mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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
This commit is contained in:
Ludovic Courtès
parent
a7f15c9ecf
commit
b30b838d50
3 changed files with 38 additions and 17 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 @@ (define-gexp-compiler (program-file-compiler (file <program-file>)
|
|||
#: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 @@ (define* (gexp->script name exp
|
|||
#: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 @@ (define extensions (gexp-extensions exp))
|
|||
((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 @@ (define extensions (gexp-extensions exp))
|
|||
'(ungexp (if splice?
|
||||
exp
|
||||
(gexp ((ungexp exp)))))))))
|
||||
#:guile-for-build guile-for-build
|
||||
#:local-build? #t
|
||||
#:substitutable? #f
|
||||
#:system system
|
||||
|
|
@ -2073,6 +2081,7 @@ (define extensions (gexp-extensions exp))
|
|||
exp
|
||||
(gexp ((ungexp exp)))))))))
|
||||
#:module-path module-path
|
||||
#:guile-for-build guile-for-build
|
||||
#:local-build? #t
|
||||
#:substitutable? #f
|
||||
#:system system
|
||||
|
|
|
|||
|
|
@ -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 @@ (define (match-input thing)
|
|||
(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 @@ (define (match-input thing)
|
|||
(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 (match-input thing)
|
|||
#~(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 @@ (define (canonical-file? file)
|
|||
(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 @@ (define-module (foo bar)
|
|||
#: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 @@ (define-module (foo)
|
|||
|
||||
(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 @@ (define-public %stupid-thing ,text))
|
|||
|
||||
(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 @@ (define (contents=? file str)
|
|||
(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 @@ (define (contents=? file str)
|
|||
(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
|
||||
|
|
|
|||
Loading…
Reference in a new issue