From e778910bdfc68c60a5be59aac93049d32feae904 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 27 Jan 2022 09:20:40 +0100
Subject: inferior: Move initialization bits away from
 'inferior-eval-with-store'.

* guix/inferior.scm (port->inferior): In the inferior, define
'cached-store-connection', 'store-protocol-error?', and
'store-protocol-error-message'.
(inferior-eval-with-store): Use them.
---
 guix/inferior.scm | 76 ++++++++++++++++++++++++++++++-------------------------
 1 file changed, 42 insertions(+), 34 deletions(-)

(limited to 'guix')

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 9681064429..6949bb3687 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -225,7 +225,39 @@ inferior."
        (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))
+       (inferior-eval '(begin
+                         (define %store-table (make-hash-table))
+                         (define (cached-store-connection store-id version)
+                           ;; 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 difference when it is called
+                           ;; repeatedly.
+                           (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
+                                                                  version)
+                                                (open-connection))))
+                                 (hashv-set! %store-table store-id store)
+                                 store))))
+                      result)
+       (inferior-eval '(begin
+                         (define store-protocol-error?
+                           (if (defined? 'store-protocol-error?)
+                               store-protocol-error?
+                               nix-protocol-error?))
+                         (define store-protocol-error-message
+                           (if (defined? 'store-protocol-error-message)
+                               store-protocol-error-message
+                               nix-protocol-error-message)))
                       result)
        result))
     (_
@@ -627,39 +659,15 @@ thus be the code of a one-argument procedure that accepts a store."
          (store-id (object-address (store-connection-socket store))))
     (ensure-store-bridge! inferior)
     (send-inferior-request
-     `(let ((proc   ,code)
-            (error? (if (defined? 'store-protocol-error?)
-                        store-protocol-error?
-                        nix-protocol-error?))
-            (error-message (if (defined? 'store-protocol-error-message)
-                               store-protocol-error-message
-                               nix-protocol-error-message)))
-
-        ;; 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 difference 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)))))
+     `(let ((proc  ,code)
+            (store (cached-store-connection ,store-id ,proto)))
+        ;; 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 ((store-protocol-error? c)
+                   `(store-protocol-error
+                     ,(store-protocol-error-message c))))
+          `(result ,(proc store))))
      inferior)
     (proxy inferior store)
 
-- 
cgit v1.2.3