channels: Add a #:system argument to channel-instances->manifest.
This allows computing a manifest for a specific system. Previously this was possible, but only through changing %current-system, which caused the derivation to be computed using that system as well (so computing a derivation for aarch64-linux on x86_64-linux would require running aarch64-linux code). This new argument adds the possibility of computing derivations for non-native systems, without having to run non-native code. I'm looking at this as it will enable the Guix Data Service to compute channel instance derivations without relying on QEMU emulation for non-native systems (it should be faster as well). * guix/channels.scm (build-from-source): Add #:system argument and pass to build. (build-channel-instance): Add system argument and pass to build-from-source. (channel-instance-derivations): Add #:system argument and pass to build-channel-instance, also rename system to current-system-value. (channel-instances->manifest): Add #:system argument and pass to channel-instance-derivations.
This commit is contained in:
parent
b7cbca221f
commit
34985fb6ae
1 changed files with 19 additions and 14 deletions
|
@ -657,10 +657,11 @@ (define (with-trivial-build-handler mvalue)
|
|||
store))))
|
||||
|
||||
(define* (build-from-source instance
|
||||
#:key core verbose? (dependencies '()))
|
||||
#:key core verbose? (dependencies '()) system)
|
||||
"Return a derivation to build Guix from INSTANCE, using the self-build
|
||||
script contained therein. When CORE is true, build package modules under
|
||||
SOURCE using CORE, an instance of Guix."
|
||||
SOURCE using CORE, an instance of Guix. By default, build for the current
|
||||
system, or SYSTEM if specified."
|
||||
(define name
|
||||
(symbol->string
|
||||
(channel-name (channel-instance-channel instance))))
|
||||
|
@ -700,20 +701,22 @@ (define script
|
|||
(with-trivial-build-handler
|
||||
(build source
|
||||
#:verbose? verbose? #:version commit
|
||||
#:system system
|
||||
#:channel-metadata (channel-instance->sexp instance)
|
||||
#:pull-version %pull-version))))
|
||||
|
||||
;; Build a set of modules that extend Guix using the standard method.
|
||||
(standard-module-derivation name source core dependencies)))
|
||||
|
||||
(define* (build-channel-instance instance
|
||||
(define* (build-channel-instance instance system
|
||||
#:optional core (dependencies '()))
|
||||
"Return, as a monadic value, the derivation for INSTANCE, a channel
|
||||
instance. DEPENDENCIES is a list of extensions providing Guile modules that
|
||||
INSTANCE depends on."
|
||||
instance, for SYSTEM. DEPENDENCIES is a list of extensions providing Guile
|
||||
modules that INSTANCE depends on."
|
||||
(build-from-source instance
|
||||
#:core core
|
||||
#:dependencies dependencies))
|
||||
#:dependencies dependencies
|
||||
#:system system))
|
||||
|
||||
(define (resolve-dependencies instances)
|
||||
"Return a procedure that, given one of the elements of INSTANCES, returns
|
||||
|
@ -743,9 +746,9 @@ (define edges
|
|||
(lambda (instance)
|
||||
(vhash-foldq* cons '() instance edges)))
|
||||
|
||||
(define (channel-instance-derivations instances)
|
||||
(define* (channel-instance-derivations instances #:key system)
|
||||
"Return the list of derivations to build INSTANCES, in the same order as
|
||||
INSTANCES."
|
||||
INSTANCES. Build for the current system by default, or SYSTEM if specified."
|
||||
(define core-instance
|
||||
;; The 'guix' channel is treated specially: it's an implicit dependency of
|
||||
;; all the other channels.
|
||||
|
@ -757,13 +760,13 @@ (define edges
|
|||
(resolve-dependencies instances))
|
||||
|
||||
(define (instance->derivation instance)
|
||||
(mlet %store-monad ((system (current-system)))
|
||||
(mlet %store-monad ((system (if system (return system) (current-system))))
|
||||
(mcached (if (eq? instance core-instance)
|
||||
(build-channel-instance instance)
|
||||
(build-channel-instance instance system)
|
||||
(mlet %store-monad ((core (instance->derivation core-instance))
|
||||
(deps (mapm %store-monad instance->derivation
|
||||
(edges instance))))
|
||||
(build-channel-instance instance core deps)))
|
||||
(build-channel-instance instance system core deps)))
|
||||
instance
|
||||
system)))
|
||||
|
||||
|
@ -865,9 +868,10 @@ (define (channel-instance->sexp instance)
|
|||
intro))))))
|
||||
'()))))
|
||||
|
||||
(define (channel-instances->manifest instances)
|
||||
(define* (channel-instances->manifest instances #:key system)
|
||||
"Return a profile manifest with entries for all of INSTANCES, a list of
|
||||
channel instances."
|
||||
channel instances. By default, build for the current system, or SYSTEM if
|
||||
specified."
|
||||
(define (instance->entry instance drv)
|
||||
(let ((commit (channel-instance-commit instance))
|
||||
(channel (channel-instance-channel instance)))
|
||||
|
@ -883,7 +887,8 @@ (define (instance->entry instance drv)
|
|||
(properties
|
||||
`((source ,(channel-instance->sexp instance)))))))
|
||||
|
||||
(mlet* %store-monad ((derivations (channel-instance-derivations instances))
|
||||
(mlet* %store-monad ((derivations (channel-instance-derivations instances
|
||||
#:system system))
|
||||
(entries -> (map instance->entry instances derivations)))
|
||||
(return (manifest entries))))
|
||||
|
||||
|
|
Loading…
Reference in a new issue