From b1510fd8d252c1ab0d32a32f064513105b99cf39 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 4 Jul 2019 23:09:11 +0200 Subject: derivations: 'derivation-build-plan' recurses on substituables. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This fixes a bug whereby "guix build texlive -n" would report: 0.0 MB would be downloaded: /gnu/store/…-texlive-20180414 instead of: The following derivation would be built: /gnu/store/…-texlive-texmf-20180414.drv 2,595.2 MB would be downloaded: /gnu/store/…-texlive-20180414-texmf.tar.xz /gnu/store/…-texlive-20180414 where 'texlive-texmf' is a non-substitutable dependency of 'texlive'. * guix/derivations.scm (dependencies-of-substitutables): New procedure. (derivation-build-plan): When 'input-substitutable-info' returns true, append the subset of DEPS that corresponds to SUBSTITUABLES to the first argument of 'loop'. * guix/ui.scm (show-what-to-build): Remove half-baked traversal of DOWNLOAD. * tests/derivations.scm ("derivation-build-plan and substitutes, non-substitutable dep"): New test. --- guix/derivations.scm | 29 +++++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) (limited to 'guix/derivations.scm') diff --git a/guix/derivations.scm b/guix/derivations.scm index 186d7a3f8f..caa76bd16c 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -352,6 +352,16 @@ substituter many times." (#f #f) ((key . value) value))))) +(define (dependencies-of-substitutables substitutables inputs) + "Return the subset of INPUTS whose output file names is among the references +of SUBSTITUTABLES." + (let ((items (fold set-insert (set) + (append-map substitutable-references substitutables)))) + (filter (lambda (input) + (any (cut set-contains? items <>) + (derivation-input-output-paths input))) + inputs))) + (define* (derivation-build-plan store inputs #:key (mode (build-mode normal)) @@ -391,7 +401,9 @@ by 'substitution-oracle'." (() (values build substitute)) ((input rest ...) - (let ((key (derivation-input-key input))) + (let ((key (derivation-input-key input)) + (deps (derivation-inputs + (derivation-input-derivation input)))) (cond ((set-contains? visited key) (loop rest build substitute visited)) ((input-built? input) @@ -400,16 +412,17 @@ by 'substitution-oracle'." ((input-substitutable-info input) => (lambda (substitutables) - (loop rest build + (loop (append (dependencies-of-substitutables substitutables + deps) + rest) + build (append substitutables substitute) (set-insert key visited)))) (else - (let ((deps (derivation-inputs - (derivation-input-derivation input)))) - (loop (append deps rest) - (cons (derivation-input-derivation input) build) - substitute - (set-insert key visited)))))))))) + (loop (append deps rest) + (cons (derivation-input-derivation input) build) + substitute + (set-insert key visited))))))))) (define-deprecated (derivation-prerequisites-to-build store drv #:rest rest) derivation-build-plan -- cgit v1.2.3 From d74392a85cfd0992d034b903ca21180a6d73eaed Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 5 Jul 2019 00:09:27 +0200 Subject: 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. --- guix/derivations.scm | 86 ++++++++++++++++++++++++---------------------------- guix/ui.scm | 3 +- 2 files changed, 41 insertions(+), 48 deletions(-) (limited to 'guix/derivations.scm') 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) -- cgit v1.2.3