summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-05-28 17:45:38 +0200
committerLudovic Courtès <ludo@gnu.org>2021-06-08 09:25:49 +0200
commit6bd3d4fe06a65db5356f4eec43a505a47acc3934 (patch)
treeadfc7d7dc5005b862a91091374363ae492f5626b /guix
parent0a3c723e0771e488cad79ae7c6f20bc83023eeb0 (diff)
grafts: Record cache lookups for profiling.
* guix/grafts.scm (record-cache-lookup!): New procedure. (with-cache): Use it.
Diffstat (limited to 'guix')
-rw-r--r--guix/grafts.scm10
1 files 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