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.
This commit is contained in:
parent
f00b85ff8d
commit
ff0e0041f3
@ -996,14 +996,18 @@ and return it."
|
|||||||
"Fold PROC over the packages BAG depends on. Each package is visited only
|
"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
|
once, in depth-first order. If NATIVE? is true, restrict to native
|
||||||
dependencies; otherwise, restrict to target dependencies."
|
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
|
(define nodes
|
||||||
(match (if native?
|
(match (bag-direct-inputs* bag)
|
||||||
(append (bag-build-inputs bag)
|
|
||||||
(bag-target-inputs bag)
|
|
||||||
(if (bag-target bag)
|
|
||||||
'()
|
|
||||||
(bag-host-inputs bag)))
|
|
||||||
(bag-host-inputs bag))
|
|
||||||
(((labels things _ ...) ...)
|
(((labels things _ ...) ...)
|
||||||
things)))
|
things)))
|
||||||
|
|
||||||
@ -1016,7 +1020,7 @@ dependencies; otherwise, restrict to target dependencies."
|
|||||||
(((? package? head) . tail)
|
(((? package? head) . tail)
|
||||||
(if (set-contains? visited head)
|
(if (set-contains? visited head)
|
||||||
(loop tail result visited)
|
(loop tail result visited)
|
||||||
(let ((inputs (bag-direct-inputs (package->bag head))))
|
(let ((inputs (bag-direct-inputs* (package->bag head))))
|
||||||
(loop (match inputs
|
(loop (match inputs
|
||||||
(((labels things _ ...) ...)
|
(((labels things _ ...) ...)
|
||||||
(append things tail)))
|
(append things tail)))
|
||||||
|
Loading…
Reference in New Issue
Block a user