build-system/gnu: Augment `package-with-explicit-inputs' for cross builds.
* guix/build-system/gnu.scm (package-with-explicit-inputs): Add `native-inputs' keyword parameter. Allow INPUTS and NATIVE-INPUTS to be thunks.
This commit is contained in:
parent
ac5c1cec86
commit
7e873a6708
|
@ -41,42 +41,60 @@
|
|||
;;
|
||||
;; Code:
|
||||
|
||||
(define* (package-with-explicit-inputs p boot-inputs
|
||||
(define* (package-with-explicit-inputs p inputs
|
||||
#:optional
|
||||
(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."
|
||||
#:key (native-inputs '())
|
||||
guile)
|
||||
"Rewrite P, which is assumed to use GNU-BUILD-SYSTEM, to take INPUTS and
|
||||
NATIVE-INPUTS as explicit inputs instead of the implicit default, and return
|
||||
it. INPUTS and NATIVE-INPUTS can be either input lists or thunks; in the
|
||||
latter case, they will be called in a context where the `%current-system' and
|
||||
`%current-target-system' are suitably parametrized. Use GUILE to run the
|
||||
builder, or the distro's final Guile when GUILE is #f."
|
||||
(define inputs* inputs)
|
||||
(define native-inputs* native-inputs)
|
||||
|
||||
(define (call inputs)
|
||||
(if (procedure? inputs)
|
||||
(inputs)
|
||||
inputs))
|
||||
|
||||
(define (duplicate-filter inputs)
|
||||
(let ((names (match (call inputs)
|
||||
(((name _ ...) ...)
|
||||
name))))
|
||||
(lambda (inputs)
|
||||
(fold alist-delete inputs names))))
|
||||
|
||||
(let loop ((p p))
|
||||
(define rewritten-input
|
||||
(memoize
|
||||
(match-lambda
|
||||
((name (? package? p) sub-drv ...)
|
||||
(cons* name
|
||||
(package-with-explicit-inputs p boot-inputs #:guile guile)
|
||||
sub-drv))
|
||||
(x x)))
|
||||
|
||||
(define boot-input-names
|
||||
(map car boot-inputs))
|
||||
|
||||
(define (filtered-inputs inputs)
|
||||
(fold alist-delete inputs boot-input-names))
|
||||
(cons* name (loop p) sub-drv))
|
||||
(x x))))
|
||||
|
||||
(package (inherit p)
|
||||
(location (if (pair? loc) (source-properties->location loc) loc))
|
||||
(arguments
|
||||
(let ((args (package-arguments p)))
|
||||
`(#:guile ,guile
|
||||
#:implicit-inputs? #f ,@args)))
|
||||
(native-inputs (map rewritten-input
|
||||
(filtered-inputs (package-native-inputs p))))
|
||||
(propagated-inputs (map rewritten-input
|
||||
(filtered-inputs
|
||||
(package-propagated-inputs p))))
|
||||
(inputs `(,@boot-inputs
|
||||
#:implicit-inputs? #f
|
||||
,@args)))
|
||||
(native-inputs
|
||||
(let ((filtered (duplicate-filter native-inputs*)))
|
||||
`(,@(call native-inputs*)
|
||||
,@(map rewritten-input
|
||||
(filtered-inputs (package-inputs p)))))))
|
||||
(filtered (package-native-inputs p))))))
|
||||
(propagated-inputs
|
||||
(map rewritten-input
|
||||
(package-propagated-inputs p)))
|
||||
(inputs
|
||||
(let ((filtered (duplicate-filter inputs*)))
|
||||
`(,@(call inputs*)
|
||||
,@(map rewritten-input
|
||||
(filtered (package-inputs p)))))))))
|
||||
|
||||
(define (package-with-extra-configure-variable p variable value)
|
||||
"Return a version of P with VARIABLE=VALUE specified as an extra `configure'
|
||||
|
|
Loading…
Reference in New Issue