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:
parent
b1510fd8d2
commit
d74392a85c
|
@ -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.
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue