From ff0e0041f358c0e4d0ab890f183b8a0c31727bea Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 5 Dec 2017 15:13:38 +0100 Subject: 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. --- guix/packages.scm | 20 ++++++++++++-------- 1 file 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 @@ (define* (fold-bag-dependencies proc seed bag "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 @@ (define nodes (((? 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))) -- cgit v1.2.3