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

View File

@ -20,16 +20,30 @@
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix build-system) #:use-module (guix build-system)
#:use-module (ice-9 match)
#:export (trivial-build-system)) #:export (trivial-build-system))
(define* (trivial-build store name source inputs (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 "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is
ignored." 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 (build-expression->derivation store name system builder inputs
#:outputs outputs #:outputs outputs
#:modules modules)) #:modules modules
#:guile-for-build guile-for-build))
(define trivial-build-system (define trivial-build-system
(build-system (name 'trivial) (build-system (name 'trivial)