summaryrefslogtreecommitdiff
path: root/guix/build-system
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-06-25 20:54:56 +0200
committerLudovic Courtès <ludo@gnu.org>2013-06-25 20:54:56 +0200
commit7e873a6708779481e2c2baa82ddbd8fcf232db5f (patch)
tree10860fb56fbc77abaa983c62482d620ae47bd74b /guix/build-system
parentac5c1cec868b3a3a0f7bc4b06f101c9913361130 (diff)
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.
Diffstat (limited to 'guix/build-system')
-rw-r--r--guix/build-system/gnu.scm82
1 files changed, 50 insertions, 32 deletions
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index 78e8bf0652..434a6dd5e0 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -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."
- (define rewritten-input
- (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))
+ #: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))))
- (define (filtered-inputs inputs)
- (fold alist-delete inputs boot-input-names))
+ (let loop ((p p))
+ (define rewritten-input
+ (memoize
+ (match-lambda
+ ((name (? package? p) sub-drv ...)
+ (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
- ,@(map rewritten-input
- (filtered-inputs (package-inputs p)))))))
+ (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
+ (let ((filtered (duplicate-filter native-inputs*)))
+ `(,@(call native-inputs*)
+ ,@(map rewritten-input
+ (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'