gexp: Add #:guile parameter to ‘gexp->file’ and ‘scheme-file’.

This brings ‘gexp->file’ in line with its documentation and mirrors
what’s done for ‘gexp->script’ and ‘program-file’.

Fixes <https://issues.guix.gnu.org/69401>.

* guix/gexp.scm (gexp->file): Add #:guile, as was already documented.
(<scheme-file>)[guile]: New field.
(scheme-file): Add #:guile.
(scheme-file-compiler): Honor ‘guile’ field.
* tests/gexp.scm ("gexp->file")
("gexp->file + file-append", "gexp->file + #:splice?")
("gexp->file, cross-compilation")
("gexp->file, cross-compilation with default target")
Add #:guile to ‘gexp->file’ calls.
("gexp-modules deletes duplicates")
("gexp->derivation & with-imported-module & computed module")
("gexp->derivation & with-extensions", "scheme-file"): Likewise for
‘scheme-file’ calls.

Change-Id: I47536063d5e411e561ec321e535267e92dd06044

Reported-by: Efraim Flashner <efraim@flashner.co.il>
Change-Id: I58d653c7fbe65c665bafcbd332ac9b264ddeab64

3 files changed, 38 insertions, 17 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 3ad44b4acb..5827e0de14 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12192,9 +12192,10 @@ The resulting file holds references to all the dependencies of @var{exp}
 or a subset thereof.
 @end deffn
 
