[bug#68266] [PATCH v2] guix: store: Add report-object-cache-duplication.

[Christopher Baines]

This is intended to help with spotting duplication in the object cache, so
where many keys, for example package records map to the same derivation. This
represents an opportunity for improved performance if you can reduce this
duplication in the cache, and better take advantage of the already present
cache entries.

I'm thinking this can be used by the data service, but maybe it could also be
worked in to guix commands.

* guix/store.scm (report-object-cache-duplication): New procedure.

Change-Id: Ia6c816f871d10cae6807543224250110099d764f
---
 guix/store.scm | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 59 insertions(+)

diff --git a/guix/store.scm b/guix/store.scm
index 97c4f32a5b..86ca293cac 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -70,6 +70,7 @@ (define-module (guix store)
             current-store-protocol-version        ;for internal use
             cache-lookup-recorder                 ;for internal use
             mcached
+            report-object-cache-duplication
 
             &store-error store-error?
             &store-connection-error store-connection-error?
@@ -2037,6 +2038,64 @@ (define-syntax mcached
     ((_ mvalue object keys ...)
      (mcached eq? mvalue object keys ...))))
 
+(define* (report-object-cache-duplication store #:key (threshold 10)
+                                          (port (current-error-port)))
+  (define cache-values-to-keys
+    (make-hash-table))
+
+  (define (insert key val)
+    (hash-set!
+     cache-values-to-keys
+     key
+     (or (and=> (hash-ref cache-values-to-keys
+                          key)
+                (lambda (existing-values)
+                  (cons val existing-values)))
+         (list val))))
+
+  (let* ((cache-size
+          (vhash-fold
+           (lambda (key value result)
+             (match value
+               ((item . keys*)
+                (insert item key)))
+
+             (+ 1 result))
+           0
+           (store-connection-cache store %object-cache-id)))
+         (cached-values-by-key-count
+          (sort
+           (hash-map->list
+            (lambda (key value)
+              (cons key (length value)))
+            cache-values-to-keys)
+           (lambda (a b)
+             (< (cdr a) (cdr b))))))
+
+    (filter-map
+     (match-lambda
+       ((value . count)
+        (if (>= count threshold)
+            (begin
+              (when port
+                (simple-format port "value ~A cached ~A times\n" value count)
+                (simple-format port "example keys:\n"))
+
+              (let ((keys (hash-ref cache-values-to-keys value)))
+                (when port
+                  (for-each
+                   (lambda (key)
+                     (simple-format #t "  - ~A\n" key))
+                   (if (> count 10)
+                       (take keys 10)
+                       keys))
+                  (newline port))
+
+                `((value . ,value)
+                  (keys . ,keys))))
+            #f)))
+     cached-values-by-key-count)))
+
 (define (preserve-documentation original proc)
   "Return PROC with documentation taken from ORIGINAL."
   (set-object-property! proc 'documentation

base-commit: e541f9593f8bfc84b6140c2408b393243289fae6
-- 
2.41.0