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} @
[#:set-load-path? #t] [#:module-path %load-path] @
[#:splice? #f] @
[#:guile (default-guile)]
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
set @code{%load-path} and @code{%load-compiled-path} to honor
@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.
@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
@var{exp}.

View file

@ -406,23 +406,24 @@ (define-gexp-compiler (program-file-compiler (file <program-file>)
#:guile (or guile (default-guile))))))
(define-record-type <scheme-file>
(%scheme-file name gexp)
(%scheme-file name gexp splice?)
scheme-file?
(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.
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>)
system target)
;; Compile FILE by returning a derivation that builds the file.
(match file
(($ <scheme-file> name gexp)
(gexp->file name gexp))))
(($ <scheme-file> name gexp splice?)
(gexp->file name gexp #:splice? splice?))))
;; Appending SUFFIX to BASE's output file name.
(define-record-type <file-append>
@ -1162,18 +1163,26 @@ (define* (gexp->script name exp
(define* (gexp->file name exp #:key
(set-load-path? #t)
(module-path %load-path))
"Return a derivation that builds a file NAME containing EXP. 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."
(module-path %load-path)
(splice? #f))
"Return a derivation that builds a file NAME containing EXP. When SPLICE?
is true, EXP is considered to be a list of expressions that will be spliced in
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) '())
(() ;zero modules
(gexp->derivation name
(gexp
(call-with-output-file (ungexp output)
(lambda (port)
(write '(ungexp exp) port))))
(for-each (lambda (exp)
(write exp port))
'(ungexp (if splice?
exp
(gexp ((ungexp exp)))))))))
#:local-build? #t
#:substitutable? #f))
((modules ...)
@ -1184,7 +1193,11 @@ (define* (gexp->file name exp #:key
(call-with-output-file (ungexp output)
(lambda (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
#:local-build? #t
#:substitutable? #f)))))

View file

@ -419,6 +419,24 @@ (define (match-input thing)
(call-with-input-file out read))
(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"
(mlet* %store-monad ((file (text-file "foo" "Hello, world!"))
(exp -> (gexp
@ -700,11 +718,12 @@ (define (match-input thing)
(test-assertm "gexp->derivation & with-imported-module & computed module"
(mlet* %store-monad
((module -> (scheme-file "x" #~(begin
((module -> (scheme-file "x" #~(;; splice!
(define-module (foo bar)
#:export (the-answer))
(define the-answer 42))))
(define the-answer 42))
#:splice? #t))
(build -> (with-imported-modules `(((foo bar) => ,module)
(guix build utils))
#~(begin