summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-03-25 09:48:52 +0100
committerLudovic Courtès <ludo@gnu.org>2015-03-25 10:46:22 +0100
commitc3a450fb49da41f1225353d2ca2e652daae36939 (patch)
treed5fedab638b6e28cab5b499ccb89fe198ab7378e
parent3681db5d2c3c40f8796703325242998bbdb48403 (diff)
downloadguix-c3a450fb49da41f1225353d2ca2e652daae36939.tar.gz
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'.
-rw-r--r--guix/derivations.scm18
1 files changed, 13 insertions, 5 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 8daad4b81d..7737e39b2d 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))))