From ced71ac7a78f12d39a41f7102019bdb1aec93dee Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 7 Mar 2016 23:57:33 +0100
Subject: 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.
---
 guix/packages.scm | 18 ++++++++++++------
 1 file 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)))
 
-- 
cgit v1.2.3