From bdcf35a6b294c1db7ce78a5550ba51e067863069 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 29 Jan 2013 23:53:09 +0100
Subject: [PATCH] store: Cache `add-text-to-store' results.

* guix/store.scm (<nix-server>)[atts-cache]: New field.
  (add-text-to-store/cached): New procedure.  Use it as a wrapper around
  `add-text-to-store'.
  When running "guix-build gdb", this reduces the number of RPCs from
  3048 to 289, and execution time from 4.7s to 2.6s.
---
 guix/store.scm | 24 +++++++++++++++++++++---
 1 file changed, 21 insertions(+), 3 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index aa762b667c..f36ebea390 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -293,7 +293,7 @@ (define-syntax read-arg
 
 (define-record-type <nix-server>
   (%make-nix-server socket major minor
-                    ats-cache)
+                    ats-cache atts-cache)
   nix-server?
   (socket nix-server-socket)
   (major  nix-server-major-version)
@@ -302,7 +302,8 @@ (define-record-type <nix-server>
   ;; Caches.  We keep them per-connection, because store paths build
   ;; during the session are temporary GC roots kept for the duration of
   ;; the session.
-  (ats-cache nix-server-add-to-store-cache))
+  (ats-cache  nix-server-add-to-store-cache)
+  (atts-cache nix-server-add-text-to-store-cache))
 
 (define-condition-type &nix-error &error
   nix-error?)
@@ -340,6 +341,7 @@ (define* (open-connection #:optional (file %default-socket-path)
                     (let ((s (%make-nix-server s
                                                (protocol-major v)
                                                (protocol-minor v)
+                                               (make-hash-table)
                                                (make-hash-table))))
                       (let loop ((done? (process-stderr s)))
                         (or done? (process-stderr s)))
@@ -462,6 +464,22 @@ (define-operation (add-text-to-store (string name) (string text)
 path."
   store-path)
 
+(define add-text-to-store/cached
+  (let ((add-text-to-store add-text-to-store))
+    (lambda (server name text references)
+      "Add TEXT under file NAME in the store, and return its store path.
+REFERENCES is the list of store paths referred to by the resulting store
+path."
+      (let ((args  `(,name ,text ,references))
+            (cache (nix-server-add-text-to-store-cache server)))
+        (or (hash-ref cache args)
+            (let ((path (add-text-to-store server name text
+                                           references)))
+              (hash-set! cache args path)
+              path))))))
+
+(set! add-text-to-store add-text-to-store/cached)
+
 (define-operation (add-to-store (string basename)
                                 (boolean fixed?)  ; obsolete, must be #t
                                 (boolean recursive?)
@@ -488,7 +506,7 @@ (define add-to-store/cached
               (hash-set! cache args path)
               path))))))
 
-(define add-to-store add-to-store/cached)
+(set! 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.