From 6bd3d4fe06a65db5356f4eec43a505a47acc3934 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 28 May 2021 17:45:38 +0200
Subject: [PATCH] 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(-)

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