me
/
guix
Archived
1
0
Fork 0
Code

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
master
Ludovic Courtès 2024-04-06 23:03:26 +02:00
parent a7f15c9ecf
commit b30b838d50
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 38 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
doc/guix.texi
View File

@ -12192,9 +12192,10 @@ The resulting file holds references to all the dependencies of @var{exp}
or a subset thereof. or a subset thereof.
@end deffn @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 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}. This is the declarative counterpart of @code{gexp->file}.
@end deffn @end deffn

19
guix/gexp.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
@ -633,25 +633,29 @@ This is the declarative counterpart of 'gexp->script'."
#:target target)))) #:target target))))
(define-record-type <scheme-file> (define-record-type <scheme-file>
(%scheme-file name gexp splice? load-path?) (%scheme-file name gexp splice? guile load-path?)
scheme-file? scheme-file?
(name scheme-file-name) ;string (name scheme-file-name) ;string
(gexp scheme-file-gexp) ;gexp (gexp scheme-file-gexp) ;gexp
(splice? scheme-file-splice?) ;Boolean (splice? scheme-file-splice?) ;Boolean
(guile scheme-file-guile) ;package
(load-path? scheme-file-set-load-path?)) ;Boolean (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. "Return an object representing the Scheme file NAME that contains GEXP.
This is the declarative counterpart of 'gexp->file'." 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>) (define-gexp-compiler (scheme-file-compiler (file <scheme-file>)
system target) system target)
;; Compile FILE by returning a derivation that builds the file. ;; Compile FILE by returning a derivation that builds the file.
(match file (match file
(($ <scheme-file> name gexp splice? set-load-path?) (($ <scheme-file> name gexp splice? guile set-load-path?)
(gexp->file name gexp (gexp->file name gexp
#:guile (or guile (default-guile))
#:set-load-path? set-load-path? #:set-load-path? set-load-path?
#:splice? splice? #:splice? splice?
#:system system #:system system
@ -2019,6 +2023,7 @@ imported modules in its search path. Look up EXP's modules in MODULE-PATH."
#:substitutable? #f))) #:substitutable? #f)))
(define* (gexp->file name exp #:key (define* (gexp->file name exp #:key
(guile (default-guile))
(set-load-path? #t) (set-load-path? #t)
(module-path %load-path) (module-path %load-path)
(splice? #f) (splice? #f)
@ -2038,6 +2043,8 @@ Lookup EXP's modules in MODULE-PATH."
((target (if (eq? target 'current) ((target (if (eq? target 'current)
(current-target-system) (current-target-system)
(return target))) (return target)))
(guile-for-build
(lower-object guile system #:target #f))
(no-load-path? -> (or (not set-load-path?) (no-load-path? -> (or (not set-load-path?)
(and (null? modules) (and (null? modules)
(null? extensions)))) (null? extensions))))
@ -2057,6 +2064,7 @@ Lookup EXP's modules in MODULE-PATH."
'(ungexp (if splice? '(ungexp (if splice?
exp exp
(gexp ((ungexp exp))))))))) (gexp ((ungexp exp)))))))))
#:guile-for-build guile-for-build
#:local-build? #t #:local-build? #t
#:substitutable? #f #:substitutable? #f
#:system system #:system system
@ -2073,6 +2081,7 @@ Lookup EXP's modules in MODULE-PATH."
exp exp
(gexp ((ungexp exp))))))))) (gexp ((ungexp exp)))))))))
#:module-path module-path #:module-path module-path
#:guile-for-build guile-for-build
#:local-build? #t #:local-build? #t
#:substitutable? #f #:substitutable? #f
#:system system #:system system

