ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

packages: 'fold-bag-dependencies' honors nativeness in recursive calls.

Browse source 
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:
Ludovic Courtès 2017-12-05 15:13:38 +01:00
parent f00b85ff8d
commit ff0e0041f3
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 12 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
guix/packages.scm
View file

@ -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)))