nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

grafts: Memoize intermediate results in 'cumulative-grafts'. 

The time for:

  guix build inkscape -n --no-substitutes

goes down by 30% (in the presence of 3 replacements among all the
packages.)

* guix/grafts.scm (cumulative-grafts): Turn into a monadic procedure in
%STATE-MONAD.  Use the current state as a derivation-to-graft cache.
(graft-derivation): Call 'cumulative-grafts' within 'run-with-state'.
This commit is contained in:
Ludovic Courtès 2016-03-04 23:10:28 +01:00
parent fcadd9ff9d
commit d4da602e4c
1 changed files with 35 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
guix/grafts.scm
View File

@ -217,7 +217,10 @@ available."
"Augment GRAFTS with additional grafts resulting from the application of "Augment GRAFTS with additional grafts resulting from the application of
GRAFTS to the dependencies of DRV; REFERENCES must be a one-argument procedure 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 that returns the list of references of the store item it is given. Return the
resulting list of grafts." resulting list of grafts.
This is a monadic procedure in %STATE-MONAD where the state is a vhash mapping
derivations to the corresponding set of grafts."
(define (dependency-grafts item) (define (dependency-grafts item)
(let-values (((drv output) (item->deriver store item))) (let-values (((drv output) (item->deriver store item)))
(if drv (if drv
@ -225,23 +228,34 @@ resulting list of grafts."
#:outputs (list output) #:outputs (list output)
#:guile guile #:guile guile
#:system system) #:system system)
grafts))) (state-return grafts))))
;; TODO: Memoize. (define (return/cache cache value)
(match (non-self-references references drv outputs) (mbegin %store-monad
(() ;no dependencies (set-current-state (vhash-consq drv value cache))
grafts) (return value)))
(deps ;one or more dependencies
(let* ((grafts (delete-duplicates (append-map dependency-grafts deps) (mlet %state-monad ((cache (current-state)))
eq?)) (match (vhash-assq drv cache)
(origins (map graft-origin-file-name grafts))) ((_ . grafts) ;hit
(if (find (cut member <> deps) origins) (return grafts))
(let ((new (graft-derivation/shallow store drv grafts (#f ;miss
#:guile guile (match (non-self-references references drv outputs)
#:system system))) (() ;no dependencies
(cons (graft (origin drv) (replacement new)) (return/cache cache grafts))
grafts)) (deps ;one or more dependencies
grafts))))) (mlet %state-monad ((grafts (mapm %state-monad dependency-grafts deps))
(cache (current-state)))
(let* ((grafts (delete-duplicates (concatenate grafts) equal?))
(origins (map graft-origin-file-name grafts)))
(if (find (cut member <> deps) origins)
(let* ((new (graft-derivation/shallow store drv grafts
#:guile guile
#:system system))
(grafts (cons (graft (origin drv) (replacement new))
grafts)))
(return/cache cache grafts))
(return/cache cache grafts))))))))))
(define* (graft-derivation store drv grafts (define* (graft-derivation store drv grafts
#:key (guile (%guile-for-build)) #:key (guile (%guile-for-build))
@ -256,8 +270,10 @@ DRV itself to refer to those grafted dependencies."
(define references (define references
(references-oracle store drv)) (references-oracle store drv))
(match (cumulative-grafts store drv grafts references (match (run-with-state
#:guile guile #:system system) (cumulative-grafts store drv grafts references
#:guile guile #:system system)
vlist-null) ;the initial cache
((first . rest) ((first . rest)
;; If FIRST is not a graft for DRV, it means that GRAFTS are not ;; If FIRST is not a graft for DRV, it means that GRAFTS are not
;; applicable to DRV and nothing needs to be done. ;; applicable to DRV and nothing needs to be done.