packages: Rewrite 'transitive-inputs' to be linear and remove duplicates.

There were two issues:

  1. Use of 'delete-duplicates', which is quadratic, was a serious problem for
     closures with lots of propagated inputs, such as that of the 'hydra'
     package (several minutes for 'guix build hydra -n'!).

  2. The 'delete-duplicates' call essentially had no effect since duplicate
     inputs typically had a different label and were thus kept.  For
     instance, (bag-transitive-inputs (package->bag inkscape)) would return
     216 items whereas (delete-duplicates (map cdr THAT)) contains only 67
     items.

     The new implementation returns 67 items in this case.  For 'hydra', we're
     down from 42211 items to 361, and roughly 13s for 'guix build hydra'.

* guix/packages.scm (transitive-inputs): Rewrite as a breadth-first
  traversal.  Remove duplicate propagated inputs.
* tests/packages.scm ("package-transitive-inputs", "package->bag, propagated
  inputs"): Adjust to use simple labels for propagated inputs, without "/".
  ("package-transitive-inputs, no duplicates"): New test.
This commit is contained in:
Ludovic Courtès 2015-07-11 23:13:24 +02:00
parent 686784d0b9
commit 161094c8e2
2 changed files with 54 additions and 16 deletions

View file

@ -491,21 +491,37 @@ (define (first-file directory)
#:guile-for-build guile-for-build))))
(define (transitive-inputs inputs)
"Return the closure of INPUTS when considering the 'propagated-inputs'
edges. Omit duplicate inputs, except for those already present in INPUTS
itself.
This is implemented as a breadth-first traversal such that INPUTS is
preserved, and only duplicate propagated inputs are removed."
(define (seen? seen item outputs)
(match (vhash-assq item seen)
((_ . o) (equal? o outputs))
(_ #f)))
(let loop ((inputs inputs)
(result '()))
(result '())
(propagated '())
(first? #t)
(seen vlist-null))
(match inputs
(()
(delete-duplicates (reverse result))) ; XXX: efficiency
(((and i (name (? package? p) sub ...)) rest ...)
(let ((t (map (match-lambda
((dep-name derivation ...)
(cons (string-append name "/" dep-name)
derivation)))
(package-propagated-inputs p))))
(loop (append t rest)
(append t (cons i result)))))
(if (null? propagated)
(reverse result)
(loop (reverse (concatenate propagated)) result '() #f seen)))
(((and input (label (? package? package) outputs ...)) rest ...)
(if (and (not first?) (seen? seen package outputs))
(loop rest result propagated first? seen)
(loop rest
(cons input result)
(cons (package-propagated-inputs package) propagated)
first?
(vhash-consq package outputs seen))))
((input rest ...)
(loop rest (cons input result))))))
(loop rest (cons input result) propagated first? seen)))))
(define (package-direct-sources package)
"Return all source origins associated with PACKAGE; including origins in

View file

@ -118,10 +118,32 @@ (define read-at
(equal? `(("a" ,a)) (package-transitive-inputs c))
(equal? (package-propagated-inputs d)
(package-transitive-inputs d))
(equal? `(("b" ,b) ("b/a" ,a) ("c" ,c)
("d" ,d) ("d/x" "something.drv"))
(equal? `(("b" ,b) ("c" ,c) ("d" ,d)
("a" ,a) ("x" "something.drv"))
(pk 'x (package-transitive-inputs e))))))
(test-assert "package-transitive-inputs, no duplicates"
(let* ((a (dummy-package "a"))
(b (dummy-package "b"
(inputs `(("a+" ,a)))
(native-inputs `(("a*" ,a)))
(propagated-inputs `(("a" ,a)))))
(c (dummy-package "c"
(propagated-inputs `(("b" ,b)))))
(d (dummy-package "d"
(inputs `(("a" ,a) ("c" ,c)))))
(e (dummy-package "e"
(inputs `(("b" ,b) ("c" ,c))))))
(and (null? (package-transitive-inputs a))
(equal? `(("a*" ,a) ("a+" ,a) ("a" ,a)) ;here duplicates are kept
(package-transitive-inputs b))
(equal? `(("b" ,b) ("a" ,a))
(package-transitive-inputs c))
(equal? `(("a" ,a) ("c" ,c) ("b" ,b)) ;duplicate A removed
(package-transitive-inputs d))
(equal? `(("b" ,b) ("c" ,c) ("a" ,a))
(package-transitive-inputs e))))) ;ditto
(test-equal "package-transitive-supported-systems"
'(("x" "y" "z") ;a
("x" "y") ;b
@ -573,8 +595,8 @@ (define read-at
(dummy (dummy-package "dummy"
(inputs `(("prop" ,prop)))))
(inputs (bag-transitive-inputs (package->bag dummy #:graft? #f))))
(match (assoc "prop/dep" inputs)
(("prop/dep" package)
(match (assoc "dep" inputs)
(("dep" package)
(eq? package dep)))))
(test-assert "bag->derivation"