gexp: Add 'with-imported-modules' macro.
* guix/gexp.scm (<gexp>)[modules]: New field. (gexp-modules): New procedure. (gexp->derivation): Use it and append the result to %MODULES. Update docstring to mark #:modules as deprecated. (current-imported-modules, with-imported-modules): New macros. (gexp): Pass CURRENT-IMPORTED-MODULES as second argument to 'gexp'. (gexp->script): Use and honor 'gexp-modules'; define '%modules'. * tests/gexp.scm ("gexp->derivation & with-imported-modules") ("gexp->derivation & nested with-imported-modules") ("gexp-modules & ungexp", "gexp-modules & ungexp-splicing"): New tests. ("program-file"): Use 'with-imported-modules'. Remove #:modules argument to 'program-file'. * doc/guix.texi (G-Expressions): Document 'with-imported-modules'. Mark #:modules of 'gexp->derivation' as deprecated. * emacs/guix-devel.el: Add syntax for 'with-imported-modules'. (guix-devel-keywords): Add it. * .dir-locals.el: Likewise.
This commit is contained in:
parent
affd7761f3
commit
0bb9929eaa
|
@ -59,6 +59,7 @@
|
||||||
(eval . (put 'run-with-store 'scheme-indent-function 1))
|
(eval . (put 'run-with-store 'scheme-indent-function 1))
|
||||||
(eval . (put 'run-with-state 'scheme-indent-function 1))
|
(eval . (put 'run-with-state 'scheme-indent-function 1))
|
||||||
(eval . (put 'wrap-program 'scheme-indent-function 1))
|
(eval . (put 'wrap-program 'scheme-indent-function 1))
|
||||||
|
(eval . (put 'with-imported-modules 'scheme-indent-function 1))
|
||||||
|
|
||||||
(eval . (put 'call-with-container 'scheme-indent-function 1))
|
(eval . (put 'call-with-container 'scheme-indent-function 1))
|
||||||
(eval . (put 'container-excursion 'scheme-indent-function 1))
|
(eval . (put 'container-excursion 'scheme-indent-function 1))
|
||||||
|
|
|
@ -3697,6 +3697,30 @@ In the example above, the native build of @var{coreutils} is used, so
|
||||||
that @command{ln} can actually run on the host; but then the
|
that @command{ln} can actually run on the host; but then the
|
||||||
cross-compiled build of @var{emacs} is referenced.
|
cross-compiled build of @var{emacs} is referenced.
|
||||||
|
|
||||||
|
@cindex imported modules, for gexps
|
||||||
|
@findex with-imported-modules
|
||||||
|
Another gexp feature is @dfn{imported modules}: sometimes you want to be
|
||||||
|
able to use certain Guile modules from the ``host environment'' in the
|
||||||
|
gexp, so those modules should be imported in the ``build environment''.
|
||||||
|
The @code{with-imported-modules} form allows you to express that:
|
||||||
|
|
||||||
|
@example
|
||||||
|
(let ((build (with-imported-modules '((guix build utils))
|
||||||
|
#~(begin
|
||||||
|
(use-modules (guix build utils))
|
||||||
|
(mkdir-p (string-append #$output "/bin"))))))
|
||||||
|
(gexp->derivation "empty-dir"
|
||||||
|
#~(begin
|
||||||
|
#$build
|
||||||
|
(display "success!\n")
|
||||||
|
#t)))
|
||||||
|
@end example
|
||||||
|
|
||||||
|
@noindent
|
||||||
|
In this example, the @code{(guix build utils)} module is automatically
|
||||||
|
pulled into the isolated build environment of our gexp, such that
|
||||||
|
@code{(use-modules (guix build utils))} works as expected.
|
||||||
|
|
||||||
The syntactic form to construct gexps is summarized below.
|
The syntactic form to construct gexps is summarized below.
|
||||||
|
|
||||||
@deffn {Scheme Syntax} #~@var{exp}
|
@deffn {Scheme Syntax} #~@var{exp}
|
||||||
|
@ -3756,6 +3780,16 @@ G-expressions created by @code{gexp} or @code{#~} are run-time objects
|
||||||
of the @code{gexp?} type (see below.)
|
of the @code{gexp?} type (see below.)
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Syntax} with-imported-modules @var{modules} @var{body}@dots{}
|
||||||
|
Mark the gexps defined in @var{body}@dots{} as requiring @var{modules}
|
||||||
|
in their execution environment. @var{modules} must be a list of Guile
|
||||||
|
module names, such as @code{'((guix build utils) (guix build gremlin))}.
|
||||||
|
|
||||||
|
This form has @emph{lexical} scope: it has an effect on the gexps
|
||||||
|
directly defined in @var{body}@dots{}, but not on those defined, say, in
|
||||||
|
procedures called from @var{body}@dots{}.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
@deffn {Scheme Procedure} gexp? @var{obj}
|
@deffn {Scheme Procedure} gexp? @var{obj}
|
||||||
Return @code{#t} if @var{obj} is a G-expression.
|
Return @code{#t} if @var{obj} is a G-expression.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
@ -3781,7 +3815,9 @@ stored in a file called @var{script-name}. When @var{target} is true,
|
||||||
it is used as the cross-compilation target triplet for packages referred
|
it is used as the cross-compilation target triplet for packages referred
|
||||||
to by @var{exp}.
|
to by @var{exp}.
|
||||||
|
|
||||||
Make @var{modules} available in the evaluation context of @var{exp};
|
@var{modules} is deprecated in favor of @code{with-imported-modules}.
|
||||||
|
Its meaning is to
|
||||||
|
make @var{modules} available in the evaluation context of @var{exp};
|
||||||
@var{modules} is a list of names of Guile modules searched in
|
@var{modules} is a list of names of Guile modules searched in
|
||||||
@var{module-path} to be copied in the store, compiled, and made available in
|
@var{module-path} to be copied in the store, compiled, and made available in
|
||||||
the load path during the execution of @var{exp}---e.g., @code{((guix
|
the load path during the execution of @var{exp}---e.g., @code{((guix
|
||||||
|
|
|
@ -216,6 +216,7 @@ to find 'modify-phases' keywords."
|
||||||
"with-derivation-substitute"
|
"with-derivation-substitute"
|
||||||
"with-directory-excursion"
|
"with-directory-excursion"
|
||||||
"with-error-handling"
|
"with-error-handling"
|
||||||
|
"with-imported-modules"
|
||||||
"with-monad"
|
"with-monad"
|
||||||
"with-mutex"
|
"with-mutex"
|
||||||
"with-store"))
|
"with-store"))
|
||||||
|
@ -306,6 +307,7 @@ Each rule should have a form (SYMBOL VALUE). See `put' for details."
|
||||||
(with-derivation-substitute 2)
|
(with-derivation-substitute 2)
|
||||||
(with-directory-excursion 1)
|
(with-directory-excursion 1)
|
||||||
(with-error-handling 0)
|
(with-error-handling 0)
|
||||||
|
(with-imported-modules 1)
|
||||||
(with-monad 1)
|
(with-monad 1)
|
||||||
(with-mutex 1)
|
(with-mutex 1)
|
||||||
(with-store 1)
|
(with-store 1)
|
||||||
|
|
|
@ -29,6 +29,7 @@
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:export (gexp
|
#:export (gexp
|
||||||
gexp?
|
gexp?
|
||||||
|
with-imported-modules
|
||||||
|
|
||||||
gexp-input
|
gexp-input
|
||||||
gexp-input?
|
gexp-input?
|
||||||
|
@ -98,9 +99,10 @@
|
||||||
|
|
||||||
;; "G expressions".
|
;; "G expressions".
|
||||||
(define-record-type <gexp>
|
(define-record-type <gexp>
|
||||||
(make-gexp references proc)
|
(make-gexp references modules proc)
|
||||||
gexp?
|
gexp?
|
||||||
(references gexp-references) ;list of <gexp-input>
|
(references gexp-references) ;list of <gexp-input>
|
||||||
|
(modules gexp-self-modules) ;list of module names
|
||||||
(proc gexp-proc)) ;procedure
|
(proc gexp-proc)) ;procedure
|
||||||
|
|
||||||
(define (write-gexp gexp port)
|
(define (write-gexp gexp port)
|
||||||
|
@ -384,6 +386,23 @@ whether this should be considered a \"native\" input or not."
|
||||||
|
|
||||||
(set-record-type-printer! <gexp-output> write-gexp-output)
|
(set-record-type-printer! <gexp-output> write-gexp-output)
|
||||||
|
|
||||||
|
(define (gexp-modules gexp)
|
||||||
|
"Return the list of Guile module names GEXP relies on."
|
||||||
|
(delete-duplicates
|
||||||
|
(append (gexp-self-modules gexp)
|
||||||
|
(append-map (match-lambda
|
||||||
|
(($ <gexp-input> (? gexp? exp))
|
||||||
|
(gexp-modules exp))
|
||||||
|
(($ <gexp-input> (lst ...))
|
||||||
|
(append-map (lambda (item)
|
||||||
|
(if (gexp? item)
|
||||||
|
(gexp-modules item)
|
||||||
|
'()))
|
||||||
|
lst))
|
||||||
|
(_
|
||||||
|
'()))
|
||||||
|
(gexp-references gexp)))))
|
||||||
|
|
||||||
(define raw-derivation
|
(define raw-derivation
|
||||||
(store-lift derivation))
|
(store-lift derivation))
|
||||||
|
|
||||||
|
@ -465,7 +484,8 @@ derivation) on SYSTEM; EXP is stored in a file called SCRIPT-NAME. When
|
||||||
TARGET is true, it is used as the cross-compilation target triplet for
|
TARGET is true, it is used as the cross-compilation target triplet for
|
||||||
packages referred to by EXP.
|
packages referred to by EXP.
|
||||||
|
|
||||||
Make MODULES available in the evaluation context of EXP; MODULES is a list of
|
MODULES is deprecated in favor of 'with-imported-modules'. Its meaning is to
|
||||||
|
make MODULES available in the evaluation context of EXP; MODULES is a list of
|
||||||
names of Guile modules searched in MODULE-PATH to be copied in the store,
|
names of Guile modules searched in MODULE-PATH to be copied in the store,
|
||||||
compiled, and made available in the load path during the execution of
|
compiled, and made available in the load path during the execution of
|
||||||
EXP---e.g., '((guix build utils) (guix build gnu-build-system)).
|
EXP---e.g., '((guix build utils) (guix build gnu-build-system)).
|
||||||
|
@ -494,7 +514,9 @@ Similarly for DISALLOWED-REFERENCES, which can list items that must not be
|
||||||
referenced by the outputs.
|
referenced by the outputs.
|
||||||
|
|
||||||
The other arguments are as for 'derivation'."
|
The other arguments are as for 'derivation'."
|
||||||
(define %modules modules)
|
(define %modules
|
||||||
|
(delete-duplicates
|
||||||
|
(append modules (gexp-modules exp))))
|
||||||
(define outputs (gexp-outputs exp))
|
(define outputs (gexp-outputs exp))
|
||||||
|
|
||||||
(define (graphs-file-names graphs)
|
(define (graphs-file-names graphs)
|
||||||
|
@ -724,6 +746,17 @@ and in the current monad setting (system type, etc.)"
|
||||||
(simple-format #f "~a:~a" line column)))
|
(simple-format #f "~a:~a" line column)))
|
||||||
"<unknown location>")))
|
"<unknown location>")))
|
||||||
|
|
||||||
|
(define-syntax-parameter current-imported-modules
|
||||||
|
;; Current list of imported modules.
|
||||||
|
(identifier-syntax '()))
|
||||||
|
|
||||||
|
(define-syntax-rule (with-imported-modules modules body ...)
|
||||||
|
"Mark the gexps defined in BODY... as requiring MODULES in their execution
|
||||||
|
environment."
|
||||||
|
(syntax-parameterize ((current-imported-modules
|
||||||
|
(identifier-syntax modules)))
|
||||||
|
body ...))
|
||||||
|
|
||||||
(define-syntax gexp
|
(define-syntax gexp
|
||||||
(lambda (s)
|
(lambda (s)
|
||||||
(define (collect-escapes exp)
|
(define (collect-escapes exp)
|
||||||
|
@ -819,6 +852,7 @@ and in the current monad setting (system type, etc.)"
|
||||||
(sexp (substitute-references #'exp (zip escapes formals)))
|
(sexp (substitute-references #'exp (zip escapes formals)))
|
||||||
(refs (map escape->ref escapes)))
|
(refs (map escape->ref escapes)))
|
||||||
#`(make-gexp (list #,@refs)
|
#`(make-gexp (list #,@refs)
|
||||||
|
current-imported-modules
|
||||||
(lambda #,formals
|
(lambda #,formals
|
||||||
#,sexp)))))))
|
#,sexp)))))))
|
||||||
|
|
||||||
|
@ -960,8 +994,11 @@ they can refer to each other."
|
||||||
#:key (modules '()) (guile (default-guile)))
|
#:key (modules '()) (guile (default-guile)))
|
||||||
"Return an executable script NAME that runs EXP using GUILE with MODULES in
|
"Return an executable script NAME that runs EXP using GUILE with MODULES in
|
||||||
its search path."
|
its search path."
|
||||||
(mlet %store-monad ((modules (imported-modules modules))
|
(define %modules
|
||||||
(compiled (compiled-modules modules)))
|
(append (gexp-modules exp) modules))
|
||||||
|
|
||||||
|
(mlet %store-monad ((modules (imported-modules %modules))
|
||||||
|
(compiled (compiled-modules %modules)))
|
||||||
(gexp->derivation name
|
(gexp->derivation name
|
||||||
(gexp
|
(gexp
|
||||||
(call-with-output-file (ungexp output)
|
(call-with-output-file (ungexp output)
|
||||||
|
|
|
@ -526,6 +526,18 @@
|
||||||
get-bytevector-all))))
|
get-bytevector-all))))
|
||||||
files))))))
|
files))))))
|
||||||
|
|
||||||
|
(test-equal "gexp-modules & ungexp"
|
||||||
|
'((bar) (foo))
|
||||||
|
((@@ (guix gexp) gexp-modules)
|
||||||
|
#~(foo #$(with-imported-modules '((foo)) #~+)
|
||||||
|
#+(with-imported-modules '((bar)) #~-))))
|
||||||
|
|
||||||
|
(test-equal "gexp-modules & ungexp-splicing"
|
||||||
|
'((foo) (bar))
|
||||||
|
((@@ (guix gexp) gexp-modules)
|
||||||
|
#~(foo #$@(list (with-imported-modules '((foo)) #~+)
|
||||||
|
(with-imported-modules '((bar)) #~-)))))
|
||||||
|
|
||||||
(test-assertm "gexp->derivation #:modules"
|
(test-assertm "gexp->derivation #:modules"
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((build -> #~(begin
|
((build -> #~(begin
|
||||||
|
@ -540,6 +552,50 @@
|
||||||
(s (stat (string-append p "/guile/guix/nix"))))
|
(s (stat (string-append p "/guile/guix/nix"))))
|
||||||
(return (eq? (stat:type s) 'directory))))))
|
(return (eq? (stat:type s) 'directory))))))
|
||||||
|
|
||||||
|
(test-assertm "gexp->derivation & with-imported-modules"
|
||||||
|
;; Same test as above, but using 'with-imported-modules'.
|
||||||
|
(mlet* %store-monad
|
||||||
|
((build -> (with-imported-modules '((guix build utils))
|
||||||
|
#~(begin
|
||||||
|
(use-modules (guix build utils))
|
||||||
|
(mkdir-p (string-append #$output "/guile/guix/nix"))
|
||||||
|
#t)))
|
||||||
|
(drv (gexp->derivation "test-with-modules" build)))
|
||||||
|
(mbegin %store-monad
|
||||||
|
(built-derivations (list drv))
|
||||||
|
(let* ((p (derivation->output-path drv))
|
||||||
|
(s (stat (string-append p "/guile/guix/nix"))))
|
||||||
|
(return (eq? (stat:type s) 'directory))))))
|
||||||
|
|
||||||
|
(test-assertm "gexp->derivation & nested with-imported-modules"
|
||||||
|
(mlet* %store-monad
|
||||||
|
((build1 -> (with-imported-modules '((guix build utils))
|
||||||
|
#~(begin
|
||||||
|
(use-modules (guix build utils))
|
||||||
|
(mkdir-p (string-append #$output "/guile/guix/nix"))
|
||||||
|
#t)))
|
||||||
|
(build2 -> (with-imported-modules '((guix build bournish))
|
||||||
|
#~(begin
|
||||||
|
(use-modules (guix build bournish)
|
||||||
|
(system base compile))
|
||||||
|
#+build1
|
||||||
|
(call-with-output-file (string-append #$output "/b")
|
||||||
|
(lambda (port)
|
||||||
|
(write
|
||||||
|
(read-and-compile (open-input-string "cd /foo")
|
||||||
|
#:from %bournish-language
|
||||||
|
#:to 'scheme)
|
||||||
|
port))))))
|
||||||
|
(drv (gexp->derivation "test-with-modules" build2)))
|
||||||
|
(mbegin %store-monad
|
||||||
|
(built-derivations (list drv))
|
||||||
|
(let* ((p (derivation->output-path drv))
|
||||||
|
(s (stat (string-append p "/guile/guix/nix")))
|
||||||
|
(b (string-append p "/b")))
|
||||||
|
(return (and (eq? (stat:type s) 'directory)
|
||||||
|
(equal? '(chdir "/foo")
|
||||||
|
(call-with-input-file b read))))))))
|
||||||
|
|
||||||
(test-assertm "gexp->derivation #:references-graphs"
|
(test-assertm "gexp->derivation #:references-graphs"
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((one (text-file "one" (random-text)))
|
((one (text-file "one" (random-text)))
|
||||||
|
@ -676,11 +732,11 @@
|
||||||
|
|
||||||
(test-assertm "program-file"
|
(test-assertm "program-file"
|
||||||
(let* ((n (random (expt 2 50)))
|
(let* ((n (random (expt 2 50)))
|
||||||
(exp (gexp (begin
|
(exp (with-imported-modules '((guix build utils))
|
||||||
(use-modules (guix build utils))
|
(gexp (begin
|
||||||
(display (ungexp n)))))
|
(use-modules (guix build utils))
|
||||||
|
(display (ungexp n))))))
|
||||||
(file (program-file "program" exp
|
(file (program-file "program" exp
|
||||||
#:modules '((guix build utils))
|
|
||||||
#:guile %bootstrap-guile)))
|
#:guile %bootstrap-guile)))
|
||||||
(mlet* %store-monad ((drv (lower-object file))
|
(mlet* %store-monad ((drv (lower-object file))
|
||||||
(out -> (derivation->output-path drv)))
|
(out -> (derivation->output-path drv)))
|
||||||
|
|
Loading…
Reference in New Issue