build-system/{gnu,trivial}: Add a `#:guile' keyword parameter.

* guix/build-system/gnu.scm (package-with-explicit-inputs): New `guile'
  keyword parameter.  Add it to P's arguments, and pass it in recursive
  calls.
  (gnu-build): New `guile' keyword parameter; new `guile-for-build'
  variable.  Pass it as the `#:guile-for-build' parameter of
  `build-expression->derivation'.

* guix/build-system/trivial.scm (trivial-build): Likewise.
This commit is contained in:
Ludovic Courtès 2012-10-06 01:24:46 +02:00
parent db1a15314d
commit 12d5aa0f5a
2 changed files with 47 additions and 11 deletions

View File

@ -38,13 +38,18 @@
(define* (package-with-explicit-inputs p boot-inputs
#:optional
(loc (current-source-location)))
"Rewrite P, which is assumed to use GNU-BUILD-SYSTEM, to take BOOT-INPUTS
as explicit inputs instead of the implicit default, and return it."
(loc (current-source-location))
#:key guile)
"Rewrite P, which is assumed to use GNU-BUILD-SYSTEM, to take
BOOT-INPUTS as explicit inputs instead of the implicit default, and
return it. Use GUILE to run the builder, or the distro's final Guile
when GUILE is #f."
(define rewritten-input
(match-lambda
((name (? package? p) sub-drv ...)
(cons* name (package-with-explicit-inputs p boot-inputs) sub-drv))
(cons* name
(package-with-explicit-inputs p boot-inputs #:guile guile)
sub-drv))
(x x)))
(define boot-input-names
@ -59,8 +64,10 @@ as explicit inputs instead of the implicit default, and return it."
(let ((args (package-arguments p)))
(if (procedure? args)
(lambda (system)
`(#:implicit-inputs? #f ,@(args system)))
`(#:implicit-inputs? #f ,@args))))
`(#:guile ,guile
#:implicit-inputs? #f ,@(args system)))
`(#:guile ,guile
#:implicit-inputs? #f ,@args))))
(native-inputs (map rewritten-input
(filtered-inputs (package-native-inputs p))))
(propagated-inputs (map rewritten-input
@ -97,7 +104,8 @@ System: GCC, GNU Make, Bash, Coreutils, etc."
inputs)))))))
(define* (gnu-build store name source inputs
#:key (outputs '("out")) (configure-flags ''())
#:key (guile #f)
(outputs '("out")) (configure-flags ''())
(make-flags ''())
(patches ''()) (patch-flags ''("--batch" "-p1"))
(out-of-source? #f)
@ -115,7 +123,9 @@ System: GCC, GNU Make, Bash, Coreutils, etc."
(modules '((guix build gnu-build-system)
(guix build utils))))
"Return a derivation called NAME that builds from tarball SOURCE, with
input derivation INPUTS, using the usual procedure of the GNU Build System."
input derivation INPUTS, using the usual procedure of the GNU Build
System. The builder is run with GUILE, or with the distro's final Guile
package if GUILE is #f or omitted."
(define builder
`(begin
(use-modules ,@modules)
@ -139,6 +149,17 @@ input derivation INPUTS, using the usual procedure of the GNU Build System."
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(define guile-for-build
(match guile
(#f ; the default
(let* ((distro (resolve-interface '(distro packages base)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))
((? package?)
(package-derivation store guile system))
((? derivation-path?)
guile)))
(build-expression->derivation store name system
builder
`(("source" ,source)
@ -148,7 +169,8 @@ input derivation INPUTS, using the usual procedure of the GNU Build System."
(standard-inputs system))
'()))
#:outputs outputs
#:modules modules))
#:modules modules
#:guile-for-build guile-for-build))
(define gnu-build-system
(build-system (name 'gnu)

View File

@ -20,16 +20,30 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix build-system)
#:use-module (ice-9 match)
#:export (trivial-build-system))
(define* (trivial-build store name source inputs
#:key outputs system builder (modules '()))
#:key outputs guile system builder (modules '()))
"Run build expression BUILDER, an expression, for SYSTEM. SOURCE is
ignored."
(define guile-for-build
(match guile
(#f ; the default
(let* ((distro (resolve-interface '(distro packages base)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))
((? package?)
(package-derivation store guile system))
((? derivation-path?)
guile)))
(build-expression->derivation store name system builder inputs
#:outputs outputs
#:modules modules))
#:modules modules
#:guile-for-build guile-for-build))
(define trivial-build-system
(build-system (name 'trivial)