build-system/{gnu,trivial}: Add a `#:guile' keyword parameter.

* guix/build-system/gnu.scm (package-with-explicit-inputs): New `guile'
  keyword parameter.  Add it to P's arguments, and pass it in recursive
  calls.
  (gnu-build): New `guile' keyword parameter; new `guile-for-build'
  variable.  Pass it as the `#:guile-for-build' parameter of
  `build-expression->derivation'.

* guix/build-system/trivial.scm (trivial-build): Likewise.

2 files changed, 47 insertions, 11 deletions

diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index b4a498bee7..1a1ec1da12 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -38,13 +38,18 @@
 
 (define* (package-with-explicit-inputs p boot-inputs
                                        #:optional
-                                       (loc (current-source-location)))
-  "Rewrite P, which is assumed to use GNU-BUILD-SYSTEM, to take BOOT-INPUTS
-as explicit inputs instead of the implicit default, and return it."
+                                       (loc (current-source-location))
+                                       #:key guile)
+  "Rewrite P, which is assumed to use GNU-BUILD-SYSTEM, to take
+BOOT-INPUTS as explicit inputs instead of the implicit default, and
+return it.  Use GUILE to run the builder, or the distro's final Guile
+when GUILE is #f."
   (define rewritten-input
     (match-lambda
      ((name (? package? p) sub-drv ...)
-      (cons* name (package-with-explicit-inputs p boot-inputs) sub-drv))
+      (cons* name
+             (package-with-explicit-inputs p boot-inputs #:guile guile)
+             sub-drv))
      (x x)))
 
   (define boot-input-names
@@ -59,8 +64,10 @@ as explicit inputs instead of the implicit default, and return it."
      (let ((args (package-arguments p)))
        (if (procedure? args)
            (lambda (system)
-             `(#:implicit-inputs? #f ,@(args system)))
-           `(#:implicit-inputs? #f ,@args))))
+             `(#:guile ,guile
+               #:implicit-inputs? #f ,@(args system)))
+           `(#:guile ,guile
+             #:implicit-inputs? #f ,@args))))
     (native-inputs (map rewritten-input
                         (filtered-inputs (package-native-inputs p))))
     (propagated-inputs (map rewritten-input
@@ -97,7 +104,8 @@ System: GCC, GNU Make, Bash, Coreutils, etc."
                                 inputs)))))))
 
 (define* (gnu-build store name source inputs
-                    #:key (outputs '("out")) (configure-flags ''())
+                    #:key (guile #f)
+                    (outputs '("out")) (configure-flags ''())
                     (make-flags ''())
                     (patches ''()) (patch-flags ''("--batch" "-p1"))
                     (out-of-source? #f)
@@ -115,7 +123,9 @@ System: GCC, GNU Make, Bash, Coreutils, etc."
                     (modules '((guix build gnu-build-system)
                                (guix build utils))))
   "Return a derivation called NAME that builds from tarball SOURCE, with
-input derivation INPUTS, using the usual procedure of the GNU Build System."
+input derivation INPUTS, using the usual procedure of the GNU Build
+System.  The builder is run with GUILE, or with the distro's final Guile
+package if GUILE is #f or omitted."
   (define builder
     `(begin
        (use-modules ,@modules)
@@ -139,6 +149,17 @@ input derivation INPUTS, using the usual procedure of the GNU Build System."
                   #:strip-flags ,strip-flags
                   #:strip-directories ,strip-directories)))
 
+  (define guile-for-build
+    (match guile
+      (#f                                         ; the default
+       (let* ((distro (resolve-interface '(distro packages base)))
+              (guile  (module-ref distro 'guile-final)))
+         (package-derivation store guile system)))
+      ((? package?)
+       (package-derivation store guile system))
+      ((? derivation-path?)
+       guile)))
+
   (build-expression->derivation store name system
                                 builder
                                 `(("source" ,source)
@@ -148,7 +169,8 @@ input derivation INPUTS, using the usual procedure of the GNU Build System."
                                           (standard-inputs system))
                                         '()))
                                 #:outputs outputs
-                                #:modules modules))
+                                #:modules modules
+                                #:guile-for-build guile-for-build))
 
 (define gnu-build-system
   (build-system (name 'gnu)
diff --git a/guix/build-system/trivial.scm b/guix/build-system/trivial.scm
index 1134ae988c..8759cb3f92 100644
--- a/guix/build-system/trivial.scm
+++ b/guix/build-system/trivial.scm
@@ -20,16 +20,30 @@
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix derivations)
+  #:use-module (guix packages)
   #:use-module (guix build-system)
+  #:use-module (ice-9 match)
   #:export (trivial-build-system))
 
 (define* (trivial-build store name source inputs
-                        #:key outputs system builder (modules '()))
+                        #:key outputs guile system builder (modules '()))
   "Run build expression BUILDER, an expression, for SYSTEM.  SOURCE is
 ignored."
+  (define guile-for-build
+    (match guile
+      (#f                                         ; the default
+       (let* ((distro (resolve-interface '(distro packages base)))
+              (guile  (module-ref distro 'guile-final)))
+         (package-derivation store guile system)))
+      ((? package?)
+       (package-derivation store guile system))
+      ((? derivation-path?)
+       guile)))
+
   (build-expression->derivation store name system builder inputs
                                 #:outputs outputs
-                                #:modules modules))
+                                #:modules modules
+                                #:guile-for-build guile-for-build))
 
 (define trivial-build-system
   (build-system (name 'trivial)