From 6bd3d4fe06a65db5356f4eec43a505a47acc3934 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 28 May 2021 17:45:38 +0200 Subject: grafts: Record cache lookups for profiling. * guix/grafts.scm (record-cache-lookup!): New procedure. (with-cache): Use it. --- guix/grafts.scm | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'guix') 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 @@ (define (references* items) 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 -- cgit v1.2.3