diff options
| -rw-r--r-- | doc/guix.texi | 6 | ||||
| -rw-r--r-- | guix/gexp.scm | 46 | ||||
| -rw-r--r-- | tests/gexp.scm | 21 |
3 files changed, 58 insertions, 15 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index a7803a4aee..8381b388cc 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2218,13 +2218,15 @@ below allow you to do that (@pxref{The Store Monad}, for more information about monads.) @deffn {Monadic Procedure} gexp->derivation @var{name} @var{exp} @ - [#:system (%current-system)] [#:inputs '()] @ + [#:system (%current-system)] [#:target #f] [#:inputs '()] @ [#:hash #f] [#:hash-algo #f] @ [#:recursive? #f] [#:env-vars '()] [#:modules '()] @ [#:references-graphs #f] [#:local-build? #f] @ [#:guile-for-build #f] Return a derivation @var{name} that runs @var{exp} (a gexp) with -@var{guile-for-build} (a derivation) on @var{system}. +@var{guile-for-build} (a derivation) on @var{system}. 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 a list of names of Guile modules from the current diff --git a/guix/gexp.scm b/guix/gexp.scm index c9f6cbe99a..f54221feab 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -81,14 +81,20 @@ (define raw-derivation (store-lift derivation)) -(define (lower-inputs inputs) - "Turn any package from INPUTS into a derivation; return the corresponding -input list as a monadic value." +(define* (lower-inputs inputs + #:key system target) + "Turn any package from INPUTS into a derivation for SYSTEM; return the +corresponding input list as a monadic value. When TARGET is true, use it as +the cross-compilation target triplet." (with-monad %store-monad (sequence %store-monad (map (match-lambda (((? package? package) sub-drv ...) - (mlet %store-monad ((drv (package->derivation package))) + (mlet %store-monad + ((drv (if target + (package->cross-derivation package target + system) + (package->derivation package system)))) (return `(,drv ,@sub-drv)))) (((? origin? origin) sub-drv ...) (mlet %store-monad ((drv (origin->derivation origin))) @@ -99,7 +105,7 @@ input list as a monadic value." (define* (gexp->derivation name exp #:key - system + system (target 'current) hash hash-algo recursive? (env-vars '()) (modules '()) @@ -107,7 +113,8 @@ input list as a monadic value." references-graphs local-build?) "Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a -derivation) on SYSTEM. +derivation) on SYSTEM. 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 names of Guile modules from the current search path to be copied in the store, @@ -118,9 +125,21 @@ The other arguments are as for 'derivation'." (define %modules modules) (define outputs (gexp-outputs exp)) - (mlet* %store-monad ((inputs (lower-inputs (gexp-inputs exp))) + (mlet* %store-monad (;; The following binding is here to force + ;; '%current-system' and '%current-target-system' to be + ;; looked up at >>= time. + (unused (return #f)) + (system -> (or system (%current-system))) - (sexp (gexp->sexp exp)) + (target -> (if (eq? target 'current) + (%current-target-system) + target)) + (inputs (lower-inputs (gexp-inputs exp) + #:system system + #:target target)) + (sexp (gexp->sexp exp + #:system system + #:target target)) (builder (text-file (string-append name "-builder") (object->string sexp))) (modules (if (pair? %modules) @@ -199,7 +218,9 @@ The other arguments are as for 'derivation'." '() (gexp-references exp))) -(define* (gexp->sexp exp) +(define* (gexp->sexp exp #:key + (system (%current-system)) + (target (%current-target-system))) "Return (monadically) the sexp corresponding to EXP for the given OUTPUT, and in the current monad setting (system type, etc.)" (define (reference->sexp ref) @@ -208,7 +229,10 @@ and in the current monad setting (system type, etc.)" (((? derivation? drv) (? string? output)) (return (derivation->output-path drv output))) (((? package? p) (? string? output)) - (package-file p #:output output)) + (package-file p + #:output output + #:system system + #:target target)) (((? origin? o) (? string? output)) (mlet %store-monad ((drv (origin->derivation o))) (return (derivation->output-path drv output)))) @@ -218,7 +242,7 @@ and in the current monad setting (system type, etc.)" ;; that trick. (return `((@ (guile) getenv) ,output))) ((? gexp? exp) - (gexp->sexp exp)) + (gexp->sexp exp #:system system #:target target)) (((? string? str)) (return (if (direct-store-path? str) str ref))) ((refs ...) diff --git a/tests/gexp.scm b/tests/gexp.scm index bdea4b8563..9cc7d41547 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -47,8 +47,11 @@ ;; Make it the default. (%guile-for-build guile-for-build) -(define (gexp->sexp* exp) - (run-with-store %store (gexp->sexp exp) +(define* (gexp->sexp* exp #:optional + (system (%current-system)) target) + (run-with-store %store (gexp->sexp exp + #:system system + #:target target) #:guile-for-build guile-for-build)) (define-syntax-rule (test-assertm name exp) @@ -223,6 +226,20 @@ (mlet %store-monad ((drv mdrv)) (return (string=? system (derivation-system drv)))))) +(test-assertm "gexp->derivation, cross-compilation" + (mlet* %store-monad ((target -> "mips64el-linux") + (exp -> (gexp (list (ungexp coreutils) + (ungexp output)))) + (xdrv (gexp->derivation "foo" exp + #:target target)) + (refs ((store-lift references) + (derivation-file-name xdrv))) + (xcu (package->cross-derivation coreutils + target)) + (cu (package->derivation coreutils))) + (return (and (member (derivation-file-name xcu) refs) + (not (member (derivation-file-name cu) refs)))))) + (define shebang (string-append "#!" (derivation->output-path guile-for-build) "/bin/guile --no-auto-compile")) |