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

[Ludovic Courtès]

civodul pushed a commit to branch core-updates
in repository guix.

commit 161094c8e2b46128544b85dae8e97d4fcb2818c0
Author: Ludovic Courtès <address@hidden>
Date:   Sat Jul 11 23:13:24 2015 +0200

    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.
---
 guix/packages.scm  |   40 ++++++++++++++++++++++++++++------------
 tests/packages.scm |   30 ++++++++++++++++++++++++++----
 2 files changed, 54 insertions(+), 16 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index 5a28085..3422272 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -491,21 +491,37 @@ IMPORTED-MODULES specify modules to use/import for use by 
SNIPPET."
                         #:guile-for-build guile-for-build))))
 
 (define (transitive-inputs inputs)
-  (let loop ((inputs  inputs)
-             (result '()))
+  "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     '())
+             (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
diff --git a/tests/packages.scm b/tests/packages.scm
index 511ad78..3cb532d 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -118,10 +118,32 @@
          (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 @@
          (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"