unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#47989] [PATCH] channels: Add a #:system argument to channel-instances->manifest.
@ 2021-04-24  8:14 Christopher Baines
  2021-05-03 20:56 ` Ludovic Courtès
                   ` (2 more replies)
  0 siblings, 3 replies; 11+ messages in thread
From: Christopher Baines @ 2021-04-24  8:14 UTC (permalink / raw)
  To: 47989

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.
---
 guix/channels.scm | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index c40fc0c507..70a09e74ff 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -657,7 +657,7 @@ that unconditionally resumes the continuation."
               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."
@@ -700,20 +700,22 @@ SOURCE using CORE, an instance of Guix."
           (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."
   (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,7 +745,7 @@ list of instances it depends on."
   (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."
   (define core-instance
@@ -757,14 +759,15 @@ INSTANCES."
     (resolve-dependencies instances))
 
   (define (instance->derivation instance)
-    (mlet %store-monad ((system (current-system)))
+    (mlet %store-monad ((current-system-value (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
+               current-system-value
                system)))
 
   (unless core-instance
@@ -865,7 +868,7 @@ derivation."
                     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."
   (define (instance->entry instance drv)
@@ -883,7 +886,8 @@ channel instances."
         (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))))
 
-- 
2.30.1





^ permalink raw reply related	[flat|nested] 11+ messages in thread

end of thread, other threads:[~2021-05-12  8:54 UTC | newest]

Thread overview: 11+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2021-04-24  8:14 [bug#47989] [PATCH] channels: Add a #:system argument to channel-instances->manifest Christopher Baines
2021-05-03 20:56 ` Ludovic Courtès
2021-05-03 21:35   ` Christopher Baines
2021-05-04 13:48     ` Ludovic Courtès
2021-05-05  9:28       ` Christopher Baines
2021-05-11  8:48         ` Ludovic Courtès
2021-05-04 13:52 ` Ludovic Courtès
2021-05-05 11:25   ` Christopher Baines
2021-05-05 11:24 ` [bug#47989] [PATCH v2] " Christopher Baines
2021-05-11  8:52   ` [bug#47989] [PATCH] " Ludovic Courtès
2021-05-12  8:52     ` bug#47989: " Christopher Baines

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).