mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-02-02 08:07:29 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

grafts: Record cache lookups for profiling.

Browse source 
* guix/grafts.scm (record-cache-lookup!): New procedure.
(with-cache): Use it.
This commit is contained in:
Ludovic Courtès 2021-05-28 17:45:38 +02:00
parent 0a3c723e07
commit 6bd3d4fe06
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 8 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
guix/grafts.scm
View file

@ -172,10 +172,16 @@ (define (references* items)
items)))) items))))
(remove (cut member <> self) refs))) (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 ...) (define-syntax-rule (with-cache key exp ...)
"Cache the value of monadic expression EXP under KEY." "Cache the value of monadic expression EXP under KEY."
(mlet %state-monad ((cache (current-state))) (mlet* %state-monad ((cache (current-state))
(match (vhash-assoc key cache) (result -> (vhash-assoc key cache)))
(record-cache-lookup! result cache)
(match result
((_ . result) ;cache hit ((_ . result) ;cache hit
(return result)) (return result))
(#f ;cache miss (#f ;cache miss