guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

03/03: derivations: Share a cache between 'derivation' and 'read-derivat


From: Ludovic Courtès
Subject: 03/03: derivations: Share a cache between 'derivation' and 'read-derivation'.
Date: Thu, 5 Jan 2017 22:46:41 +0000 (UTC)

civodul pushed a commit to branch master
in repository guix.

commit 76c31074c89239bda31b29e78e63e878b17a57f9
Author: Ludovic Courtès <address@hidden>
Date:   Thu Jan 5 23:40:59 2017 +0100

    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.
---
 guix/derivations.scm |   37 +++++++++++++++++++++----------------
 1 file changed, 21 insertions(+), 16 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 23ad58f..d5e4b57 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)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]