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
prev 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).