guix/guix
3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00
Code Issues Releases Wiki Activity

packages: Cache the result of 'input-grafts'.

Browse source 
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:
Ludovic Courtès 2016-03-07 23:57:33 +01:00
parent 9775412ee0
commit ced71ac7a7
1 changed files with 12 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
guix/packages.scm
View file

@ -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)))