nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

gexp: Add #:target parameter to 'gexp->derivation'. 

* guix/gexp.scm (lower-inputs): Add #:system and #:target.  Use
  'package->cross-derivation' when TARGET is true.  Honor SYSTEM.
  (gexp->derivation): Add #:target argument.  Pass SYSTEM and TARGET to
  'lower-inputs' and 'gexp->sexp'.
  (gexp->sexp): Add #:system and #:target.  Pass them in recursive call
  and to 'package-file'.
* tests/gexp.scm (gexp->sexp*): Add 'system' and 'target' parameters.
  ("gexp->derivation, cross-compilation"): New test.
This commit is contained in:
Ludovic Courtès 2014-08-17 21:20:11 +02:00
parent c90ddc8f81
commit 68a61e9ffb
3 changed files with 58 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
doc/guix.texi
View File

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

46
guix/gexp.scm
View File

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

21
tests/gexp.scm
View File

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