diff options
author | Ludovic Courtès <ludo@gnu.org> | 2016-03-07 23:57:33 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2016-03-08 00:01:13 +0100 |
commit | ced71ac7a78f12d39a41f7102019bdb1aec93dee (patch) | |
tree | cbf9ef9926112311b45d5ddfb7c49d5d671194a8 | |
parent | 9775412ee05d2510970d6ee842f42f3702b3c44c (diff) | |
download | guix-ced71ac7a78f12d39a41f7102019bdb1aec93dee.tar.gz guix-ced71ac7a78f12d39a41f7102019bdb1aec93dee.zip |
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.
-rw-r--r-- | guix/packages.scm | 18 |
1 files changed, 12 insertions, 6 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index 92222c0def..d62d1f3343 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -843,6 +843,11 @@ and return it." (&package-error (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) "Return a procedure that, given a package with a graft, returns a graft, and #f otherwise." @@ -850,12 +855,13 @@ and return it." ((? package? package) (let ((replacement (package-replacement package))) (and replacement - (let ((orig (package-derivation store package system - #:graft? #f)) - (new (package-derivation store replacement system))) - (graft - (origin orig) - (replacement new)))))) + (cached (=> %graft-cache) package system + (let ((orig (package-derivation store package system + #:graft? #f)) + (new (package-derivation store replacement system))) + (graft + (origin orig) + (replacement new))))))) (x #f))) |