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.
This commit is contained in:
Ludovic Courtès 2019-07-05 00:09:27 +02:00
parent b1510fd8d2
commit d74392a85c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 40 additions and 47 deletions

View File

@ -293,60 +293,57 @@ result is the set of prerequisites of DRV not already in valid."
(derivation-output-path (assoc-ref outputs sub-drv))) (derivation-output-path (assoc-ref outputs sub-drv)))
sub-drvs)))) sub-drvs))))
(define* (substitution-oracle store drv (define* (substitution-oracle store inputs-or-drv
#:key (mode (build-mode normal))) #:key (mode (build-mode normal)))
"Return a one-argument procedure that, when passed a store file name, "Return a one-argument procedure that, when passed a store file name,
returns a 'substitutable?' if it's substitutable and #f otherwise. 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* The returned procedure knows about all substitutes for all the derivation
those that are already valid (that is, it won't bother checking whether an inputs or derivations listed in INPUTS-OR-DRV, *except* those that are already
item is substitutable if it's already on disk); it also knows about their valid (that is, it won't bother checking whether an item is substitutable if
prerequisites, unless they are themselves substitutable. 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 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 reusing it is much more efficient than calling 'has-substitutes?' or similar
repeatedly, because it avoids the costs associated with launching the repeatedly, because it avoids the costs associated with launching the
substituter many times." substituter many times."
(define valid?
(cut valid-path? store <>))
(define valid-input? (define valid-input?
(cut valid-derivation-input? store <>)) (cut valid-derivation-input? store <>))
(define (dependencies drv) (define (closure inputs)
;; Skip prerequisite sub-trees of DRV whose root is valid. This allows us (let loop ((inputs inputs)
;; to ask the substituter for just as much as needed, instead of asking it (closure '())
;; for the whole world, which can be significantly faster when substitute (visited (set)))
;; info is not already in cache. (match inputs
;; Also, skip derivations marked as non-substitutable. (()
(append-map (lambda (input) (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))) (let ((drv (derivation-input-derivation input)))
(if (substitutable-derivation? drv) (loop (append (derivation-inputs drv) rest)
(derivation-input-output-paths input) (if (substitutable-derivation? drv)
'()))) (cons input closure)
(derivation-prerequisites drv valid-input?))) closure)
(set-insert key visited))))))))))
(let* ((paths (delete-duplicates (let* ((inputs (closure (map (match-lambda
(concatenate ((? derivation-input? input)
(fold (lambda (drv result) input)
(let ((self (match (derivation->output-paths drv) ((? derivation? drv)
(((names . paths) ...) (derivation-input drv)))
paths)))) inputs-or-drv)))
(cond ((eqv? mode (build-mode check)) (items (append-map derivation-input-output-paths inputs))
(cons (dependencies drv) result)) (subst (fold (lambda (subst vhash)
((not (substitutable-derivation? drv)) (vhash-cons (substitutable-path subst) subst
(cons (dependencies drv) result)) vhash))
((every valid? self) vlist-null
result) (substitutable-path-info store items))))
(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))))
(lambda (item) (lambda (item)
(match (vhash-assoc item subst) (match (vhash-assoc item subst)
(#f #f) (#f #f)
@ -367,10 +364,7 @@ of SUBSTITUTABLES."
(mode (build-mode normal)) (mode (build-mode normal))
(substitutable-info (substitutable-info
(substitution-oracle (substitution-oracle
store store inputs #:mode mode)))
(map derivation-input-derivation
inputs)
#:mode mode)))
"Given INPUTS, a list of derivation-inputs, return two values: the list of "Given INPUTS, a list of derivation-inputs, return two values: the list of
derivation to build, and the list of substitutable items that, together, derivation to build, and the list of substitutable items that, together,
allows INPUTS to be realized. allows INPUTS to be realized.

View File

@ -835,8 +835,7 @@ check and report what is prerequisites are available for download."
;; substituter many times. This makes a big difference, especially when ;; substituter many times. This makes a big difference, especially when
;; DRV is a long list as is the case with 'guix environment'. ;; DRV is a long list as is the case with 'guix environment'.
(if use-substitutes? (if use-substitutes?
(substitution-oracle store (map derivation-input-derivation inputs) (substitution-oracle store inputs #:mode mode)
#:mode mode)
(const #f))) (const #f)))
(let*-values (((build download) (let*-values (((build download)