packages: Cache the result of 'input-grafts'.
This reduces the wall-clock time of guix environment gnutls --pure -E true by ~35%. * guix/packages.scm (%graft-cache): New variable. (input-graft): Use 'cached' to cache to %GRAFT-CACHE.
This commit is contained in:
parent
9775412ee0
commit
ced71ac7a7
|
@ -843,6 +843,11 @@ and return it."
|
||||||
(&package-error
|
(&package-error
|
||||||
(package package)))))))))))
|
(package package)))))))))))
|
||||||
|
|
||||||
|
(define %graft-cache
|
||||||
|
;; 'eq?' cache mapping package objects to a graft corresponding to their
|
||||||
|
;; replacement package.
|
||||||
|
(make-weak-key-hash-table 200))
|
||||||
|
|
||||||
(define (input-graft store system)
|
(define (input-graft store system)
|
||||||
"Return a procedure that, given a package with a graft, returns a graft, and
|
"Return a procedure that, given a package with a graft, returns a graft, and
|
||||||
#f otherwise."
|
#f otherwise."
|
||||||
|
@ -850,12 +855,13 @@ and return it."
|
||||||
((? package? package)
|
((? package? package)
|
||||||
(let ((replacement (package-replacement package)))
|
(let ((replacement (package-replacement package)))
|
||||||
(and replacement
|
(and replacement
|
||||||
(let ((orig (package-derivation store package system
|
(cached (=> %graft-cache) package system
|
||||||
#:graft? #f))
|
(let ((orig (package-derivation store package system
|
||||||
(new (package-derivation store replacement system)))
|
#:graft? #f))
|
||||||
(graft
|
(new (package-derivation store replacement system)))
|
||||||
(origin orig)
|
(graft
|
||||||
(replacement new))))))
|
(origin orig)
|
||||||
|
(replacement new)))))))
|
||||||
(x
|
(x
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue