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

40
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)
(mbegin %store-monad
(set-current-state (vhash-consq drv value cache))
(return value)))
(mlet %state-monad ((cache (current-state)))
(match (vhash-assq drv cache)
((_ . grafts) ;hit
(return grafts))
(#f ;miss
(match (non-self-references references drv outputs) (match (non-self-references references drv outputs)
(() ;no dependencies (() ;no dependencies
grafts) (return/cache cache grafts))
(deps ;one or more dependencies (deps ;one or more dependencies
(let* ((grafts (delete-duplicates (append-map dependency-grafts deps) (mlet %state-monad ((grafts (mapm %state-monad dependency-grafts deps))
eq?)) (cache (current-state)))
(let* ((grafts (delete-duplicates (concatenate grafts) equal?))
(origins (map graft-origin-file-name grafts))) (origins (map graft-origin-file-name grafts)))
(if (find (cut member <> deps) origins) (if (find (cut member <> deps) origins)
(let ((new (graft-derivation/shallow store drv grafts (let* ((new (graft-derivation/shallow store drv grafts
#:guile guile #:guile guile
#:system system))) #:system system))
(cons (graft (origin drv) (replacement new)) (grafts (cons (graft (origin drv) (replacement new))
grafts)) grafts)))
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
(cumulative-grafts store drv grafts references
#:guile guile #:system system) #: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.