From 0a3c723e0771e488cad79ae7c6f20bc83023eeb0 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 28 May 2021 17:45:11 +0200
Subject: store: Generalize cache lookup recording.

* guix/store.scm (cache-lookup-recorder): New procedure.
(record-cache-lookup!): Define in terms of it.
---
 guix/store.scm | 23 +++++++++++++++--------
 1 file changed, 15 insertions(+), 8 deletions(-)

(limited to 'guix')

diff --git a/guix/store.scm b/guix/store.scm
index 897062efff..38d12ac5d7 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -69,6 +69,7 @@
             nix-server-socket
 
             current-store-protocol-version        ;for internal use
+            cache-lookup-recorder                 ;for internal use
             mcached
 
             &store-error store-error?
@@ -1898,21 +1899,24 @@ and RESULT is typically its derivation."
              (vhash-cons object (cons result keys)
                          (store-connection-cache store cache))))))
 
-(define record-cache-lookup!
-  (if (profiled? "object-cache")
+(define (cache-lookup-recorder component title)
+  "Return a procedure of two arguments to record cache lookups, hits, and
+misses for COMPONENT.  The procedure must be passed a Boolean indicating
+whether the cache lookup was a hit, and the actual cache (a vhash)."
+  (if (profiled? component)
       (let ((fresh    0)
             (lookups  0)
             (hits     0)
             (size     0))
         (register-profiling-hook!
-         "object-cache"
+         component
          (lambda ()
-           (format (current-error-port) "Store object cache:
+           (format (current-error-port) "~a:
   fresh caches: ~5@a
   lookups:      ~5@a
   hits:         ~5@a (~,1f%)
   cache size:   ~5@a entries~%"
-                   fresh lookups hits
+                   title fresh lookups hits
                    (if (zero? lookups)
                        100.
                        (* 100. (/ hits lookups)))
@@ -1920,9 +1924,9 @@ and RESULT is typically its derivation."
 
         (lambda (hit? cache)
           (set! fresh
-            (if (eq? cache vlist-null)
-                (+ 1 fresh)
-                fresh))
+                (if (eq? cache vlist-null)
+                    (+ 1 fresh)
+                    fresh))
           (set! lookups (+ 1 lookups))
           (set! hits (if hit? (+ hits 1) hits))
           (set! size (+ (if hit? 0 1)
@@ -1930,6 +1934,9 @@ and RESULT is typically its derivation."
       (lambda (x y)
         #t)))
 
+(define record-cache-lookup!
+  (cache-lookup-recorder "object-cache" "Store object cache"))
+
 (define-inlinable (lookup-cached-object object keys vhash-fold*)
   "Return the cached object in the store connection corresponding to OBJECT
 and KEYS; use VHASH-FOLD* to look for OBJECT in the cache.  KEYS is a list of
-- 
cgit v1.2.3