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:
Ludovic Courtès 2016-07-03 22:26:19 +02:00
parent affd7761f3
commit 0bb9929eaa
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
5 changed files with 142 additions and 10 deletions

View File

@ -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))

View File

@ -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

View File

@ -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)

View File

@ -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)

View File

@ -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))
(gexp (begin
(use-modules (guix build utils)) (use-modules (guix build utils))
(display (ungexp n))))) (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)))