-@deffn {Procedure} scheme-file name exp [#:splice? #f] [#:set-load-path? #t]
+@deffn {Procedure} scheme-file name exp [#:splice? #f] @
+           [#:guile #f] [#:set-load-path? #t]
 Return an object representing the Scheme file @var{name} that contains
-@var{exp}.
+@var{exp}.  @var{guile} is the Guile package used to produce that file.
 
 This is the declarative counterpart of @code{gexp->file}.
 @end deffn
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 29819878fa..74b4c49f90 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -633,25 +633,29 @@ This is the declarative counterpart of 'gexp->script'."
                    #:target target))))
 
 (define-record-type <scheme-file>
-  (%scheme-file name gexp splice? load-path?)
+  (%scheme-file name gexp splice? guile load-path?)
   scheme-file?
   (name       scheme-file-name)                  ;string
   (gexp       scheme-file-gexp)                  ;gexp
   (splice?    scheme-file-splice?)               ;Boolean
+  (guile      scheme-file-guile)                 ;package
   (load-path? scheme-file-set-load-path?))       ;Boolean
 
-(define* (scheme-file name gexp #:key splice? (set-load-path? #t))
+(define* (scheme-file name gexp
+                      #:key splice?
+                      guile (set-load-path? #t))
   "Return an object representing the Scheme file NAME that contains GEXP.
 
 This is the declarative counterpart of 'gexp->file'."
-  (%scheme-file name gexp splice? set-load-path?))
+  (%scheme-file name gexp splice? guile set-load-path?))
 
 (define-gexp-compiler (scheme-file-compiler (file <scheme-file>)
                                             system target)
   ;; Compile FILE by returning a derivation that builds the file.
   (match file
-    (($ <scheme-file> name gexp splice? set-load-path?)
+    (($ <scheme-file> name gexp splice? guile set-load-path?)
      (gexp->file name gexp
+                 #:guile (or guile (default-guile))
                  #:set-load-path? set-load-path?
                  #:splice? splice?
                  #:system system
@@ -2019,6 +2023,7 @@ imported modules in its search path.  Look up EXP's modules in MODULE-PATH."
                       #:substitutable? #f)))
 
 (define* (gexp->file name exp #:key
+                     (guile (default-guile))
                      (set-load-path? #t)
                      (module-path %load-path)
                      (splice? #f)
@@ -2038,6 +2043,8 @@ Lookup EXP's modules in MODULE-PATH."
       ((target (if (eq? target 'current)
                    (current-target-system)
                    (return target)))
+       (guile-for-build
+        (lower-object guile system #:target #f))
        (no-load-path? -> (or (not set-load-path?)
                              (and (null? modules)
                                   (null? extensions))))
@@ -2057,6 +2064,7 @@ Lookup EXP's modules in MODULE-PATH."
                                 '(ungexp (if splice?
                                              exp
                                              (gexp ((ungexp exp)))))))))
+                          #:guile-for-build guile-for-build
                           #:local-build? #t
                           #:substitutable? #f
                           #:system system
@@ -2073,6 +2081,7 @@ Lookup EXP's modules in MODULE-PATH."
                                              exp
                                              (gexp ((ungexp exp)))))))))
                           #:module-path module-path
+                          #:guile-for-build guile-for-build
                           #:local-build? #t
                           #:substitutable? #f
                           #:system system
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 001786c13c..905009caee 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021-2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -661,7 +661,8 @@
   (mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile))))
                        (guile  (package-file %bootstrap-guile))
                        (sexp   (gexp->sexp exp (%current-system) #f))
-                       (drv    (gexp->file "foo" exp))
+                       (drv    (gexp->file "foo" exp
+                                           #:guile %bootstrap-guile))
                        (out -> (derivation->output-path drv))
                        (done   (built-derivations (list drv)))
                        (refs   (references* out)))
@@ -672,7 +673,8 @@
   (mlet* %store-monad ((exp -> #~#$(file-append %bootstrap-guile
                                                 "/bin/guile"))
                        (guile  (package-file %bootstrap-guile))
-                       (drv    (gexp->file "foo" exp))
+                       (drv    (gexp->file "foo" exp
+                                           #:guile %bootstrap-guile))
                        (out -> (derivation->output-path drv))
                        (done   (built-derivations (list drv)))
                        (refs   (references* out)))
@@ -685,7 +687,9 @@
                                 #~(define foo 'bar)
                                 #~(define guile #$%bootstrap-guile)))
                        (guile  (package-file %bootstrap-guile))
-                       (drv    (gexp->file "splice" exp #:splice? #t))
+                       (drv    (gexp->file "splice" exp
+                                           #:splice? #t
+                                           #:guile %bootstrap-guile))
                        (out -> (derivation->output-path drv))
                        (done   (built-derivations (list drv)))
                        (refs   (references* out)))
@@ -943,7 +947,8 @@
   (let ((make-file (lambda ()
                      ;; Use 'eval' to make sure we get an object that's not
                      ;; 'eq?' nor 'equal?' due to the closures it embeds.
-                     (eval '(scheme-file "bar.scm" #~(define-module (bar)))
+                     (eval '(scheme-file "bar.scm" #~(define-module (bar))
+                                         #:guile %bootstrap-guile)
                            (current-module)))))
     (define result
       ((@@ (guix gexp) gexp-modules)
@@ -1035,7 +1040,8 @@ importing.* \\(guix config\\) from the host"
                                          #:export (the-answer))
 
                                        (define the-answer 42))
-                               #:splice? #t))
+                               #:splice? #t
+                               #:guile %bootstrap-guile))
        (build -> (with-imported-modules `(((foo bar) => ,module)
                                           (guix build utils))
                    #~(begin
@@ -1080,7 +1086,8 @@ importing.* \\(guix config\\) from the host"
 
                                       (define (multiply x)
                                         (* the-answer x)))
-                               #:splice? #t))
+                               #:splice? #t
+                               #:guile %bootstrap-guile))
        (build -> (with-extensions (list extension)
                    (with-imported-modules `((guix build utils)
                                             ((foo) => ,module))
@@ -1432,7 +1439,8 @@ importing.* \\(guix config\\) from the host"
 
 (test-assertm "scheme-file"
   (let* ((text   (plain-file "foo" "Hello, world!"))
-         (scheme (scheme-file "bar" #~(list "foo" #$text))))
+         (scheme (scheme-file "bar" #~(list "foo" #$text)
+                              #:guile %bootstrap-guile)))
     (mlet* %store-monad ((drv  (lower-object scheme))
                          (text (lower-object text))
                          (out -> (derivation->output-path drv)))
@@ -1719,7 +1727,9 @@ importing.* \\(guix config\\) from the host"
 (test-assertm "gexp->file, cross-compilation"
   (mlet* %store-monad ((target -> "aarch64-linux-gnu")
                        (exp    -> (gexp (list (ungexp coreutils))))
-                       (xdrv      (gexp->file "foo" exp #:target target))
+                       (xdrv      (gexp->file "foo" exp
+                                              #:target target
+                                              #:guile %bootstrap-guile))
                        (refs      (references*
                                    (derivation-file-name xdrv)))
                        (xcu       (package->cross-derivation coreutils
@@ -1732,7 +1742,8 @@ importing.* \\(guix config\\) from the host"
   (mlet* %store-monad ((target -> "aarch64-linux-gnu")
                        (_         (set-current-target target))
                        (exp    -> (gexp (list (ungexp coreutils))))
-                       (xdrv      (gexp->file "foo" exp))
+                       (xdrv      (gexp->file "foo" exp
+                                              #:guile %bootstrap-guile))
                        (refs      (references*
                                    (derivation-file-name xdrv)))
                        (xcu       (package->cross-derivation coreutils