[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/04: derivations: 'substitution-oracle' now ignores sub-trees that are
From: |
Ludovic Courtès |
Subject: |
02/04: derivations: 'substitution-oracle' now ignores sub-trees that are valid. |
Date: |
Wed, 25 Mar 2015 09:46:36 +0000 |
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))))