diff options
| -rw-r--r-- | .dir-locals.el | 1 | ||||
| -rw-r--r-- | doc/guix.texi | 38 | ||||
| -rw-r--r-- | emacs/guix-devel.el | 2 | ||||
| -rw-r--r-- | guix/gexp.scm | 47 | ||||
| -rw-r--r-- | tests/gexp.scm | 64 |
5 files changed, 142 insertions, 10 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index 0873c1d747..c7ceb9e9f0 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -59,6 +59,7 @@ (eval . (put 'run-with-store 'scheme-indent-function 1)) (eval . (put 'run-with-state '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 'container-excursion 'scheme-indent-function 1)) diff --git a/doc/guix.texi b/doc/guix.texi index c9d9bd8977..b315325034 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 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. @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.) @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} Return @code{#t} if @var{obj} is a G-expression. @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 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{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 diff --git a/emacs/guix-devel.el b/emacs/guix-devel.el index ee8371ce81..b71670cdfb 100644 --- a/emacs/guix-devel.el +++ b/emacs/guix-devel.el @@ -216,6 +216,7 @@ to find 'modify-phases' keywords." "with-derivation-substitute" "with-directory-excursion" "with-error-handling" + "with-imported-modules" "with-monad" "with-mutex" "with-store")) @@ -306,6 +307,7 @@ Each rule should have a form (SYMBOL VALUE). See `put' for details." (with-derivation-substitute 2) (with-directory-excursion 1) (with-error-handling 0) + (with-imported-modules 1) (with-monad 1) (with-mutex 1) (with-store 1) diff --git a/guix/gexp.scm b/guix/gexp.scm index c86f4d0fd3..e9274a05f4 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -29,6 +29,7 @@ #:use-module (ice-9 match) #:export (gexp gexp? + with-imported-modules gexp-input gexp-input? @@ -98,9 +99,10 @@ ;; "G expressions". (define-record-type <gexp> - (make-gexp references proc) + (make-gexp references modules proc) gexp? (references gexp-references) ;list of <gexp-input> + (modules gexp-self-modules) ;list of module names (proc gexp-proc)) ;procedure (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) +(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 (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 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, compiled, and made available in the load path during the execution of 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. 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 (graphs-file-names graphs) @@ -724,6 +746,17 @@ and in the current monad setting (system type, etc.)" (simple-format #f "~a:~a" line column))) "<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 (lambda (s) (define (collect-escapes exp) @@ -819,6 +852,7 @@ and in the current monad setting (system type, etc.)" (sexp (substitute-references #'exp (zip escapes formals))) (refs (map escape->ref escapes))) #`(make-gexp (list #,@refs) + current-imported-modules (lambda #,formals #,sexp))))))) @@ -960,8 +994,11 @@ they can refer to each other." #:key (modules '()) (guile (default-guile))) "Return an executable script NAME that runs EXP using GUILE with MODULES in its search path." - (mlet %store-monad ((modules (imported-modules modules)) - (compiled (compiled-modules modules))) + (define %modules + (append (gexp-modules exp) modules)) + + (mlet %store-monad ((modules (imported-modules %modules)) + (compiled (compiled-modules %modules))) (gexp->derivation name (gexp (call-with-output-file (ungexp output) diff --git a/tests/gexp.scm b/tests/gexp.scm index f44f0eaf9a..36ce66f7cc 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -526,6 +526,18 @@ get-bytevector-all)))) 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" (mlet* %store-monad ((build -> #~(begin @@ -540,6 +552,50 @@ (s (stat (string-append p "/guile/guix/nix")))) (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" (mlet* %store-monad ((one (text-file "one" (random-text))) @@ -676,11 +732,11 @@ (test-assertm "program-file" (let* ((n (random (expt 2 50))) - (exp (gexp (begin - (use-modules (guix build utils)) - (display (ungexp n))))) + (exp (with-imported-modules '((guix build utils)) + (gexp (begin + (use-modules (guix build utils)) + (display (ungexp n)))))) (file (program-file "program" exp - #:modules '((guix build utils)) #:guile %bootstrap-guile))) (mlet* %store-monad ((drv (lower-object file)) (out -> (derivation->output-path drv))) |