diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-12-05 15:13:38 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-12-05 15:13:38 +0100 |
| commit | ff0e0041f358c0e4d0ab890f183b8a0c31727bea (patch) | |
| tree | 17a7e500e8af629e15e00639e94fb59b03d1d5c3 | |
| parent | f00b85ff8d34df0a1879e593d4a85629b8586af7 (diff) | |
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.scm | 20 |
1 files changed, 12 insertions, 8 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index d68af1569ff..c6d3b811f21 100644 --- a/guix/packages.scm +++ b/guix/packages.scm | |||
| @@ -996,14 +996,18 @@ and return it." | |||
| 996 | "Fold PROC over the packages BAG depends on. Each package is visited only | 996 | "Fold PROC over the packages BAG depends on. Each package is visited only |
| 997 | once, in depth-first order. If NATIVE? is true, restrict to native | 997 | once, in depth-first order. If NATIVE? is true, restrict to native |
| 998 | dependencies; otherwise, restrict to target dependencies." | 998 | dependencies; otherwise, restrict to target dependencies." |
| 999 | (define bag-direct-inputs* | ||
| 1000 | (if native? | ||
| 1001 | (lambda (bag) | ||
| 1002 | (append (bag-build-inputs bag) | ||
| 1003 | (bag-target-inputs bag) | ||
| 1004 | (if (bag-target bag) | ||
| 1005 | '() | ||
| 1006 | (bag-host-inputs bag)))) | ||
| 1007 | bag-host-inputs)) | ||
| 1008 | |||
| 999 | (define nodes | 1009 | (define nodes |
| 1000 | (match (if native? | 1010 | (match (bag-direct-inputs* bag) |
| 1001 | (append (bag-build-inputs bag) | ||
| 1002 | (bag-target-inputs bag) | ||
| 1003 | (if (bag-target bag) | ||
| 1004 | '() | ||
| 1005 | (bag-host-inputs bag))) | ||
| 1006 | (bag-host-inputs bag)) | ||
| 1007 | (((labels things _ ...) ...) | 1011 | (((labels things _ ...) ...) |
| 1008 | things))) | 1012 | things))) |
| 1009 | 1013 | ||
| @@ -1016,7 +1020,7 @@ dependencies; otherwise, restrict to target dependencies." | |||
| 1016 | (((? package? head) . tail) | 1020 | (((? package? head) . tail) |
| 1017 | (if (set-contains? visited head) | 1021 | (if (set-contains? visited head) |
| 1018 | (loop tail result visited) | 1022 | (loop tail result visited) |
| 1019 | (let ((inputs (bag-direct-inputs (package->bag head)))) | 1023 | (let ((inputs (bag-direct-inputs* (package->bag head)))) |
| 1020 | (loop (match inputs | 1024 | (loop (match inputs |
| 1021 | (((labels things _ ...) ...) | 1025 | (((labels things _ ...) ...) |
| 1022 | (append things tail))) | 1026 | (append things tail))) |
