~ruther/guix-local

ff0e0041f358c0e4d0ab890f183b8a0c31727bea — Ludovic Courtès 8 years ago f00b85f
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.
1 files changed, 12 insertions(+), 8 deletions(-)

M guix/packages.scm
M guix/packages.scm => guix/packages.scm +12 -8
@@ 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)))