summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-01-27 08:55:59 +0100
committerLudovic Courtès <ludo@gnu.org>2022-01-27 14:13:24 +0100
commitc71910a095f7e1ef0ab4c1fbea85348373e5a264 (patch)
treec9f6a9fbdaed92d3249d2be9c1343ea1f22ca334
parentbd86bbd300474204878e927f6cd3f0defa1662a5 (diff)
downloadguix-patches-c71910a095f7e1ef0ab4c1fbea85348373e5a264.tar
guix-patches-c71910a095f7e1ef0ab4c1fbea85348373e5a264.tar.gz
inferior: Inferior caches store connections.
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.
-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)