diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-03-24 22:47:25 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-03-24 23:22:23 +0100 |
| commit | c7d1d88f6c75f9ba67caa624976dbad2980856ef (patch) | |
| tree | 3e0ad90854b1fd1e6485e0f76a2ba5b7e5836c97 /guix/derivations.scm | |
| parent | b655b2154c8a72f5c9b7e54594653df49f3c2c02 (diff) | |
| download | gnu-guix-c7d1d88f6c75f9ba67caa624976dbad2980856ef.tar gnu-guix-c7d1d88f6c75f9ba67caa624976dbad2980856ef.tar.gz | |
derivations: Don't invoke the substituter when an item is already in store.
Fixes <http://bugs.gnu.org/20188>.
Reported by Mark H Weaver <mhw@netris.org>.
* guix/derivations.scm (substitution-oracle): Add 'valid?' procedure.
Remove 'valid?' items from PATHS.
Diffstat (limited to 'guix/derivations.scm')
| -rw-r--r-- | guix/derivations.scm | 20 |
1 files changed, 13 insertions, 7 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm index 4b0048b54b..9b5ee367b6 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -225,22 +225,28 @@ download with a fixed hash (aka. `fetchurl')." (define* (substitution-oracle store drv) "Return a one-argument procedure that, when passed a store file name, returns #t if it's substitutable and #f otherwise. The returned procedure -knows about all substitutes for all the derivations listed in DRV and their -prerequisites. +knows about all substitutes for all the derivations listed in DRV; it also +knows about their prerequisites, unless they are themselves substitutable. Creating a single oracle (thus making a single 'substitutable-paths' call) and reusing it is much more efficient than calling 'has-substitutes?' or similar repeatedly, because it avoids the costs associated with launching the substituter many times." + (define valid? + (cut valid-path? store <>)) + (let* ((paths (delete-duplicates (fold (lambda (drv result) (let ((self (match (derivation->output-paths drv) (((names . paths) ...) - paths))) - (deps (append-map derivation-input-output-paths - (derivation-prerequisites - drv)))) - (append self deps result))) + paths)))) + (if (every valid? self) + result + (let ((deps + (append-map derivation-input-output-paths + (derivation-prerequisites drv)))) + (append (remove valid? (append self deps)) + result))))) '() drv))) (subst (list->set (substitutable-paths store paths)))) |