summaryrefslogtreecommitdiff
path: root/guix/store.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/store.scm')
-rw-r--r--guix/store.scm35
1 files 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)))))
+
;;;
;;; Store monad.