unofficial mirror of bug-guix@gnu.org 
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 48007@debbugs.gnu.org
Subject: bug#48007: [PATCH 4/4] inferior: Move initialization bits away from 'inferior-eval-with-store'.
Date: Thu, 27 Jan 2022 09:47:43 +0100	[thread overview]
Message-ID: <20220127084743.27130-4-ludo@gnu.org> (raw)
In-Reply-To: <20220127084743.27130-1-ludo@gnu.org>

* 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(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 64dd1ce9b6..fc253dcc4f 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -225,7 +225,39 @@ (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))
+       (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 different 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 @@ (define (inferior-eval-with-store inferior store code)
          (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 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)))))
+     `(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)
 
-- 
2.34.0





      parent reply	other threads:[~2022-01-27  9:24 UTC|newest]

Thread overview: 11+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-04-24 21:07 bug#48007: computing derivations through inferior takes twice as long Ricardo Wurmus
2022-01-26 20:51 ` Ludovic Courtès
2022-01-26 21:32   ` Ricardo Wurmus
2022-01-27  8:50     ` Ludovic Courtès
2022-01-27  9:56       ` Ricardo Wurmus
2022-01-27 13:33         ` Ludovic Courtès
2022-01-27  8:47   ` bug#48007: [PATCH 1/4] inferior: Create the store proxy listening socket only once Ludovic Courtès
2022-01-27  8:47     ` bug#48007: [PATCH 2/4] inferior: Keep the store bridge connected Ludovic Courtès
2022-02-18 11:30       ` bug#48007: computing derivations through inferior takes twice as long Ludovic Courtès
2022-01-27  8:47     ` bug#48007: [PATCH 3/4] inferior: Inferior caches store connections Ludovic Courtès
2022-01-27  8:47     ` Ludovic Courtès [this message]

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20220127084743.27130-4-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=48007@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).