mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
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 @@ that unconditionally resumes the continuation."
|
||||||
store))))
|
store))))
|
||||||
|
|
||||||
(define* (build-from-source instance
|
(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
|
"Return a derivation to build Guix from INSTANCE, using the self-build
|
||||||
script contained therein. When CORE is true, build package modules under
|
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
|
(define name
|
||||||
(symbol->string
|
(symbol->string
|
||||||
(channel-name (channel-instance-channel instance))))
|
(channel-name (channel-instance-channel instance))))
|
||||||
|
@ -700,20 +701,22 @@ SOURCE using CORE, an instance of Guix."
|
||||||
(with-trivial-build-handler
|
(with-trivial-build-handler
|
||||||
(build source
|
(build source
|
||||||
#:verbose? verbose? #:version commit
|
#:verbose? verbose? #:version commit
|
||||||
|
#:system system
|
||||||
#:channel-metadata (channel-instance->sexp instance)
|
#:channel-metadata (channel-instance->sexp instance)
|
||||||
#:pull-version %pull-version))))
|
#:pull-version %pull-version))))
|
||||||
|
|
||||||
;; Build a set of modules that extend Guix using the standard method.
|
;; Build a set of modules that extend Guix using the standard method.
|
||||||
(standard-module-derivation name source core dependencies)))
|
(standard-module-derivation name source core dependencies)))
|
||||||
|
|
||||||
(define* (build-channel-instance instance
|
(define* (build-channel-instance instance system
|
||||||
#:optional core (dependencies '()))
|
#:optional core (dependencies '()))
|
||||||
"Return, as a monadic value, the derivation for INSTANCE, a channel
|
"Return, as a monadic value, the derivation for INSTANCE, a channel
|
||||||
instance. DEPENDENCIES is a list of extensions providing Guile modules that
|
instance, for SYSTEM. DEPENDENCIES is a list of extensions providing Guile
|
||||||
INSTANCE depends on."
|
modules that INSTANCE depends on."
|
||||||
(build-from-source instance
|
(build-from-source instance
|
||||||
#:core core
|
#:core core
|
||||||
#:dependencies dependencies))
|
#:dependencies dependencies
|
||||||
|
#:system system))
|
||||||
|
|
||||||
(define (resolve-dependencies instances)
|
(define (resolve-dependencies instances)
|
||||||
"Return a procedure that, given one of the elements of INSTANCES, returns
|
"Return a procedure that, given one of the elements of INSTANCES, returns
|
||||||
|
@ -743,9 +746,9 @@ list of instances it depends on."
|
||||||
(lambda (instance)
|
(lambda (instance)
|
||||||
(vhash-foldq* cons '() instance edges)))
|
(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
|
"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
|
(define core-instance
|
||||||
;; The 'guix' channel is treated specially: it's an implicit dependency of
|
;; The 'guix' channel is treated specially: it's an implicit dependency of
|
||||||
;; all the other channels.
|
;; all the other channels.
|
||||||
|
@ -757,13 +760,13 @@ INSTANCES."
|
||||||
(resolve-dependencies instances))
|
(resolve-dependencies instances))
|
||||||
|
|
||||||
(define (instance->derivation instance)
|
(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)
|
(mcached (if (eq? instance core-instance)
|
||||||
(build-channel-instance instance)
|
(build-channel-instance instance system)
|
||||||
(mlet %store-monad ((core (instance->derivation core-instance))
|
(mlet %store-monad ((core (instance->derivation core-instance))
|
||||||
(deps (mapm %store-monad instance->derivation
|
(deps (mapm %store-monad instance->derivation
|
||||||
(edges instance))))
|
(edges instance))))
|
||||||
(build-channel-instance instance core deps)))
|
(build-channel-instance instance system core deps)))
|
||||||
instance
|
instance
|
||||||
system)))
|
system)))
|
||||||
|
|
||||||
|
@ -865,9 +868,10 @@ derivation."
|
||||||
intro))))))
|
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
|
"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)
|
(define (instance->entry instance drv)
|
||||||
(let ((commit (channel-instance-commit instance))
|
(let ((commit (channel-instance-commit instance))
|
||||||
(channel (channel-instance-channel instance)))
|
(channel (channel-instance-channel instance)))
|
||||||
|
@ -883,7 +887,8 @@ channel instances."
|
||||||
(properties
|
(properties
|
||||||
`((source ,(channel-instance->sexp instance)))))))
|
`((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)))
|
(entries -> (map instance->entry instances derivations)))
|
||||||
(return (manifest entries))))
|
(return (manifest entries))))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue