[bug#48806] [PATCH 0/7] Generalized cache support and improved graft caching

[bug#48806] [PATCH 0/7] Generalized cache support and improved graft caching

[Ludovic Courtès]

Hi!

This patch series allows us to dynamically allocate per-store-connection
caches, such that subsequently created <store-connection> records
can have the newly allocated caches.

So far there were a couple of per-connection caches; for anything else,
we’d resort to global hash tables.  That’s not great because those caches
are usually valid only for one connection to a store, and only for the
duration of that session.  This new feature addresses that.

The last patch uses it to have session-wide caches mapping derivations
to applicable grafts, which partly addresses the performance problems
described in <https://issues.guix.gnu.org/41702>.

Feedback welcome, including performance reports!

Thanks,
Ludo’.

Ludovic Courtès (7):
  store: Support dynamic allocation of per-connection caches.
  store: Generalize cache lookup recording.
  grafts: Record cache lookups for profiling.
  grafts: Use SRFI-71 instead of SRFI-11.
  store: Remove 'references/substitutes'.
  store: 'references/cached' now uses a per-session cache.
  grafts: Cache the derivation/graft mapping for the whole session.

 guix/grafts.scm |  56 ++++++++-----
 guix/store.scm  | 205 ++++++++++++++++++++++++++----------------------
 tests/store.scm |  36 ---------
 3 files changed, 150 insertions(+), 147 deletions(-)

-- 
2.31.1

[bug#48806] [PATCH 1/7] store: Support dynamic allocation of per-connection caches.

[Ludovic Courtès]

* guix/store.scm (<store-connection>)[object-cache]: Remove.
[caches]: New field.
(open-connection, port->connection): Adjust '%make-store-connection'
calls accordingly.
(%store-connection-caches, %object-cache-id): New variables.
(allocate-store-connection-cache, vector-set)
(store-connection-cache, set-store-connection-cache)
(set-store-connection-caches!, set-store-connection-cache!): New
procedures.
(cache-object-mapping): Add #:cache parameter.
(set-store-connection-object-cache!): Remove.
(lookup-cached-object): Use 'store-connection-cache'.
(run-with-store): Use 'store-connection-caches' and
'set-store-connection-caches!'.
---
 guix/store.scm | 94 +++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 78 insertions(+), 16 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index cf5d5eeccc..897062efff 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -36,6 +36,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
   #:use-module ((ice-9 control) #:select (let/ec))
+  #:use-module (ice-9 atomic)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
@@ -47,7 +48,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 popen)
-  #:use-module (ice-9 threads)
+  #:autoload   (ice-9 threads) (current-processor-count)
   #:use-module (ice-9 format)
   #:use-module (web uri)
   #:export (%daemon-socket-uri
@@ -87,6 +88,11 @@
             nix-protocol-error-message
             nix-protocol-error-status
 
+            allocate-store-connection-cache
+            store-connection-cache
+            set-store-connection-cache
+            set-store-connection-cache!
+
             hash-algo
             build-mode
 
@@ -383,8 +389,8 @@
   ;; the session.
   (ats-cache    store-connection-add-to-store-cache)
   (atts-cache   store-connection-add-text-to-store-cache)
-  (object-cache store-connection-object-cache
-                (default vlist-null))             ;vhash
+  (caches       store-connection-caches
+                (default '#()))                   ;vector
   (built-in-builders store-connection-built-in-builders
                      (default (delay '()))))      ;promise
 
@@ -586,6 +592,10 @@ for this connection will be pinned.  Return a server object."
             (write-int (if reserve-space? 1 0) port))
           (letrec* ((built-in-builders
                      (delay (%built-in-builders conn)))
+                    (caches
+                     (make-vector
+                      (atomic-box-ref %store-connection-caches)
+                      vlist-null))
                     (conn
                      (%make-store-connection port
                                              (protocol-major v)
@@ -593,7 +603,7 @@ for this connection will be pinned.  Return a server object."
                                              output flush
                                              (make-hash-table 100)
                                              (make-hash-table 100)
-                                             vlist-null
+                                             caches
                                              built-in-builders)))
             (let loop ((done? (process-stderr conn)))
               (or done? (process-stderr conn)))
@@ -616,7 +626,9 @@ connection.  Use with care."
                               output flush
                               (make-hash-table 100)
                               (make-hash-table 100)
-                              vlist-null
+                              (make-vector
+                               (atomic-box-ref %store-connection-caches)
+                               vlist-null)
                               (delay (%built-in-builders connection))))
 
     connection))
@@ -1799,6 +1811,57 @@ The result is always the empty list unless the daemon was started with
 This makes sense only when the daemon was started with '--cache-failures'."
   boolean)
 
+\f
+;;;
+;;; Per-connection caches.
+;;;
+
+;; Number of currently allocated store connection caches--things that go in
+;; the 'caches' vector of <store-connection>.
+(define %store-connection-caches (make-atomic-box 0))
+
+(define (allocate-store-connection-cache name)
+  "Allocate a new cache for store connections and return its identifier.  Said
+identifier can be passed as an argument to "
+  (let loop ((current (atomic-box-ref %store-connection-caches)))
+    (let ((previous (atomic-box-compare-and-swap! %store-connection-caches
+                                                  current (+ current 1))))
+      (if (= previous current)
+          current
+          (loop current)))))
+
+(define %object-cache-id
+  ;; The "object cache", mapping lowerable objects such as <package> records
+  ;; to derivations.
+  (allocate-store-connection-cache 'object-cache))
+
+(define (vector-set vector index value)
+  (let ((new (vector-copy vector)))
+    (vector-set! new index value)
+    new))
+
+(define (store-connection-cache store cache)
+  "Return the cache of STORE identified by CACHE, an identifier as returned by
+'allocate-store-connection-cache'."
+  (vector-ref (store-connection-caches store) cache))
+
+(define (set-store-connection-cache store cache value)
+  "Return a copy of STORE where CACHE has the given VALUE.  CACHE must be a
+value returned by 'allocate-store-connection-cache'."
+  (store-connection
+   (inherit store)
+   (caches (vector-set (store-connection-caches store) cache value))))
+
+(define set-store-connection-caches!              ;private
+  (record-modifier <store-connection> 'caches))
+
+(define (set-store-connection-cache! store cache value)
+  "Set STORE's CACHE to VALUE.
+
+This is a mutating version that should be avoided.  Prefer the functional
+'set-store-connection-cache' instead, together with using %STORE-MONAD."
+  (vector-set! (store-connection-caches store) cache value))
+
 \f
 ;;;
 ;;; Store monad.
@@ -1819,7 +1882,9 @@ This makes sense only when the daemon was started with '--cache-failures'."
 (template-directory instantiations %store-monad)
 
 (define* (cache-object-mapping object keys result
-                               #:key (vhash-cons vhash-consq))
+                               #:key
+                               (cache %object-cache-id)
+                               (vhash-cons vhash-consq))
   "Augment the store's object cache with a mapping from OBJECT/KEYS to RESULT.
 KEYS is a list of additional keys to match against, for instance a (SYSTEM
 TARGET) tuple.  Use VHASH-CONS to insert OBJECT into the cache.
@@ -1828,10 +1893,10 @@ OBJECT is typically a high-level object such as a <package> or an <origin>,
 and RESULT is typically its derivation."
   (lambda (store)
     (values result
-            (store-connection
-             (inherit store)
-             (object-cache (vhash-cons object (cons result keys)
-                                       (store-connection-object-cache store)))))))
+            (set-store-connection-cache
+             store cache
+             (vhash-cons object (cons result keys)
+                         (store-connection-cache store cache))))))
 
 (define record-cache-lookup!
   (if (profiled? "object-cache")
@@ -1871,7 +1936,7 @@ and KEYS; use VHASH-FOLD* to look for OBJECT in the cache.  KEYS is a list of
 additional keys to match against, and which are compared with 'equal?'.
 Return #f on failure and the cached result otherwise."
   (lambda (store)
-    (let* ((cache (store-connection-object-cache store))
+    (let* ((cache (store-connection-cache store %object-cache-id))
 
            ;; Escape as soon as we find the result.  This avoids traversing
            ;; the whole vlist chain and significantly reduces the number of
@@ -2048,9 +2113,6 @@ the store."
   ;; when using 'gexp->derivation' and co.
   (make-parameter #f))
 
-(define set-store-connection-object-cache!
-  (record-modifier <store-connection> 'object-cache))
-
 (define* (run-with-store store mval
                          #:key
                          (guile-for-build (%guile-for-build))
@@ -2070,8 +2132,8 @@ connection, and return the result."
         (when (and store new-store)
           ;; Copy the object cache from NEW-STORE so we don't fully discard
           ;; the state.
-          (let ((cache (store-connection-object-cache new-store)))
-            (set-store-connection-object-cache! store cache)))
+          (let ((caches (store-connection-caches new-store)))
+            (set-store-connection-caches! store caches)))
         result))))
 
 \f
-- 
2.31.1

[bug#48806] [PATCH 2/7] store: Generalize cache lookup recording.

[Ludovic Courtès]

* guix/store.scm (cache-lookup-recorder): New procedure.
(record-cache-lookup!): Define in terms of it.
---
 guix/store.scm | 23 +++++++++++++++--------
 1 file changed, 15 insertions(+), 8 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index 897062efff..38d12ac5d7 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -69,6 +69,7 @@
             nix-server-socket
 
             current-store-protocol-version        ;for internal use
+            cache-lookup-recorder                 ;for internal use
             mcached
 
             &store-error store-error?
@@ -1898,21 +1899,24 @@ and RESULT is typically its derivation."
              (vhash-cons object (cons result keys)
                          (store-connection-cache store cache))))))
 
-(define record-cache-lookup!
-  (if (profiled? "object-cache")
+(define (cache-lookup-recorder component title)
+  "Return a procedure of two arguments to record cache lookups, hits, and
+misses for COMPONENT.  The procedure must be passed a Boolean indicating
+whether the cache lookup was a hit, and the actual cache (a vhash)."
+  (if (profiled? component)
       (let ((fresh    0)
             (lookups  0)
             (hits     0)
             (size     0))
         (register-profiling-hook!
-         "object-cache"
+         component
          (lambda ()
-           (format (current-error-port) "Store object cache:
+           (format (current-error-port) "~a:
   fresh caches: ~5@a
   lookups:      ~5@a
   hits:         ~5@a (~,1f%)
   cache size:   ~5@a entries~%"
-                   fresh lookups hits
+                   title fresh lookups hits
                    (if (zero? lookups)
                        100.
                        (* 100. (/ hits lookups)))
@@ -1920,9 +1924,9 @@ and RESULT is typically its derivation."
 
         (lambda (hit? cache)
           (set! fresh
-            (if (eq? cache vlist-null)
-                (+ 1 fresh)
-                fresh))
+                (if (eq? cache vlist-null)
+                    (+ 1 fresh)
+                    fresh))
           (set! lookups (+ 1 lookups))
           (set! hits (if hit? (+ hits 1) hits))
           (set! size (+ (if hit? 0 1)
@@ -1930,6 +1934,9 @@ and RESULT is typically its derivation."
       (lambda (x y)
         #t)))
 
+(define record-cache-lookup!
+  (cache-lookup-recorder "object-cache" "Store object cache"))
+
 (define-inlinable (lookup-cached-object object keys vhash-fold*)
   "Return the cached object in the store connection corresponding to OBJECT
 and KEYS; use VHASH-FOLD* to look for OBJECT in the cache.  KEYS is a list of
-- 
2.31.1

[bug#48806] [PATCH 3/7] grafts: Record cache lookups for profiling.

[Ludovic Courtès]

* guix/grafts.scm (record-cache-lookup!): New procedure.
(with-cache): Use it.
---
 guix/grafts.scm | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/guix/grafts.scm b/guix/grafts.scm
index fd8a108092..dff3d75b8b 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -172,10 +172,16 @@ references."
                  items))))
     (remove (cut member <> self) refs)))
 
+(define record-cache-lookup!
+  (cache-lookup-recorder "derivation-graft-cache"
+                         "Derivation graft cache"))
+
 (define-syntax-rule (with-cache key exp ...)
   "Cache the value of monadic expression EXP under KEY."
-  (mlet %state-monad ((cache (current-state)))
-    (match (vhash-assoc key cache)
+  (mlet* %state-monad ((cache (current-state))
+                       (result -> (vhash-assoc key cache)))
+    (record-cache-lookup! result cache)
+    (match result
       ((_ . result)                               ;cache hit
        (return result))
       (#f                                         ;cache miss
-- 
2.31.1

[bug#48806] [PATCH 4/7] grafts: Use SRFI-71 instead of SRFI-11.

[Ludovic Courtès]

* guix/grafts.scm (reference-origins): Use SRFI-71 'let*'.
---
 guix/grafts.scm | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/guix/grafts.scm b/guix/grafts.scm
index dff3d75b8b..e5672268b1 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -25,10 +25,10 @@
   #:use-module ((guix utils) #:select (%current-system))
   #:use-module (guix sets)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
   #:export (graft?
@@ -223,10 +223,10 @@ have no corresponding element in the resulting list."
              ((set-contains? visited drv)
               (loop rest items result visited))
              (else
-              (let*-values (((inputs)
-                             (map derivation-input-derivation
-                                  (derivation-inputs drv)))
-                            ((result items)
+              (let* ((inputs
+                      (map derivation-input-derivation
+                           (derivation-inputs drv)))
+                     (result items
                              (fold2 lookup-derivers
                                     result items inputs)))
                 (loop (append rest inputs)
-- 
2.31.1

[bug#48806] [PATCH 5/7] store: Remove 'references/substitutes'.

[Ludovic Courtès]

This procedure lost its only user in commit
710854304b1ab29332edcb76f3de532e0724c197.

* guix/store.scm (references/substitutes): Remove.
* tests/store.scm ("references/substitutes missing reference info")
("references/substitutes with substitute info"): Remove.
---
 guix/store.scm  | 55 +------------------------------------------------
 tests/store.scm | 36 --------------------------------
 2 files changed, 1 insertion(+), 90 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index 38d12ac5d7..ea784a33d2 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -148,7 +148,6 @@
             built-in-builders
             references
             references/cached
-            references/substitutes
             references*
             query-path-info*
             requisites
@@ -1481,7 +1480,7 @@ error if there is no such root."
   ;; Brute-force cache mapping store items to their list of references.
   ;; Caching matters because when building a profile in the presence of
   ;; grafts, we keep calling 'graft-derivation', which in turn calls
-  ;; 'references/substitutes' many times with the same arguments.  Ideally we
+  ;; 'references/cached' many times with the same arguments.  Ideally we
   ;; would use a cache associated with the daemon connection instead (XXX).
   (make-hash-table 100))
 
@@ -1492,58 +1491,6 @@ error if there is no such root."
         (hash-set! %reference-cache item references)
         references)))
 
-(define (references/substitutes store items)
-  "Return the list of list of references of ITEMS; the result has the same
-length as ITEMS.  Query substitute information for any item missing from the
-store at once.  Raise a '&store-protocol-error' exception if reference
-information for one of ITEMS is missing."
-  (let* ((requested  items)
-         (local-refs (map (lambda (item)
-                            (or (hash-ref %reference-cache item)
-                                (guard (c ((store-protocol-error? c) #f))
-                                  (references store item))))
-                          items))
-         (missing    (fold-right (lambda (item local-ref result)
-                                   (if local-ref
-                                       result
-                                       (cons item result)))
-                                 '()
-                                 items local-refs))
-
-         ;; Query all the substitutes at once to minimize the cost of
-         ;; launching 'guix substitute' and making HTTP requests.
-         (substs     (if (null? missing)
-                         '()
-                         (substitutable-path-info store missing))))
-    (when (< (length substs) (length missing))
-      (raise (condition (&store-protocol-error
-                         (message "cannot determine \
-the list of references")
-                         (status 1)))))
-
-    ;; Intersperse SUBSTS and LOCAL-REFS.
-    (let loop ((items       items)
-               (local-refs  local-refs)
-               (result      '()))
-      (match items
-        (()
-         (let ((result (reverse result)))
-           (for-each (cut hash-set! %reference-cache <> <>)
-                     requested result)
-           result))
-        ((item items ...)
-         (match local-refs
-           ((#f tail ...)
-            (loop items tail
-                  (cons (any (lambda (subst)
-                               (and (string=? (substitutable-path subst) item)
-                                    (substitutable-references subst)))
-                             substs)
-                        result)))
-           ((head tail ...)
-            (loop items tail
-                  (cons head result)))))))))
-
 (define* (fold-path store proc seed paths
                     #:optional (relatives (cut references store <>)))
   "Call PROC for each of the RELATIVES of PATHS, exactly once, and return the
diff --git a/tests/store.scm b/tests/store.scm
index 9c25adf5e9..3266fa7a82 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -308,42 +308,6 @@
          (null? (references %store t1))
          (null? (referrers %store t2)))))
 
-(test-assert "references/substitutes missing reference info"
-  (with-store s
-    (set-build-options s #:use-substitutes? #f)
-    (guard (c ((store-protocol-error? c) #t))
-      (let* ((b  (add-to-store s "bash" #t "sha256"
-                               (search-bootstrap-binary "bash"
-                                                        (%current-system))))
-             (d  (derivation s "the-thing" b '("--help")
-                             #:inputs `((,b)))))
-        (references/substitutes s (list (derivation->output-path d) b))
-        #f))))
-
-(test-assert "references/substitutes with substitute info"
-  (with-store s
-    (set-build-options s #:use-substitutes? #t)
-    (let* ((t1 (add-text-to-store s "random1" (random-text)))
-           (t2 (add-text-to-store s "random2" (random-text)
-                                  (list t1)))
-           (t3 (add-text-to-store s "build" "echo -n $t2 > $out"))
-           (b  (add-to-store s "bash" #t "sha256"
-                             (search-bootstrap-binary "bash"
-                                                      (%current-system))))
-           (d  (derivation s "the-thing" b `("-e" ,t3)
-                           #:inputs `((,b) (,t3) (,t2))
-                           #:env-vars `(("t2" . ,t2))))
-           (o  (derivation->output-path d)))
-      (with-derivation-narinfo d
-        (sha256 => (gcrypt:sha256 (string->utf8 t2)))
-        (references => (list t2))
-
-        (equal? (references/substitutes s (list o t3 t2 t1))
-                `((,t2)                           ;refs of O
-                  ()                              ;refs of T3
-                  (,t1)                           ;refs of T2
-                  ()))))))                        ;refs of T1
-
 (test-equal "substitutable-path-info when substitutes are turned off"
   '()
   (with-store s
-- 
2.31.1

[bug#48806] [PATCH 6/7] store: 'references/cached' now uses a per-session cache.

[Ludovic Courtès]

* guix/store.scm (%reference-cache): Remove.
(%reference-cache-id): New variable.
(references/cached): Rewrite in terms of it.
---
 guix/store.scm | 35 ++++++++++++++++++++---------------
 1 file changed, 20 insertions(+), 15 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index ea784a33d2..b761264ac0 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1476,21 +1476,6 @@ error if there is no such root."
              "Return the list of references of PATH."
              store-path-list))
 
-(define %reference-cache
-  ;; Brute-force cache mapping store items to their list of references.
-  ;; Caching matters because when building a profile in the presence of
-  ;; grafts, we keep calling 'graft-derivation', which in turn calls
-  ;; 'references/cached' many times with the same arguments.  Ideally we
-  ;; would use a cache associated with the daemon connection instead (XXX).
-  (make-hash-table 100))
-
-(define (references/cached store item)
-  "Like 'references', but cache results."
-  (or (hash-ref %reference-cache item)
-      (let ((references (references store item)))
-        (hash-set! %reference-cache item references)
-        references)))
-
 (define* (fold-path store proc seed paths
                     #:optional (relatives (cut references store <>)))
   "Call PROC for each of the RELATIVES of PATHS, exactly once, and return the
@@ -1810,6 +1795,26 @@ This is a mutating version that should be avoided.  Prefer the functional
 'set-store-connection-cache' instead, together with using %STORE-MONAD."
   (vector-set! (store-connection-caches store) cache value))
 
+
+(define %reference-cache-id
+  ;; Cache mapping store items to their list of references.  Caching matters
+  ;; because when building a profile in the presence of grafts, we keep
+  ;; calling 'graft-derivation', which in turn calls 'references/cached' many
+  ;; times with the same arguments.
+  (allocate-store-connection-cache 'reference-cache))
+
+(define (references/cached store item)
+  "Like 'references', but cache results."
+  (let ((cache (store-connection-cache store %reference-cache-id)))
+    (match (vhash-assoc item cache)
+      ((_ . references)
+       references)
+      (#f
+       (let* ((references (references store item))
+              (cache      (vhash-cons item references cache)))
+         (set-store-connection-cache! store %reference-cache-id cache)
+         references)))))
+
 \f
 ;;;
 ;;; Store monad.
-- 
2.31.1

[bug#48806] [PATCH 7/7] grafts: Cache the derivation/graft mapping for the whole session.

[Ludovic Courtès]

Partly fixes <https://bugs.gnu.org/41702>.
Reported by Lars-Dominik Braun <ldb@leibniz-psychology.org>.

Previously, 'graft-derivation' would start anew at every call.  When
creating a profile with lots of packages, it would potentially do the
same work multiple times.  The per-session cache addresses this.  It
increases the derivation-graft-cache hit rate from 77.9% to 80.1% on:

  GUIX_PROFILING="derivation-graft-cache" ./pre-inst-env \
    guix environment --ad-hoc libreoffice inkscape krita darktable -n

The effect is more visible on the pathological case below, where cache
hit rate goes from 75% to 87% and wall-clock time from 5.0s to 3.5s:

  GUIX_PROFILING="derivation-graft-cache" ./pre-inst-env \
    guix environment --ad-hoc r-learnr --search-paths

* guix/grafts.scm (%graft-cache): New variable.
(graft-derivation): Add calls to 'store-connection-cache' and
'set-store-connection-cache!'.
---
 guix/grafts.scm | 36 ++++++++++++++++++++++++------------
 1 file changed, 24 insertions(+), 12 deletions(-)

diff --git a/guix/grafts.scm b/guix/grafts.scm
index e5672268b1..4c69eb35a2 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -172,6 +172,10 @@ references."
                  items))))
     (remove (cut member <> self) refs)))
 
+(define %graft-cache
+  ;; Cache that maps derivation/outputs/grafts tuples to lists of grafts.
+  (allocate-store-connection-cache 'grafts))
+
 (define record-cache-lookup!
   (cache-lookup-recorder "derivation-graft-cache"
                          "Derivation graft cache"))
@@ -271,7 +275,7 @@ derivations to the corresponding set of grafts."
                                       #:system system)))))
           (reference-origins drv items)))
 
-  (with-cache (cons (derivation-file-name drv) outputs)
+  (with-cache (list (derivation-file-name drv) outputs grafts)
     (match (non-self-references store drv outputs)
       (()                                         ;no dependencies
        (return grafts))
@@ -309,17 +313,25 @@ derivations to the corresponding set of grafts."
   "Apply GRAFTS to the OUTPUTS of DRV and all their dependencies, recursively.
 That is, if GRAFTS apply only indirectly to DRV, graft the dependencies of
 DRV, and graft DRV itself to refer to those grafted dependencies."
-  (match (run-with-state
-             (cumulative-grafts store drv grafts
-                                #:outputs outputs
-                                #:guile guile #:system system)
-           vlist-null)                            ;the initial cache
-    ((first . rest)
-     ;; If FIRST is not a graft for DRV, it means that GRAFTS are not
-     ;; applicable to DRV and nothing needs to be done.
-     (if (equal? drv (graft-origin first))
-         (graft-replacement first)
-         drv))))
+  (let ((grafts cache
+                (run-with-state
+                    (cumulative-grafts store drv grafts
+                                       #:outputs outputs
+                                       #:guile guile #:system system)
+                  (store-connection-cache store %graft-cache))))
+
+    ;; Save CACHE in STORE to benefit from it on the next call.
+    ;; XXX: Ideally we'd use %STORE-MONAD and 'mcached' and avoid mutating
+    ;; STORE.
+    (set-store-connection-cache! store %graft-cache cache)
+
+    (match grafts
+      ((first . rest)
+       ;; If FIRST is not a graft for DRV, it means that GRAFTS are not
+       ;; applicable to DRV and nothing needs to be done.
+       (if (equal? drv (graft-origin first))
+           (graft-replacement first)
+           drv)))))
 
 \f
 ;; The following might feel more at home in (guix packages) but since (guix
-- 
2.31.1

[bug#48806] [PATCH 0/7] Generalized cache support and improved graft caching

[Lars-Dominik Braun]

Hi Ludo’!

> Feedback welcome, including performance reports!
I can confirm this further improves the situation around `guix
environment --ad-hoc r-learnr`. The additive behavior from my initial
report is also gone for r-learnr and r-stm, but not for r-learnr and
jupyter. I’m assuming the last two don’t share alot of grafts/packages
and thus don’t benefit from caching.

Thanks,
Lars

[bug#48806] [PATCH 0/7] Generalized cache support and improved graft caching

[Ludovic Courtès]

Hi!

Lars-Dominik Braun <lars@6xq.net> skribis:

>> Feedback welcome, including performance reports!
> I can confirm this further improves the situation around `guix
> environment --ad-hoc r-learnr`. The additive behavior from my initial
> report is also gone for r-learnr and r-stm, but not for r-learnr and
> jupyter. I’m assuming the last two don’t share alot of grafts/packages
> and thus don’t benefit from caching.

Yes, most likely.

Thanks for testing!

Ludo’.

bug#48806: [PATCH 0/7] Generalized cache support and improved graft caching

[Ludovic Courtès]

Hi,

Lars-Dominik Braun <lars@6xq.net> skribis:

>> Feedback welcome, including performance reports!
> I can confirm this further improves the situation around `guix
> environment --ad-hoc r-learnr`. The additive behavior from my initial
> report is also gone for r-learnr and r-stm, but not for r-learnr and
> jupyter. I’m assuming the last two don’t share alot of grafts/packages
> and thus don’t benefit from caching.

Pushed as 0c109026093e6fa8730efe0d7454656275d6efe3!

Thanks,
Ludo’.