31
tests/gexp.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2021-2022 Maxime Devos <maximedevos@telenet.be>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -661,7 +661,8 @@
(mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile)))) (mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile))))
(guile (package-file %bootstrap-guile)) (guile (package-file %bootstrap-guile))
(sexp (gexp->sexp exp (%current-system) #f)) (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)) (out -> (derivation->output-path drv))
(done (built-derivations (list drv))) (done (built-derivations (list drv)))
(refs (references* out))) (refs (references* out)))
@ -672,7 +673,8 @@
(mlet* %store-monad ((exp -> #~#$(file-append %bootstrap-guile (mlet* %store-monad ((exp -> #~#$(file-append %bootstrap-guile
"/bin/guile")) "/bin/guile"))
(guile (package-file %bootstrap-guile)) (guile (package-file %bootstrap-guile))
(drv (gexp->file "foo" exp)) (drv (gexp->file "foo" exp
#:guile %bootstrap-guile))
(out -> (derivation->output-path drv)) (out -> (derivation->output-path drv))
(done (built-derivations (list drv))) (done (built-derivations (list drv)))
(refs (references* out))) (refs (references* out)))
@ -685,7 +687,9 @@
#~(define foo 'bar) #~(define foo 'bar)
#~(define guile #$%bootstrap-guile))) #~(define guile #$%bootstrap-guile)))
(guile (package-file %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)) (out -> (derivation->output-path drv))
(done (built-derivations (list drv))) (done (built-derivations (list drv)))
(refs (references* out))) (refs (references* out)))
@ -943,7 +947,8 @@
(let ((make-file (lambda () (let ((make-file (lambda ()
;; Use 'eval' to make sure we get an object that's not ;; Use 'eval' to make sure we get an object that's not
;; 'eq?' nor 'equal?' due to the closures it embeds. ;; '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))))) (current-module)))))
(define result (define result
((@@ (guix gexp) gexp-modules) ((@@ (guix gexp) gexp-modules)
@ -1035,7 +1040,8 @@ importing.* \\(guix config\\) from the host"
#:export (the-answer)) #:export (the-answer))
(define the-answer 42)) (define the-answer 42))
#:splice? #t)) #:splice? #t
#:guile %bootstrap-guile))
(build -> (with-imported-modules `(((foo bar) => ,module) (build -> (with-imported-modules `(((foo bar) => ,module)
(guix build utils)) (guix build utils))
#~(begin #~(begin
@ -1080,7 +1086,8 @@ importing.* \\(guix config\\) from the host"
(define (multiply x) (define (multiply x)
(* the-answer x))) (* the-answer x)))
#:splice? #t)) #:splice? #t
#:guile %bootstrap-guile))
(build -> (with-extensions (list extension) (build -> (with-extensions (list extension)
(with-imported-modules `((guix build utils) (with-imported-modules `((guix build utils)
((foo) => ,module)) ((foo) => ,module))
@ -1432,7 +1439,8 @@ importing.* \\(guix config\\) from the host"
(test-assertm "scheme-file" (test-assertm "scheme-file"
(let* ((text (plain-file "foo" "Hello, world!")) (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)) (mlet* %store-monad ((drv (lower-object scheme))
(text (lower-object text)) (text (lower-object text))
(out -> (derivation->output-path drv))) (out -> (derivation->output-path drv)))
@ -1719,7 +1727,9 @@ importing.* \\(guix config\\) from the host"
(test-assertm "gexp->file, cross-compilation" (test-assertm "gexp->file, cross-compilation"
(mlet* %store-monad ((target -> "aarch64-linux-gnu") (mlet* %store-monad ((target -> "aarch64-linux-gnu")
(exp -> (gexp (list (ungexp coreutils)))) (exp -> (gexp (list (ungexp coreutils))))
(xdrv (gexp->file "foo" exp #:target target)) (xdrv (gexp->file "foo" exp
#:target target
#:guile %bootstrap-guile))
(refs (references* (refs (references*
(derivation-file-name xdrv))) (derivation-file-name xdrv)))
(xcu (package->cross-derivation coreutils (xcu (package->cross-derivation coreutils
@ -1732,7 +1742,8 @@ importing.* \\(guix config\\) from the host"
(mlet* %store-monad ((target -> "aarch64-linux-gnu") (mlet* %store-monad ((target -> "aarch64-linux-gnu")
(_ (set-current-target target)) (_ (set-current-target target))
(exp -> (gexp (list (ungexp coreutils)))) (exp -> (gexp (list (ungexp coreutils))))
(xdrv (gexp->file "foo" exp)) (xdrv (gexp->file "foo" exp
#:guile %bootstrap-guile))
(refs (references* (refs (references*
(derivation-file-name xdrv))) (derivation-file-name xdrv)))
(xcu (package->cross-derivation coreutils (xcu (package->cross-derivation coreutils