Merge branch 'master' into staging

1 files changed, 33 insertions, 0 deletions

diff --git a/guix/inferior.scm b/guix/inferior.scm
index ba8d00866b..9f19e7d316 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -81,6 +81,8 @@
 
             inferior-package->manifest-entry
 
+            gexp->derivation-in-inferior
+
             %inferior-cache-directory
             inferior-for-channels))
 
@@ -484,6 +486,37 @@ PACKAGE must be live."
   ;; Compile PACKAGE for SYSTEM, optionally cross-building for TARGET.
   (inferior-package->derivation package system #:target target))
 
+(define* (gexp->derivation-in-inferior name exp guix
+                                       #:rest rest)
+  "Return a derivation that evaluates EXP with GUIX, an instance of Guix as
+returned for example by 'channel-instances->derivation'.  Other arguments are
+passed as-is to 'gexp->derivation'."
+  (define script
+    ;; EXP wrapped with a proper (set! %load-path …) prologue.
+    (scheme-file "inferior-script.scm" exp))
+
+  (define trampoline
+    ;; This is a crude way to run EXP on GUIX.  TODO: use 'raw-derivation' and
+    ;; make 'guix repl' the "builder"; this will require "opening up" the
+    ;; mechanisms behind 'gexp->derivation', and adding '-l' to 'guix repl'.
+    #~(begin
+        (use-modules (ice-9 popen))
+
+        (let ((pipe (open-pipe* OPEN_WRITE
+                                #+(file-append guix "/bin/guix")
+                                "repl" "-t" "machine")))
+
+          ;; XXX: EXP presumably refers to #$output but that reference is lost
+          ;; so explicitly reference it here.
+          #$output
+
+          (write `(primitive-load #$script) pipe)
+
+          (unless (zero? (close-pipe pipe))
+            (error "inferior failed" #+guix)))))
+
+  (apply gexp->derivation name trampoline rest))
+
 
 ;;;
 ;;; Manifest entries.