summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-01-29 00:16:18 +0100
committerLudovic Courtès <ludo@gnu.org>2013-01-29 00:16:18 +0100
commita7b6ffee68d7b47fe3f00a2a0bd8e5c83314f9ce (patch)
treed367fe5e313e67c08512130a01c255d0acaabceb
parentd7e8e288c54495556b1de33a5722f382abc56f3f (diff)
downloadguix-a7b6ffee68d7b47fe3f00a2a0bd8e5c83314f9ce.tar.gz
store: Make `add-to-store' memoizing.
* guix/store.scm (add-to-store/cached): New variable.
  Use it as the new `add-to-store'.
  This reduces the number of RPCs when doing "guix-build gdb" from 5009
  to 3053, and the execution time from 7s to 3.9s.
-rw-r--r--guix/store.scm19
1 files changed, 19 insertions, 0 deletions
diff --git a/guix/store.scm b/guix/store.scm
index c7eb9a7605..79e651f01b 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -464,6 +464,25 @@ path."
 FIXED? is for backward compatibility with old Nix versions and must be #t."
   store-path)
 
+(define add-to-store/cached
+  ;; A memoizing version of `add-to-store'.  This is important because
+  ;; `add-to-store' leads to huge data transfers to the server, and
+  ;; because it's often called many times with the very same argument.
+  (let ((add-to-store add-to-store)
+        (cache        (make-weak-value-hash-table 500)))
+    (lambda (server basename fixed? recursive? hash-algo file-name)
+      "Add the contents of FILE-NAME under BASENAME to the store.  Note that
+FIXED? is for backward compatibility with old Nix versions and must be #t."
+      (let* ((st   (stat file-name #f))
+             (args `(,basename ,recursive? ,hash-algo ,st)))
+        (or (and st (hash-ref cache args))
+            (let ((path (add-to-store server basename fixed? recursive?
+                                      hash-algo file-name)))
+              (hash-set! cache args path)
+              path))))))
+
+(define add-to-store add-to-store/cached)
+
 (define-operation (build-derivations (string-list derivations))
   "Build DERIVATIONS, and return when the worker is done building them.
 Return #t on success."