summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-12-05 15:13:38 +0100
committerLudovic Courtès <ludo@gnu.org>2017-12-05 15:13:38 +0100
commitff0e0041f358c0e4d0ab890f183b8a0c31727bea (patch)
tree17a7e500e8af629e15e00639e94fb59b03d1d5c3
parentf00b85ff8d34df0a1879e593d4a85629b8586af7 (diff)
downloadguix-ff0e0041f358c0e4d0ab890f183b8a0c31727bea.tar.gz
packages: 'fold-bag-dependencies' honors nativeness in recursive calls.
Previously recursive calls to 'loop' would always consider all the bag
inputs rather than those corresponding to NATIVE?.

* guix/packages.scm (fold-bag-dependencies)[bag-direct-inputs*]: New
procedure.  Use it both in the 'match' expression and in its body.
-rw-r--r--guix/packages.scm20
1 files changed, 12 insertions, 8 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index d68af1569f..c6d3b811f2 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -996,14 +996,18 @@ and return it."
   "Fold PROC over the packages BAG depends on.  Each package is visited only
 once, in depth-first order.  If NATIVE? is true, restrict to native
 dependencies; otherwise, restrict to target dependencies."
+  (define bag-direct-inputs*
+    (if native?
+        (lambda (bag)
+          (append (bag-build-inputs bag)
+                  (bag-target-inputs bag)
+                  (if (bag-target bag)
+                      '()
+                      (bag-host-inputs bag))))
+        bag-host-inputs))
+
   (define nodes
-    (match (if native?
-               (append (bag-build-inputs bag)
-                       (bag-target-inputs bag)
-                       (if (bag-target bag)
-                           '()
-                           (bag-host-inputs bag)))
-               (bag-host-inputs bag))
+    (match (bag-direct-inputs* bag)
       (((labels things _ ...) ...)
        things)))
 
@@ -1016,7 +1020,7 @@ dependencies; otherwise, restrict to target dependencies."
       (((? package? head) . tail)
        (if (set-contains? visited head)
            (loop tail result visited)
-           (let ((inputs (bag-direct-inputs (package->bag head))))
+           (let ((inputs (bag-direct-inputs* (package->bag head))))
              (loop (match inputs
                      (((labels things _ ...) ...)
                       (append things tail)))