From c71910a095f7e1ef0ab4c1fbea85348373e5a264 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 27 Jan 2022 08:55:59 +0100 Subject: inferior: Inferior caches store connections. Fixes . Reported by Ricardo Wurmus . Previously, at each 'inferior-eval-with-store' call, the inferior would create a new 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 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. --- guix/inferior.scm | 54 +++++++++++++++++++++++++++++++++--------------------- 1 file 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 + ;; (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) -- cgit v1.2.3