me/guix
Archived
1
0
Fork 0
Code Activity

store: Allow objects in the cache to be inserted and search for with 'equal?'.

Browse source 
* guix/store.scm (cache-object-mapping): Add #:vhash-cons parameter and
honor it.
(lookup-cached-object): Add #:vhash-fold* parameter and honor it.
(%mcached): Add #:vhash-fold* and #:vhash-cons and honor them.
(mcached): Add clauses with 'eq?' and 'equal?' as the first argument.
This commit is contained in:
Ludovic Courtès 2019-10-27 19:08:15 +01:00
parent f58b45350b
commit c57e417eff
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 43 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

67
guix/store.scm
View file

@ -1612,10 +1612,11 @@ This makes sense only when the daemon was started with '--cache-failures'."
;; from %STATE-MONAD. ;; from %STATE-MONAD.
(template-directory instantiations %store-monad) (template-directory instantiations %store-monad)
(define* (cache-object-mapping object keys result) (define* (cache-object-mapping object keys result
#:key (vhash-cons vhash-consq))
"Augment the store's object cache with a mapping from OBJECT/KEYS to RESULT. "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 KEYS is a list of additional keys to match against, for instance a (SYSTEM
TARGET) tuple. TARGET) tuple. Use VHASH-CONS to insert OBJECT into the cache.
OBJECT is typically a high-level object such as a <package> or an <origin>, OBJECT is typically a high-level object such as a <package> or an <origin>,
and RESULT is typically its derivation." and RESULT is typically its derivation."
@ -1623,8 +1624,8 @@ and RESULT is typically its derivation."
(values result (values result
(store-connection (store-connection
(inherit store) (inherit store)
(object-cache (vhash-consq object (cons result keys) (object-cache (vhash-cons object (cons result keys)
(store-connection-object-cache store))))))) (store-connection-object-cache store)))))))
(define record-cache-lookup! (define record-cache-lookup!
(if (profiled? "object-cache") (if (profiled? "object-cache")
@ -1653,11 +1654,12 @@ and RESULT is typically its derivation."
(lambda (x y) (lambda (x y)
#t))) #t)))
(define* (lookup-cached-object object #:optional (keys '())) (define* (lookup-cached-object object #:optional (keys '())
#:key (vhash-fold* vhash-foldq*))
"Return the cached object in the store connection corresponding to OBJECT "Return the cached object in the store connection corresponding to OBJECT
and KEYS. KEYS is a list of additional keys to match against, and which are and KEYS; use VHASH-FOLD* to look for OBJECT in the cache. KEYS is a list of
compared with 'equal?'. Return #f on failure and the cached result additional keys to match against, and which are compared with 'equal?'.
otherwise." Return #f on failure and the cached result otherwise."
(lambda (store) (lambda (store)
(let* ((cache (store-connection-object-cache store)) (let* ((cache (store-connection-object-cache store))
@ -1665,33 +1667,50 @@ otherwise."
;; the whole vlist chain and significantly reduces the number of ;; the whole vlist chain and significantly reduces the number of
;; 'hashq' calls. ;; 'hashq' calls.
(value (let/ec return (value (let/ec return
(vhash-foldq* (lambda (item result) (vhash-fold* (lambda (item result)
(match item (match item
((value . keys*) ((value . keys*)
(if (equal? keys keys*) (if (equal? keys keys*)
(return value) (return value)
result)))) result))))
#f object #f object
cache)))) cache))))
(record-cache-lookup! value cache) (record-cache-lookup! value cache)
(values value store)))) (values value store))))
(define* (%mcached mthunk object #:optional (keys '())) (define* (%mcached mthunk object #:optional (keys '())
#:key
(vhash-cons vhash-consq)
(vhash-fold* vhash-foldq*))
"Bind the monadic value returned by MTHUNK, which supposedly corresponds to "Bind the monadic value returned by MTHUNK, which supposedly corresponds to
OBJECT/KEYS, or return its cached value." OBJECT/KEYS, or return its cached value. Use VHASH-CONS to insert OBJECT into
(mlet %store-monad ((cached (lookup-cached-object object keys))) the cache, and VHASH-FOLD* to look it up."
(mlet %store-monad ((cached (lookup-cached-object object keys
#:vhash-fold* vhash-fold*)))
(if cached (if cached
(return cached) (return cached)
(>>= (mthunk) (>>= (mthunk)
(lambda (result) (lambda (result)
(cache-object-mapping object keys result)))))) (cache-object-mapping object keys result
#:vhash-cons vhash-cons))))))
(define-syntax-rule (mcached mvalue object keys ...) (define-syntax mcached
"Run MVALUE, which corresponds to OBJECT/KEYS, and cache it; or return the (syntax-rules (eq? equal?)
"Run MVALUE, which corresponds to OBJECT/KEYS, and cache it; or return the
value associated with OBJECT/KEYS in the store's object cache if there is value associated with OBJECT/KEYS in the store's object cache if there is
one." one."
(%mcached (lambda () mvalue) ((_ eq? mvalue object keys ...)
object (list keys ...))) (%mcached (lambda () mvalue)
object (list keys ...)
#:vhash-cons vhash-consq
#:vhash-fold* vhash-foldq*))
((_ equal? mvalue object keys ...)
(%mcached (lambda () mvalue)
object (list keys ...)
#:vhash-cons vhash-cons
#:vhash-fold* vhash-fold*))
((_ mvalue object keys ...)
(mcached eq? mvalue object keys ...))))
(define (preserve-documentation original proc) (define (preserve-documentation original proc)
"Return PROC with documentation taken from ORIGINAL." "Return PROC with documentation taken from ORIGINAL."