bug#48007: [PATCH 3/4] inferior: Inferior caches store connections.

["Ludovic Courtès" <ludo@gnu.org>]

Fixes <https://issues.guix.gnu.org/48007>.
Reported by Ricardo Wurmus <rekado@elephly.net>.

Previously, at each 'inferior-eval-with-store' call, the inferior would
create a new <store-connection> object with empty caches.  Consequently,
when repeatedly calling 'inferior-package-derivation', we would not
benefit from any caching and instead recompute all the derivations for
every package.  This patch fixes it by caching <store-connection>
objects in the inferior.

* guix/inferior.scm (port->inferior): Define '%store-table' in the inferior.
(inferior-eval-with-store): Cache store connections in %STORE-TABLE.
Remove now unneeded 'dynamic-wind' with 'close-port' call.
---
 guix/inferior.scm | 54 +++++++++++++++++++++++++++++------------------
 1 file changed, 33 insertions(+), 21 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 1c19527b8f..64dd1ce9b6 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -225,6 +225,8 @@ (define* (port->inferior pipe #:optional (close close-port))
        (inferior-eval '(use-modules (srfi srfi-34)) result)
        (inferior-eval '(define %package-table (make-hash-table))
                       result)
+       (inferior-eval '(define %store-table (make-hash-table))
+                      result)
        result))
     (_
      #f)))
@@ -617,7 +619,12 @@ (define (inferior-eval-with-store inferior store code)
 thus be the code of a one-argument procedure that accepts a store."
   (let* ((major    (store-connection-major-version store))
          (minor    (store-connection-minor-version store))
-         (proto    (logior major minor)))
+         (proto    (logior major minor))
+
+         ;; The address of STORE itself is not a good identifier because it
+         ;; keeps changing through the use of "functional caches".  The
+         ;; address of its socket port makes more sense.
+         (store-id (object-address (store-connection-socket store))))
     (ensure-store-bridge! inferior)
     (send-inferior-request
      `(let ((proc   ,code)
@@ -628,26 +635,31 @@ (define (inferior-eval-with-store inferior store code)
                                store-protocol-error-message
                                nix-protocol-error-message)))
 
-        ;; 'port->connection' appeared in June 2018 and we can hardly
-        ;; emulate it on older versions.  Thus fall back to
-        ;; 'open-connection', at the risk of talking to the wrong daemon or
-        ;; having our build result reclaimed (XXX).
-        (let ((store (if (defined? 'port->connection)
-                         (port->connection %bridge-socket #:version ,proto)
-                         (open-connection))))
-          (dynamic-wind
-            (const #t)
-            (lambda ()
-              ;; Serialize '&store-protocol-error' conditions.  The
-              ;; exception serialization mechanism that
-              ;; 'read-repl-response' expects is unsuitable for SRFI-35
-              ;; error conditions, hence this special case.
-              (guard (c ((error? c)
-                         `(store-protocol-error ,(error-message c))))
-                `(result ,(proc store))))
-            (lambda ()
-              (unless (defined? 'port->connection)
-                (close-port store))))))
+        ;; Cache connections to STORE-ID.  This ensures that the caches within
+        ;; <store-connection> (in particular the object cache) are reused
+        ;; across calls to 'inferior-eval-with-store', which makes a
+        ;; significant different when it is called repeatedly.
+        (let ((store (or (hashv-ref %store-table ,store-id)
+
+                         ;; 'port->connection' appeared in June 2018 and we
+                         ;; can hardly emulate it on older versions.  Thus
+                         ;; fall back to 'open-connection', at the risk of
+                         ;; talking to the wrong daemon or having our build
+                         ;; result reclaimed (XXX).
+                         (let ((store (if (defined? 'port->connection)
+                                          (port->connection %bridge-socket
+                                                            #:version ,proto)
+                                          (open-connection))))
+                           (hashv-set! %store-table ,store-id store)
+                           store))))
+
+          ;; Serialize '&store-protocol-error' conditions.  The
+          ;; exception serialization mechanism that
+          ;; 'read-repl-response' expects is unsuitable for SRFI-35
+          ;; error conditions, hence this special case.
+          (guard (c ((error? c)
+                     `(store-protocol-error ,(error-message c))))
+            `(result ,(proc store)))))
      inferior)
     (proxy inferior store)
 
-- 
2.34.0