grafts: 'references-oracle' now takes a derivation input.

That way, if we end up calling 'build-derivations', we'll only build the
outputs that we really need.

* guix/grafts.scm (references-oracle): Rename 'drv' to 'input'.
[output-paths]: Remove.
Adjust accordingly.
(graft-derivation): Adjust call to 'references-oracle'.
This commit is contained in:
Ludovic Courtès 2019-07-02 16:45:12 +02:00
parent 7c9fbf3e3d
commit 9616b81e98
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 10 additions and 14 deletions

View File

@ -163,16 +163,11 @@ references. Call REFERENCES to get the list of references."
items)))) items))))
(remove (cut member <> self) refs))) (remove (cut member <> self) refs)))
(define (references-oracle store drv) (define (references-oracle store input)
"Return a one-argument procedure that, when passed the file name of DRV's "Return a one-argument procedure that, when passed the output file names of
outputs or their dependencies, returns the list of references of that item. INPUT, a derivation input, or their dependencies, returns the list of
Use either local info or substitute info; build DRV if no information is references of that item. Use either local info or substitute info; build
available." INPUT if no information is available."
(define (output-paths drv)
(match (derivation->output-paths drv)
(((names . items) ...)
items)))
(define (references* items) (define (references* items)
(guard (c ((store-protocol-error? c) (guard (c ((store-protocol-error? c)
;; As a last resort, build DRV and query the references of the ;; As a last resort, build DRV and query the references of the
@ -181,13 +176,14 @@ available."
;; Warm up the narinfo cache, otherwise each derivation build ;; Warm up the narinfo cache, otherwise each derivation build
;; will result in one HTTP request to get one narinfo, which is ;; will result in one HTTP request to get one narinfo, which is
;; much less efficient than fetching them all upfront. ;; much less efficient than fetching them all upfront.
(substitution-oracle store (list drv)) (substitution-oracle store
(list (derivation-input-derivation input)))
(and (build-derivations store (list drv)) (and (build-derivations store (list input))
(map (cut references store <>) items)))) (map (cut references store <>) items))))
(references/substitutes store items))) (references/substitutes store items)))
(let loop ((items (output-paths drv)) (let loop ((items (derivation-input-output-paths input))
(result vlist-null)) (result vlist-null))
(match items (match items
(() (()
@ -324,7 +320,7 @@ DRV, and graft DRV itself to refer to those grafted dependencies."
;; upfront to have as much parallelism as possible when querying substitute ;; upfront to have as much parallelism as possible when querying substitute
;; info or when building DRV. ;; info or when building DRV.
(define references (define references
(references-oracle store drv)) (references-oracle store (derivation-input drv outputs)))
(match (run-with-state (match (run-with-state
(cumulative-grafts store drv grafts references (cumulative-grafts store drv grafts references