diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-03-25 09:48:52 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-03-25 10:46:22 +0100 |
| commit | c3a450fb49da41f1225353d2ca2e652daae36939 (patch) | |
| tree | d5fedab638b6e28cab5b499ccb89fe198ab7378e | |
| parent | 3681db5d2c3c40f8796703325242998bbdb48403 (diff) | |
| download | guix-c3a450fb49da41f1225353d2ca2e652daae36939.tar guix-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.scm | 18 |
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)))) |