gexp: 'scheme-file' can splice expressions.

* guix/gexp.scm (<scheme-file>)[splice?]: New field.
(scheme-file): Add #:splice? and pass it to '%scheme-file'.
(scheme-file-compiler): Pass SPLICE? to 'gexp->file'.
(gexp->file): Add #:splice? and honor it.
* tests/gexp.scm ("gexp->file + #:splice?"): New test.
("gexp->derivation & with-imported-module & computed module"): Use
 #:splice? #t.
This commit is contained in:
Ludovic Courtès 2018-04-11 00:52:40 +02:00
parent a1639ae9de
commit 4fbd1a2b7f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 52 additions and 16 deletions

View File

@ -5221,8 +5221,12 @@ This is the declarative counterpart of @code{gexp->script}.
@deffn {Monadic Procedure} gexp->file @var{name} @var{exp} @ @deffn {Monadic Procedure} gexp->file @var{name} @var{exp} @
[#:set-load-path? #t] [#:module-path %load-path] @ [#:set-load-path? #t] [#:module-path %load-path] @
[#:splice? #f] @
[#:guile (default-guile)] [#:guile (default-guile)]
Return a derivation that builds a file @var{name} containing @var{exp}. Return a derivation that builds a file @var{name} containing @var{exp}.
When @var{splice?} is true, @var{exp} is considered to be a list of
expressions that will be spliced in the resulting file.
When @var{set-load-path?} is true, emit code in the resulting file to When @var{set-load-path?} is true, emit code in the resulting file to
set @code{%load-path} and @code{%load-compiled-path} to honor set @code{%load-path} and @code{%load-compiled-path} to honor
@var{exp}'s imported modules. Look up @var{exp}'s modules in @var{exp}'s imported modules. Look up @var{exp}'s modules in
@ -5232,7 +5236,7 @@ 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 {Scheme Procedure} scheme-file @var{name} @var{exp} @deffn {Scheme Procedure} scheme-file @var{name} @var{exp} [#:splice? #f]
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}.

View File

@ -406,23 +406,24 @@ This is the declarative counterpart of 'gexp->script'."
#:guile (or guile (default-guile)))))) #:guile (or guile (default-guile))))))
(define-record-type <scheme-file> (define-record-type <scheme-file>
(%scheme-file name gexp) (%scheme-file name gexp splice?)
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
(define* (scheme-file name gexp) (define* (scheme-file name gexp #:key splice?)
"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)) (%scheme-file name gexp splice?))
(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) (($ <scheme-file> name gexp splice?)
(gexp->file name gexp)))) (gexp->file name gexp #:splice? splice?))))
;; Appending SUFFIX to BASE's output file name. ;; Appending SUFFIX to BASE's output file name.
(define-record-type <file-append> (define-record-type <file-append>
@ -1162,18 +1163,26 @@ imported modules in its search path. Look up EXP's modules in MODULE-PATH."
(define* (gexp->file name exp #:key (define* (gexp->file name exp #:key
(set-load-path? #t) (set-load-path? #t)
(module-path %load-path)) (module-path %load-path)
"Return a derivation that builds a file NAME containing EXP. When (splice? #f))
SET-LOAD-PATH? is true, emit code in the resulting file to set '%load-path' "Return a derivation that builds a file NAME containing EXP. When SPLICE?
and '%load-compiled-path' to honor EXP's imported modules. Lookup EXP's is true, EXP is considered to be a list of expressions that will be spliced in
modules in MODULE-PATH." the resulting file.
When SET-LOAD-PATH? is true, emit code in the resulting file to set
'%load-path' and '%load-compiled-path' to honor EXP's imported modules.
Lookup EXP's modules in MODULE-PATH."
(match (if set-load-path? (gexp-modules exp) '()) (match (if set-load-path? (gexp-modules exp) '())
(() ;zero modules (() ;zero modules
(gexp->derivation name (gexp->derivation name
(gexp (gexp
(call-with-output-file (ungexp output) (call-with-output-file (ungexp output)
(lambda (port) (lambda (port)
(write '(ungexp exp) port)))) (for-each (lambda (exp)
(write exp port))
'(ungexp (if splice?
exp
(gexp ((ungexp exp)))))))))
#:local-build? #t #:local-build? #t
#:substitutable? #f)) #:substitutable? #f))
((modules ...) ((modules ...)
@ -1184,7 +1193,11 @@ modules in MODULE-PATH."
(call-with-output-file (ungexp output) (call-with-output-file (ungexp output)
(lambda (port) (lambda (port)
(write '(ungexp set-load-path) port) (write '(ungexp set-load-path) port)
(write '(ungexp exp) port)))) (for-each (lambda (exp)
(write exp port))
'(ungexp (if splice?
exp
(gexp ((ungexp exp)))))))))
#:module-path module-path #:module-path module-path
#:local-build? #t #:local-build? #t
#:substitutable? #f))))) #:substitutable? #f)))))

View File

@ -419,6 +419,24 @@
(call-with-input-file out read)) (call-with-input-file out read))
(equal? (list guile) refs))))) (equal? (list guile) refs)))))
(test-assertm "gexp->file + #:splice?"
(mlet* %store-monad ((exp -> (list
#~(define foo 'bar)
#~(define guile #$%bootstrap-guile)))
(guile (package-file %bootstrap-guile))
(drv (gexp->file "splice" exp #:splice? #t))
(out -> (derivation->output-path drv))
(done (built-derivations (list drv)))
(refs (references* out)))
(pk 'splice out)
(return (and (equal? `((define foo 'bar)
(define guile ,guile)
,(call-with-input-string "" read))
(call-with-input-file out
(lambda (port)
(list (read port) (read port) (read port)))))
(equal? (list guile) refs)))))
(test-assertm "gexp->derivation" (test-assertm "gexp->derivation"
(mlet* %store-monad ((file (text-file "foo" "Hello, world!")) (mlet* %store-monad ((file (text-file "foo" "Hello, world!"))
(exp -> (gexp (exp -> (gexp
@ -700,11 +718,12 @@
(test-assertm "gexp->derivation & with-imported-module & computed module" (test-assertm "gexp->derivation & with-imported-module & computed module"
(mlet* %store-monad (mlet* %store-monad
((module -> (scheme-file "x" #~(begin ((module -> (scheme-file "x" #~(;; splice!
(define-module (foo bar) (define-module (foo bar)
#:export (the-answer)) #:export (the-answer))
(define the-answer 42)))) (define the-answer 42))
#:splice? #t))
(build -> (with-imported-modules `(((foo bar) => ,module) (build -> (with-imported-modules `(((foo bar) => ,module)
(guix build utils)) (guix build utils))
#~(begin #~(begin