derivations: Share a cache between 'derivation' and 'read-derivation'.

This leads a 13% speedup on 'guix build libreoffice -d' and 18% on
'guix build gnome -d'.

* guix/derivations.scm (%derivation-cache): New variable.
(read-derivation): Use it instead of the private 'cache' variable.
(derivation): Populate %DERIVATION-CACHE before returning.

1 files changed, 21 insertions, 16 deletions

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 23ad58f914..d5e4b5730b 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -453,19 +453,22 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
        (loop (read drv-port)
              (cons (ununquote exp) result))))))
 
-(define read-derivation
-  (let ((cache (make-weak-value-hash-table 200)))
-    (lambda (drv-port)
-      "Read the derivation from DRV-PORT and return the corresponding
+(define %derivation-cache
+  ;; Maps derivation file names to <derivation> objects.
+  ;; XXX: This is redundant with 'atts-cache' in the store.
+  (make-weak-value-hash-table 200))
+
+(define (read-derivation drv-port)
+  "Read the derivation from DRV-PORT and return the corresponding
 <derivation> object."
-      ;; Memoize that operation because `%read-derivation' is quite expensive,
-      ;; and because the same argument is read more than 15 times on average
-      ;; during something like (package-derivation s gdb).
-      (let ((file (and=> (port-filename drv-port) basename)))
-        (or (and file (hash-ref cache file))
-            (let ((drv (%read-derivation drv-port)))
-              (hash-set! cache file drv)
-              drv))))))
+  ;; Memoize that operation because `%read-derivation' is quite expensive,
+  ;; and because the same argument is read more than 15 times on average
+  ;; during something like (package-derivation s gdb).
+  (let ((file (port-filename drv-port)))
+    (or (and file (hash-ref %derivation-cache file))
+        (let ((drv (%read-derivation drv-port)))
+          (hash-set! %derivation-cache file drv)
+          drv))))
 
 (define-inlinable (write-sequence lst write-item port)
   ;; Write each element of LST with WRITE-ITEM to PORT, separating them with a
@@ -866,10 +869,12 @@ output should not be used."
                                       system builder args env-vars #f))
          (drv        (add-output-paths drv-masked)))
 
-    (let ((file (add-text-to-store store (string-append name ".drv")
-                                   (derivation->string drv)
-                                   (map derivation-input-path inputs))))
-      (set-file-name drv file))))
+    (let* ((file (add-text-to-store store (string-append name ".drv")
+                                    (derivation->string drv)
+                                    (map derivation-input-path inputs)))
+           (drv  (set-file-name drv file)))
+      (hash-set! %derivation-cache file drv)
+      drv)))
 
 (define* (map-derivation store drv mapping
                          #:key (system (%current-system)))