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.

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'