diff options
| -rw-r--r-- | guix/build-system/gnu.scm | 82 |
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' |