aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-07-05 00:09:27 +0200
committerLudovic Courtès <ludo@gnu.org>2019-07-05 00:51:17 +0200
commitd74392a85cfd0992d034b903ca21180a6d73eaed (patch)
tree7bf180de016fa04c71d0847c90b616ebd57eda11
parentb1510fd8d252c1ab0d32a32f064513105b99cf39 (diff)
downloadguix-d74392a85cfd0992d034b903ca21180a6d73eaed.tar
guix-d74392a85cfd0992d034b903ca21180a6d73eaed.tar.gz
derivations: Simplify 'substitution-oracle'.
* guix/derivations.scm (substitution-oracle)[valid?, dependencies]: Remove. [closure]: New procedure. Rename parameter from 'drv' to 'inputs-or-drv' and adjust accordingly. (derivation-build-plan): Pass INPUTS directly to 'substitution-oracle'. * guix/ui.scm (show-what-to-build)[substitutable-info]: Likewise.
-rw-r--r--guix/derivations.scm86
-rw-r--r--guix/ui.scm3
2 files changed, 41 insertions, 48 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm
index caa76bd16c..731f1f698f 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -293,60 +293,57 @@ result is the set of prerequisites of DRV not already in valid."
(derivation-output-path (assoc-ref outputs sub-drv)))
sub-drvs))))
-(define* (substitution-oracle store drv
+(define* (substitution-oracle store inputs-or-drv
#:key (mode (build-mode normal)))
"Return a one-argument procedure that, when passed a store file name,
returns a 'substitutable?' if it's substitutable and #f otherwise.
-The returned procedure
-knows about all substitutes for all the derivations listed in DRV, *except*
-those that are already valid (that is, it won't bother checking whether an
-item is substitutable if it's already on disk); it also knows about their
-prerequisites, unless they are themselves substitutable.
+
+The returned procedure knows about all substitutes for all the derivation
+inputs or derivations listed in INPUTS-OR-DRV, *except* those that are already
+valid (that is, it won't bother checking whether an item is substitutable if
+it's already on disk); it also knows about their prerequisites, unless they
+are themselves substitutable.
Creating a single oracle (thus making a single 'substitutable-path-info' 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 <>))
-
(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.
- ;; Also, skip derivations marked as non-substitutable.
- (append-map (lambda (input)
+ (define (closure inputs)
+ (let loop ((inputs inputs)
+ (closure '())
+ (visited (set)))
+ (match inputs
+ (()
+ (reverse closure))
+ ((input rest ...)
+ (let ((key (derivation-input-key input)))
+ (cond ((set-contains? visited key)
+ (loop rest closure visited))
+ ((valid-input? input)
+ (loop rest closure (set-insert key visited)))
+ (else
(let ((drv (derivation-input-derivation input)))
- (if (substitutable-derivation? drv)
- (derivation-input-output-paths input)
- '())))
- (derivation-prerequisites drv valid-input?)))
-
- (let* ((paths (delete-duplicates
- (concatenate
- (fold (lambda (drv result)
- (let ((self (match (derivation->output-paths drv)
- (((names . paths) ...)
- paths))))
- (cond ((eqv? mode (build-mode check))
- (cons (dependencies drv) result))
- ((not (substitutable-derivation? drv))
- (cons (dependencies drv) result))
- ((every valid? self)
- result)
- (else
- (cons* self (dependencies drv) result)))))
- '()
- drv))))
- (subst (fold (lambda (subst vhash)
- (vhash-cons (substitutable-path subst) subst
- vhash))
- vlist-null
- (substitutable-path-info store paths))))
+ (loop (append (derivation-inputs drv) rest)
+ (if (substitutable-derivation? drv)
+ (cons input closure)
+ closure)
+ (set-insert key visited))))))))))
+
+ (let* ((inputs (closure (map (match-lambda
+ ((? derivation-input? input)
+ input)
+ ((? derivation? drv)
+ (derivation-input drv)))
+ inputs-or-drv)))
+ (items (append-map derivation-input-output-paths inputs))
+ (subst (fold (lambda (subst vhash)
+ (vhash-cons (substitutable-path subst) subst
+ vhash))
+ vlist-null
+ (substitutable-path-info store items))))
(lambda (item)
(match (vhash-assoc item subst)
(#f #f)
@@ -367,10 +364,7 @@ of SUBSTITUTABLES."
(mode (build-mode normal))
(substitutable-info
(substitution-oracle
- store
- (map derivation-input-derivation
- inputs)
- #:mode mode)))
+ store inputs #:mode mode)))
"Given INPUTS, a list of derivation-inputs, return two values: the list of
derivation to build, and the list of substitutable items that, together,
allows INPUTS to be realized.
diff --git a/guix/ui.scm b/guix/ui.scm
index 2ce82ff658..7d6ab9a2a7 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -835,8 +835,7 @@ check and report what is prerequisites are available for download."
;; substituter many times. This makes a big difference, especially when
;; DRV is a long list as is the case with 'guix environment'.
(if use-substitutes?
- (substitution-oracle store (map derivation-input-derivation inputs)
- #:mode mode)
+ (substitution-oracle store inputs #:mode mode)
(const #f)))
(let*-values (((build download)