02/04: derivations: 'substitution-oracle' now ignores sub-trees that are valid.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit c3a450fb49da41f1225353d2ca2e652daae36939
Author: Ludovic Courtès <address@hidden>
Date:   Wed Mar 25 09:48:52 2015 +0100

    derivations: 'substitution-oracle' now ignores sub-trees that are valid.
    
    Before that, "guix build qt", when only qt itself is missing, would lead
    'substitution-oracle' to call 'substitutable-paths' with 318 items.
    Now, this is down to 6 items, because it doesn't ask about prerequisites
    that are already valid.
    
    * guix/derivations.scm (substitution-oracle)[valid-input?,
      dependencies]: New procedures.
      Use 'dependencies' and remove call to 'remove'.
---
 guix/derivations.scm |   18 +++++++++++++-----
 1 files changed, 13 insertions(+), 5 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 8daad4b..7737e39 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -249,6 +249,17 @@ substituter many times."
   (define valid?
     (cut valid-path? store <>))
 
+  (define valid-input?
+    (cut valid-derivation-input? store <>))
+
+  (define (dependencies drv)
+    ;; Skip prerequisite sub-trees of DRV whose root is valid.  This allows us
+    ;; to ask the substituter for just as much as needed, instead of asking it
+    ;; for the whole world, which can be significantly faster when substitute
+    ;; info is not already in cache.
+    (append-map derivation-input-output-paths
+                (derivation-prerequisites drv valid-input?)))
+
   (let* ((paths (delete-duplicates
                  (fold (lambda (drv result)
                          (let ((self (match (derivation->output-paths drv)
@@ -256,11 +267,8 @@ substituter many times."
                                         paths))))
                            (if (every valid? self)
                                result
-                               (let ((deps
-                                      (append-map derivation-input-output-paths
-                                                  (derivation-prerequisites 
drv))))
-                                 (append (remove valid? (append self deps))
-                                         result)))))
+                               (append (append self (dependencies drv))
+                                       result))))
                        '()
                        drv)))
          (subst (list->set (substitutable-paths store paths))))