mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2025-01-21 01:26:43 +01:00
store: 'references/cached' now uses a per-session cache.
* guix/store.scm (%reference-cache): Remove. (%reference-cache-id): New variable. (references/cached): Rewrite in terms of it.
This commit is contained in:
parent
2725f04634
commit
fde3c349f5
1 changed files with 20 additions and 15 deletions
|
@ -1476,21 +1476,6 @@ (define references
|
|||
"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 @@ (define (set-store-connection-cache! store cache value)
|
|||
'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.
|
||||
|
|
Loading…
Reference in a new issue