summary refs log tree commit diff
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)
downloadguix-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)))