summaryrefslogtreecommitdiff
path: root/guix/inferior.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/inferior.scm')
-rw-r--r--guix/inferior.scm54
1 files changed, 33 insertions, 21 deletions
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 1c19527b8f..9681064429 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -225,6 +225,8 @@ 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))
+ result)
result))
(_
#f)))
@@ -617,7 +619,12 @@ process."
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 @@ thus be the code of a one-argument procedure that accepts a store."
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 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)))))
inferior)
(proxy inferior store)