aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-03-07 23:57:33 +0100
committerLudovic Courtès <ludo@gnu.org>2016-03-08 00:01:13 +0100
commitced71ac7a78f12d39a41f7102019bdb1aec93dee (patch)
treecbf9ef9926112311b45d5ddfb7c49d5d671194a8
parent9775412ee05d2510970d6ee842f42f3702b3c44c (diff)
downloadgnu-guix-ced71ac7a78f12d39a41f7102019bdb1aec93dee.tar
gnu-guix-ced71ac7a78f12d39a41f7102019bdb1aec93dee.tar.gz
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.scm18
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)))