mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
grafts: Use dependency information from substitutes when possible.
This avoids starting derivation builds just for the sake of knowing the references of their outputs, thereby restoring the expected behavior of --dry-run when substitutes are available. * guix/grafts.scm (non-self-references): Remove 'store' parameter, and add 'references'. Use it. Update caller. (references-oracle): New variable. (cumulative-grafts): Add 'references' parameter and use it. Update callers. (graft-derivation): Remove 'build-derivations' call. Add call to 'references-oracle'.
This commit is contained in:
parent
6581ec9ab9
commit
c90cb5c9d8
1 changed files with 51 additions and 12 deletions
|
@ -26,7 +26,9 @@ (define-module (guix grafts)
|
|||
#:use-module (srfi srfi-9 gnu)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 vlist)
|
||||
#:export (graft?
|
||||
graft
|
||||
graft-origin
|
||||
|
@ -162,36 +164,71 @@ (define (item->deriver store item)
|
|||
(and (string=? item path) name)))
|
||||
(derivation->output-paths drv)))))))
|
||||
|
||||
(define (non-self-references store drv outputs)
|
||||
(define (non-self-references references drv outputs)
|
||||
"Return the list of references of the OUTPUTS of DRV, excluding self
|
||||
references."
|
||||
(let ((refs (append-map (lambda (output)
|
||||
(references store
|
||||
(derivation->output-path drv output)))
|
||||
references. Call REFERENCES to get the list of references."
|
||||
(let ((refs (append-map (compose references
|
||||
(cut derivation->output-path drv <>))
|
||||
outputs))
|
||||
(self (match (derivation->output-paths drv)
|
||||
(((names . items) ...)
|
||||
items))))
|
||||
(remove (cut member <> self) refs)))
|
||||
|
||||
(define (references-oracle store drv)
|
||||
"Return a one-argument procedure that, when passed the file name of DRV's
|
||||
outputs or their dependencies, returns the list of references of that item.
|
||||
Use either local info or substitute info; build DRV if no information is
|
||||
available."
|
||||
(define (output-paths drv)
|
||||
(match (derivation->output-paths drv)
|
||||
(((names . items) ...)
|
||||
items)))
|
||||
|
||||
(define (references* items)
|
||||
(guard (c ((nix-protocol-error? c)
|
||||
;; As a last resort, build DRV and query the references of the
|
||||
;; build result.
|
||||
(and (build-derivations store (list drv))
|
||||
(map (cut references store <>) items))))
|
||||
(references/substitutes store items)))
|
||||
|
||||
(let loop ((items (output-paths drv))
|
||||
(result vlist-null))
|
||||
(match items
|
||||
(()
|
||||
(lambda (item)
|
||||
(match (vhash-assoc item result)
|
||||
((_ . refs) refs)
|
||||
(#f #f))))
|
||||
(_
|
||||
(let* ((refs (references* items))
|
||||
(result (fold vhash-cons result items refs)))
|
||||
(loop (remove (cut vhash-assoc <> result)
|
||||
(delete-duplicates (concatenate refs) string=?))
|
||||
result))))))
|
||||
|
||||
(define* (cumulative-grafts store drv grafts
|
||||
references
|
||||
#:key
|
||||
(outputs (derivation-output-names drv))
|
||||
(guile (%guile-for-build))
|
||||
(system (%current-system)))
|
||||
"Augment GRAFTS with additional grafts resulting from the application of
|
||||
GRAFTS to the dependencies of DRV. Return the resulting list of grafts."
|
||||
GRAFTS to the dependencies of DRV; REFERENCES must be a one-argument procedure
|
||||
that returns the list of references of the store item it is given. Return the
|
||||
resulting list of grafts."
|
||||
(define (dependency-grafts item)
|
||||
(let-values (((drv output) (item->deriver store item)))
|
||||
(if drv
|
||||
(cumulative-grafts store drv grafts
|
||||
(cumulative-grafts store drv grafts references
|
||||
#:outputs (list output)
|
||||
#:guile guile
|
||||
#:system system)
|
||||
grafts)))
|
||||
|
||||
;; TODO: Memoize.
|
||||
(match (non-self-references store drv outputs)
|
||||
(match (non-self-references references drv outputs)
|
||||
(() ;no dependencies
|
||||
grafts)
|
||||
(deps ;one or more dependencies
|
||||
|
@ -213,11 +250,13 @@ (define* (graft-derivation store drv grafts
|
|||
GRAFTS apply only indirectly to DRV, graft the dependencies of DRV, and graft
|
||||
DRV itself to refer to those grafted dependencies."
|
||||
|
||||
;; First, we need to build the ungrafted DRV so we can query its run-time
|
||||
;; dependencies in 'cumulative-grafts'.
|
||||
(build-derivations store (list drv))
|
||||
;; First, pre-compute the dependency tree of the outputs of DRV. Do this
|
||||
;; upfront to have as much parallelism as possible when querying substitute
|
||||
;; info or when building DRV.
|
||||
(define references
|
||||
(references-oracle store drv))
|
||||
|
||||
(match (cumulative-grafts store drv grafts
|
||||
(match (cumulative-grafts store drv grafts references
|
||||
#:guile guile #:system system)
|
||||
((first . rest)
|
||||
;; If FIRST is not a graft for DRV, it means that GRAFTS are not
|
||||
|
|
Loading…
Reference in a new issue