mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-23 21:17:11 -05:00
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
3 changed files with 52 additions and 16 deletions
|
@ -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}.
|
||||
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue