summaryrefslogtreecommitdiff
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)
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 8daad4b81d5..7737e39b2d6 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -249,6 +249,17 @@ substituter many times."
249 (define valid? 249 (define valid?
250 (cut valid-path? store <>)) 250 (cut valid-path? store <>))
251 251
252 (define valid-input?
253 (cut valid-derivation-input? store <>))
254
255 (define (dependencies drv)
256 ;; Skip prerequisite sub-trees of DRV whose root is valid. This allows us
257 ;; to ask the substituter for just as much as needed, instead of asking it
258 ;; for the whole world, which can be significantly faster when substitute
259 ;; info is not already in cache.
260 (append-map derivation-input-output-paths
261 (derivation-prerequisites drv valid-input?)))
262
252 (let* ((paths (delete-duplicates 263 (let* ((paths (delete-duplicates
253 (fold (lambda (drv result) 264 (fold (lambda (drv result)
254 (let ((self (match (derivation->output-paths drv) 265 (let ((self (match (derivation->output-paths drv)
@@ -256,11 +267,8 @@ substituter many times."
256 paths)))) 267 paths))))
257 (if (every valid? self) 268 (if (every valid? self)
258 result 269 result
259 (let ((deps 270 (append (append self (dependencies drv))
260 (append-map derivation-input-output-paths 271 result))))
261 (derivation-prerequisites drv))))
262 (append (remove valid? (append self deps))
263 result)))))
264 '() 272 '()
265 drv))) 273 drv)))
266 (subst (list->set (substitutable-paths store paths)))) 274 (subst (list->set (substitutable-paths store paths))))