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:
parent
a1639ae9de
commit
4fbd1a2b7f
|
@ -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}.
|
||||||
|
|
||||||
|
|
|
@ -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)))))
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue