From 9dcf353c67ac2693c0c934622d4c6a7332c80562 Mon Sep 17 00:00:00 2001
From: Rafal Gwozdzinski <rafal@gwozdzinski.com>
Date: Wed, 22 Nov 2023 10:17:44 +0100
Subject: [PATCH 1/3] Cache stats

---
 src/frontend/ocamlmerlin/new/new_merlin.ml |  5 ++++
 src/kernel/mpipeline.ml                    | 35 +++++++++++++++++++---
 src/kernel/mpipeline.mli                   |  1 +
 src/kernel/mtyper.ml                       | 25 +++++++++-------
 src/kernel/mtyper.mli                      |  2 ++
 src/utils/file_cache.ml                    | 11 +++++--
 src/utils/file_cache.mli                   |  3 ++
 tests/merlin-wrapper                       |  1 +
 8 files changed, 67 insertions(+), 16 deletions(-)

diff --git a/src/frontend/ocamlmerlin/new/new_merlin.ml b/src/frontend/ocamlmerlin/new/new_merlin.ml
index 446ce1aaa5..203056e388 100644
--- a/src/frontend/ocamlmerlin/new/new_merlin.ml
+++ b/src/frontend/ocamlmerlin/new/new_merlin.ml
@@ -132,12 +132,17 @@ let run = function
           let notify { Logger.section; msg } =
             `String (Printf.sprintf "%s: %s" section msg)
           in
+          let cache = Mpipeline.cache_information pipeline in
+          let format_cache (k,v) =
+            let fmt_str (k, v) = (k, `String v) in
+            (k, `Assoc (List.map fmt_str v)) in
           let format_timing (k,v) = (k, `Int (int_of_float (0.5 +. v))) in
           `Assoc [
             "class", `String class_; "value", message;
             "notifications", `List (List.rev_map notify !notifications);
             "timing", `Assoc (List.map format_timing timing);
             "heap_mbytes", `Int heap_mbytes
+            "cache", `Assoc (List.map format_cache cache)
           ]
         in
         log ~title:"run(result)" "%a" Logger.json (fun () -> json);
diff --git a/src/kernel/mpipeline.ml b/src/kernel/mpipeline.ml
index 6b63af6be5..0840243358 100644
--- a/src/kernel/mpipeline.ml
+++ b/src/kernel/mpipeline.ml
@@ -99,6 +99,10 @@ type t = {
   ppx_time    : float ref;
   typer_time  : float ref;
   error_time  : float ref;
+
+  ppx_cache_hit : bool ref;
+  reader_cache_hit : bool ref;
+  buffer_cache_stats : string ref;
 }
 
 let raw_source t = t.raw_source
@@ -231,6 +235,9 @@ let process
     ?(ppx_time=ref 0.0)
     ?(typer_time=ref 0.0)
     ?(error_time=ref 0.0)
+    ?(ppx_cache_hit = ref false)
+    ?(reader_cache_hit = ref false)
+    ?(buffer_cache_stats = ref "")
     ?for_completion
     config raw_source =
   let state = match state with
@@ -267,10 +274,11 @@ let process
               Some "source preprocessor usage"
             | true, None -> None
           in
-          let { Reader_with_cache.output = { result; cache_version }; _ } =
+          let { Reader_with_cache.output = { result; cache_version }; cache_was_hit } =
             Reader_with_cache.apply ~cache_disabling
               { source; for_completion; config }
           in
+          reader_cache_hit := cache_was_hit;
           let cache_version =
             if Option.is_some cache_disabling then None else Some cache_version
           in
@@ -280,7 +288,7 @@ let process
       let (lazy {
             Reader.result = { Mreader.parsetree; _ };
             config;
-            cache_version;
+            cache_version
           }) = reader
       in
       let caught = ref [] in
@@ -293,10 +301,11 @@ let process
         | Some v -> None, Ppx_phase.Version v
         | None -> Some "reader cache is disabled", Off
       in
-      let { Ppx_with_cache.output = parsetree; _ } =
+      let { Ppx_with_cache.output = parsetree; cache_was_hit } =
         Ppx_with_cache.apply ~cache_disabling
           {parsetree; config; reader_cache}
       in
+      ppx_cache_hit := cache_was_hit;
       { Ppx.config; parsetree; errors = !caught }
     )) in
   let typer = timed_lazy typer_time (lazy (
@@ -304,10 +313,12 @@ let process
       Mocaml.setup_typer_config config;
       let result = Mtyper.run config parsetree in
       let errors = timed_lazy error_time (lazy (Mtyper.get_errors result)) in
+      buffer_cache_stats := Mtyper.get_cache_stat result;
       { Typer. errors; result }
     )) in
   { config; state; raw_source; source; reader; ppx; typer;
-    pp_time; reader_time; ppx_time; typer_time; error_time }
+    pp_time; reader_time; ppx_time; typer_time; error_time;
+    ppx_cache_hit; reader_cache_hit; buffer_cache_stats }
 
 let make config source =
   process (Mconfig.normalize config) source
@@ -325,3 +336,19 @@ let timing_information t = [
   "typer"  , !(t.typer_time);
   "error"  , !(t.error_time);
 ]
+
+let cache_information t =
+  let fmt_bool hit = if hit then "hit" else "miss" in
+  let phase = ("phase", [
+  "reader" , fmt_bool !(t.reader_cache_hit);
+  "ppx"    , fmt_bool !(t.ppx_cache_hit);
+  ]) in
+  let fmt_file (filename, hit) = (filename, fmt_bool hit) in
+  let cmt = ("cmt", List.map ~f:fmt_file (Cmt_cache.get_cache_stats ())) in
+  let cmi = ("cmi", List.map ~f:fmt_file (Cmi_cache.get_cache_stats ())) in
+  Cmt_cache.clear_cache_stats ();
+  Cmi_cache.clear_cache_stats ();
+  let buffer = ("buffer", [
+      "stats", !(t.buffer_cache_stats)
+  ]) in
+  [phase; cmt; cmi; buffer]
diff --git a/src/kernel/mpipeline.mli b/src/kernel/mpipeline.mli
index 24355f19fa..da6854de3b 100644
--- a/src/kernel/mpipeline.mli
+++ b/src/kernel/mpipeline.mli
@@ -26,3 +26,4 @@ val typer_result : t -> Mtyper.result
 val typer_errors : t -> exn list
 
 val timing_information : t -> (string * float) list
+val cache_information : t -> (string * (string * string) list) list
diff --git a/src/kernel/mtyper.ml b/src/kernel/mtyper.ml
index 8920e76b41..f24c1f1287 100644
--- a/src/kernel/mtyper.ml
+++ b/src/kernel/mtyper.ml
@@ -30,7 +30,7 @@ let fresh_env config =
 
 let get_cache config =
   match !cache with
-  | Some (env0, snap0, stamp0, items) when Types.is_valid snap0 ->
+  | Some (env0, snap0, stamp0, items, _) when Types.is_valid snap0 ->
     env0, snap0, stamp0, Some items
   | Some _ | None ->
     let env0, snap0, stamp0 = fresh_env config in
@@ -51,10 +51,13 @@ type result = {
     | `Implementation of
         (Parsetree.structure_item, Typedtree.structure_item) item list
   ];
+  cache_stat : string
 }
 
 let initial_env res = res.initial_env
 
+let get_cache_stat res = res.cache_stat
+
 let compatible_prefix result_items tree_items =
   let rec aux acc = function
     | (ritem :: ritems, pitem :: pitems)
@@ -62,9 +65,11 @@ let compatible_prefix result_items tree_items =
         && compare ritem.parsetree_item pitem = 0 ->
       aux (ritem :: acc) (ritems, pitems)
     | (_, pitems) ->
+      let cache_stat = Printf.sprintf "reusing %d items, %d new items to type"
+        (List.length acc) (List.length pitems) in
       log ~title:"compatible_prefix" "reusing %d items, %d new items to type"
         (List.length acc) (List.length pitems);
-      acc, pitems
+      acc, pitems, cache_stat
   in
   aux [] (result_items, tree_items)
 
@@ -103,10 +108,10 @@ let rec type_signature caught env = function
 
 let type_implementation config caught parsetree =
   let env0, snap0, stamp0, prefix = get_cache config in
-  let prefix, parsetree =
+  let prefix, parsetree, cache_stat =
     match prefix with
     | Some (`Implementation items) -> compatible_prefix items parsetree
-    | Some (`Interface _) | None -> ([], parsetree)
+    | Some (`Interface _) | None -> ([], parsetree, "miss")
   in
   let env', snap', stamp', warn' = match prefix with
     | [] -> (env0, snap0, stamp0, Warnings.backup ())
@@ -120,14 +125,14 @@ let type_implementation config caught parsetree =
   Env.cleanup_functor_caches ~stamp:stamp';
   let suffix = type_structure caught env' parsetree in
   return_and_cache
-    (env0, snap0, stamp0, `Implementation (List.rev_append prefix suffix))
+    (env0, snap0, stamp0, `Implementation (List.rev_append prefix suffix), cache_stat)
 
 let type_interface config caught parsetree =
   let env0, snap0, stamp0, prefix = get_cache config in
-  let prefix, parsetree =
+  let prefix, parsetree, cache_stat =
     match prefix with
     | Some (`Interface items) -> compatible_prefix items parsetree
-    | Some (`Implementation _) | None -> ([], parsetree)
+    | Some (`Implementation _) | None -> ([], parsetree, "miss")
   in
   let env', snap', stamp', warn' = match prefix with
     | [] -> (env0, snap0, stamp0, Warnings.backup ())
@@ -141,7 +146,7 @@ let type_interface config caught parsetree =
   Env.cleanup_functor_caches ~stamp:stamp';
   let suffix = type_signature caught env' parsetree in
   return_and_cache
-    (env0, snap0, stamp0, `Interface (List.rev_append prefix suffix))
+    (env0, snap0, stamp0, `Interface (List.rev_append prefix suffix), cache_stat)
 
 let run config parsetree =
   if not (Env.check_state_consistency ()) then (
@@ -156,12 +161,12 @@ let run config parsetree =
   let caught = ref [] in
   Msupport.catch_errors Mconfig.(config.ocaml.warnings) caught @@ fun () ->
   Typecore.reset_delayed_checks ();
-  let initial_env, initial_snapshot, initial_stamp, typedtree = match parsetree with
+  let initial_env, initial_snapshot, initial_stamp, typedtree, cache_stat = match parsetree with
     | `Implementation parsetree -> type_implementation config caught parsetree
     | `Interface parsetree -> type_interface config caught parsetree
   in
   Typecore.reset_delayed_checks ();
-  { config; initial_env; initial_snapshot; initial_stamp; typedtree }
+  { config; initial_env; initial_snapshot; initial_stamp; typedtree; cache_stat }
 
 let get_env ?pos:_ t =
   Option.value ~default:t.initial_env (
diff --git a/src/kernel/mtyper.mli b/src/kernel/mtyper.mli
index 77820e2b17..4acb235ca9 100644
--- a/src/kernel/mtyper.mli
+++ b/src/kernel/mtyper.mli
@@ -24,6 +24,8 @@ val get_errors : result -> exn list
 
 val initial_env : result -> Env.t
 
+val get_cache_stat : result -> string
+
 (** Heuristic to find suitable environment to complete / type at given position.
  *  1. Try to find environment near given cursor.
  *  2. Check if there is an invalid construct between found env and cursor :
diff --git a/src/utils/file_cache.ml b/src/utils/file_cache.ml
index 1010867ced..4e79b7439f 100644
--- a/src/utils/file_cache.ml
+++ b/src/utils/file_cache.ml
@@ -36,10 +36,16 @@ end) = struct
   let cache : (string, File_id.t * float ref * Input.t) Hashtbl.t
             = Hashtbl.create 17
 
+  let cache_stats = ref []
+
+  let get_cache_stats () = !cache_stats
+  let clear_cache_stats () = cache_stats := []
+
   let get_cached_entry ~title fid filename =
     let fid', latest_use, file = Hashtbl.find cache filename in
-    if (File_id.check fid fid') then
-      log ~title "reusing %S" filename
+    if (File_id.check fid fid') then (
+      log ~title "reusing %S" filename;
+      cache_stats := (filename, true) :: !cache_stats)
     else (
       log ~title "%S was updated on disk" filename;
       raise Not_found;
@@ -53,6 +59,7 @@ end) = struct
     try get_cached_entry ~title fid filename
     with Not_found ->
     try
+      cache_stats := (filename, false) :: !cache_stats;
       log ~title "reading %S from disk" filename;
       let file = Input.read filename in
       Hashtbl.replace cache filename (fid, ref (Unix.time ()), file);
diff --git a/src/utils/file_cache.mli b/src/utils/file_cache.mli
index 33fb2b8ed6..2fa80b6b1b 100644
--- a/src/utils/file_cache.mli
+++ b/src/utils/file_cache.mli
@@ -38,4 +38,7 @@ end) : sig
 
   val get_cached_entry : string -> Input.t
   (** @raises Not_found if the file is not in cache. *)
+
+  val get_cache_stats : unit -> (string * bool) list
+  val clear_cache_stats : unit -> unit
 end
diff --git a/tests/merlin-wrapper b/tests/merlin-wrapper
index b343c6cb26..f38e307034 100755
--- a/tests/merlin-wrapper
+++ b/tests/merlin-wrapper
@@ -11,6 +11,7 @@ fi
 ocamlmerlin "$@" \
     | jq 'del(.timing)' \
     | jq 'del(.heap_mbytes)' \
+    | jq 'del(.cache)' \
     | sed -e 's:"[^"]*lib/ocaml:"lib/ocaml:g' \
     | sed -e 's:\\n:\
 :g'

From a91dc3d56f1f78530631ddf293406b0e8a872ba1 Mon Sep 17 00:00:00 2001
From: Rafal Gwozdzinski <rafal@gwozdzinski.com>
Date: Fri, 8 Dec 2023 13:14:25 +0100
Subject: [PATCH 2/3] Add changelog to #1711

---
 CHANGES.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/CHANGES.md b/CHANGES.md
index c64e869f21..d7e1121fe5 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -3,6 +3,8 @@ merlin NEXT_VERSION
 
   + merlin binary
     - Add a "heap_mbytes" field to Merlin server responses to report heap usage (#1717)
+    - Add cache stats to telemetry (#1711)
+
 
 merlin 4.13
 ===========

From 90d8b70f280795ce15786234935bfce18982a85b Mon Sep 17 00:00:00 2001
From: Rafal Gwozdzinski <rafal@gwozdzinski.com>
Date: Tue, 12 Dec 2023 09:09:04 +0100
Subject: [PATCH 3/3] Apply review comments to #1711

---
 src/frontend/ocamlmerlin/new/new_merlin.ml |  8 +---
 src/kernel/mpipeline.ml                    | 45 ++++++++++++++--------
 src/kernel/mpipeline.mli                   |  2 +-
 src/kernel/mtyper.ml                       | 15 +++++---
 src/kernel/mtyper.mli                      |  4 +-
 src/utils/file_cache.ml                    | 13 ++++---
 src/utils/file_cache.mli                   |  3 +-
 7 files changed, 53 insertions(+), 37 deletions(-)

diff --git a/src/frontend/ocamlmerlin/new/new_merlin.ml b/src/frontend/ocamlmerlin/new/new_merlin.ml
index 203056e388..d971dacead 100644
--- a/src/frontend/ocamlmerlin/new/new_merlin.ml
+++ b/src/frontend/ocamlmerlin/new/new_merlin.ml
@@ -132,17 +132,13 @@ let run = function
           let notify { Logger.section; msg } =
             `String (Printf.sprintf "%s: %s" section msg)
           in
-          let cache = Mpipeline.cache_information pipeline in
-          let format_cache (k,v) =
-            let fmt_str (k, v) = (k, `String v) in
-            (k, `Assoc (List.map fmt_str v)) in
           let format_timing (k,v) = (k, `Int (int_of_float (0.5 +. v))) in
           `Assoc [
             "class", `String class_; "value", message;
             "notifications", `List (List.rev_map notify !notifications);
             "timing", `Assoc (List.map format_timing timing);
-            "heap_mbytes", `Int heap_mbytes
-            "cache", `Assoc (List.map format_cache cache)
+            "heap_mbytes", `Int heap_mbytes;
+            "cache", Mpipeline.cache_information pipeline
           ]
         in
         log ~title:"run(result)" "%a" Logger.json (fun () -> json);
diff --git a/src/kernel/mpipeline.ml b/src/kernel/mpipeline.ml
index 0840243358..cbfedbe790 100644
--- a/src/kernel/mpipeline.ml
+++ b/src/kernel/mpipeline.ml
@@ -102,7 +102,7 @@ type t = {
 
   ppx_cache_hit : bool ref;
   reader_cache_hit : bool ref;
-  buffer_cache_stats : string ref;
+  typer_cache_stats : Mtyper.typer_cache_stats ref;
 }
 
 let raw_source t = t.raw_source
@@ -237,7 +237,7 @@ let process
     ?(error_time=ref 0.0)
     ?(ppx_cache_hit = ref false)
     ?(reader_cache_hit = ref false)
-    ?(buffer_cache_stats = ref "")
+    ?(typer_cache_stats = ref Mtyper.Miss)
     ?for_completion
     config raw_source =
   let state = match state with
@@ -288,7 +288,7 @@ let process
       let (lazy {
             Reader.result = { Mreader.parsetree; _ };
             config;
-            cache_version
+            cache_version;
           }) = reader
       in
       let caught = ref [] in
@@ -313,12 +313,12 @@ let process
       Mocaml.setup_typer_config config;
       let result = Mtyper.run config parsetree in
       let errors = timed_lazy error_time (lazy (Mtyper.get_errors result)) in
-      buffer_cache_stats := Mtyper.get_cache_stat result;
+      typer_cache_stats := Mtyper.get_cache_stat result;
       { Typer. errors; result }
     )) in
   { config; state; raw_source; source; reader; ppx; typer;
     pp_time; reader_time; ppx_time; typer_time; error_time;
-    ppx_cache_hit; reader_cache_hit; buffer_cache_stats }
+    ppx_cache_hit; reader_cache_hit; typer_cache_stats }
 
 let make config source =
   process (Mconfig.normalize config) source
@@ -338,17 +338,28 @@ let timing_information t = [
 ]
 
 let cache_information t =
-  let fmt_bool hit = if hit then "hit" else "miss" in
-  let phase = ("phase", [
-  "reader" , fmt_bool !(t.reader_cache_hit);
-  "ppx"    , fmt_bool !(t.ppx_cache_hit);
-  ]) in
-  let fmt_file (filename, hit) = (filename, fmt_bool hit) in
-  let cmt = ("cmt", List.map ~f:fmt_file (Cmt_cache.get_cache_stats ())) in
-  let cmi = ("cmi", List.map ~f:fmt_file (Cmi_cache.get_cache_stats ())) in
+  let typer =
+    match !(t.typer_cache_stats) with
+    | Miss -> `String "miss"
+    | Hit { reused; typed } ->
+      `Assoc
+        [ "reused" , `Int reused;
+          "typed", `Int typed
+        ]
+  in
+  let fmt_hit_miss h m =
+    `Assoc [ "hit", `Int h; "miss", `Int m ] in
+  let cmt_stat = Cmt_cache.get_cache_stats () in
+  let cmt = fmt_hit_miss cmt_stat.hit cmt_stat.miss in
+  let cmi_stat = Cmi_cache.get_cache_stats () in
+  let cmi = fmt_hit_miss cmi_stat.hit cmi_stat.miss in
   Cmt_cache.clear_cache_stats ();
   Cmi_cache.clear_cache_stats ();
-  let buffer = ("buffer", [
-      "stats", !(t.buffer_cache_stats)
-  ]) in
-  [phase; cmt; cmi; buffer]
+  let fmt_bool hit = `String (if hit then "hit" else "miss") in
+  `Assoc [
+    "reader_phase" , fmt_bool !(t.reader_cache_hit);
+    "ppx_phase"    , fmt_bool !(t.ppx_cache_hit);
+    "typer"        , typer;
+    "cmt"          , cmt;
+    "cmi"          , cmi
+  ]
diff --git a/src/kernel/mpipeline.mli b/src/kernel/mpipeline.mli
index da6854de3b..58355efdce 100644
--- a/src/kernel/mpipeline.mli
+++ b/src/kernel/mpipeline.mli
@@ -26,4 +26,4 @@ val typer_result : t -> Mtyper.result
 val typer_errors : t -> exn list
 
 val timing_information : t -> (string * float) list
-val cache_information : t -> (string * (string * string) list) list
+val cache_information : t -> Std.json
diff --git a/src/kernel/mtyper.ml b/src/kernel/mtyper.ml
index f24c1f1287..034cb10c7d 100644
--- a/src/kernel/mtyper.ml
+++ b/src/kernel/mtyper.ml
@@ -19,6 +19,8 @@ type typedtree = [
   | `Implementation of Typedtree.structure
 ]
 
+type typer_cache_stats = Miss | Hit of { reused : int; typed : int }
+
 let cache = s_ref None
 
 let fresh_env config =
@@ -51,7 +53,7 @@ type result = {
     | `Implementation of
         (Parsetree.structure_item, Typedtree.structure_item) item list
   ];
-  cache_stat : string
+  cache_stat : typer_cache_stats
 }
 
 let initial_env res = res.initial_env
@@ -65,10 +67,11 @@ let compatible_prefix result_items tree_items =
         && compare ritem.parsetree_item pitem = 0 ->
       aux (ritem :: acc) (ritems, pitems)
     | (_, pitems) ->
-      let cache_stat = Printf.sprintf "reusing %d items, %d new items to type"
-        (List.length acc) (List.length pitems) in
+      let reused = List.length acc in
+      let typed = List.length pitems in
+      let cache_stat = Hit { reused; typed } in
       log ~title:"compatible_prefix" "reusing %d items, %d new items to type"
-        (List.length acc) (List.length pitems);
+        reused typed;
       acc, pitems, cache_stat
   in
   aux [] (result_items, tree_items)
@@ -111,7 +114,7 @@ let type_implementation config caught parsetree =
   let prefix, parsetree, cache_stat =
     match prefix with
     | Some (`Implementation items) -> compatible_prefix items parsetree
-    | Some (`Interface _) | None -> ([], parsetree, "miss")
+    | Some (`Interface _) | None -> ([], parsetree, Miss)
   in
   let env', snap', stamp', warn' = match prefix with
     | [] -> (env0, snap0, stamp0, Warnings.backup ())
@@ -132,7 +135,7 @@ let type_interface config caught parsetree =
   let prefix, parsetree, cache_stat =
     match prefix with
     | Some (`Interface items) -> compatible_prefix items parsetree
-    | Some (`Implementation _) | None -> ([], parsetree, "miss")
+    | Some (`Implementation _) | None -> ([], parsetree, Miss)
   in
   let env', snap', stamp', warn' = match prefix with
     | [] -> (env0, snap0, stamp0, Warnings.backup ())
diff --git a/src/kernel/mtyper.mli b/src/kernel/mtyper.mli
index 4acb235ca9..fd6a7a6b77 100644
--- a/src/kernel/mtyper.mli
+++ b/src/kernel/mtyper.mli
@@ -14,6 +14,8 @@ type typedtree = [
   | `Implementation of Typedtree.structure
 ]
 
+type typer_cache_stats = Miss | Hit of { reused : int; typed : int }
+
 val run : Mconfig.t -> Mreader.parsetree -> result
 
 val get_env : ?pos:Msource.position -> result -> Env.t
@@ -24,7 +26,7 @@ val get_errors : result -> exn list
 
 val initial_env : result -> Env.t
 
-val get_cache_stat : result -> string
+val get_cache_stat : result -> typer_cache_stats
 
 (** Heuristic to find suitable environment to complete / type at given position.
  *  1. Try to find environment near given cursor.
diff --git a/src/utils/file_cache.ml b/src/utils/file_cache.ml
index 4e79b7439f..0ce83ef54b 100644
--- a/src/utils/file_cache.ml
+++ b/src/utils/file_cache.ml
@@ -36,16 +36,19 @@ end) = struct
   let cache : (string, File_id.t * float ref * Input.t) Hashtbl.t
             = Hashtbl.create 17
 
-  let cache_stats = ref []
+  type cache_stats = { hit: int; miss: int }
+  let cache_hit = ref 0
+  let cache_miss = ref 0
 
-  let get_cache_stats () = !cache_stats
-  let clear_cache_stats () = cache_stats := []
+  let get_cache_stats () = { hit = !cache_hit; miss = !cache_miss }
+  let clear_cache_stats () =
+    cache_hit := 0; cache_miss := 0
 
   let get_cached_entry ~title fid filename =
     let fid', latest_use, file = Hashtbl.find cache filename in
     if (File_id.check fid fid') then (
       log ~title "reusing %S" filename;
-      cache_stats := (filename, true) :: !cache_stats)
+      cache_hit := !cache_hit + 1)
     else (
       log ~title "%S was updated on disk" filename;
       raise Not_found;
@@ -59,7 +62,7 @@ end) = struct
     try get_cached_entry ~title fid filename
     with Not_found ->
     try
-      cache_stats := (filename, false) :: !cache_stats;
+      cache_miss := !cache_miss + 1;
       log ~title "reading %S from disk" filename;
       let file = Input.read filename in
       Hashtbl.replace cache filename (fid, ref (Unix.time ()), file);
diff --git a/src/utils/file_cache.mli b/src/utils/file_cache.mli
index 2fa80b6b1b..5ea735405b 100644
--- a/src/utils/file_cache.mli
+++ b/src/utils/file_cache.mli
@@ -39,6 +39,7 @@ end) : sig
   val get_cached_entry : string -> Input.t
   (** @raises Not_found if the file is not in cache. *)
 
-  val get_cache_stats : unit -> (string * bool) list
+  type cache_stats = { hit: int; miss: int }
+  val get_cache_stats : unit -> cache_stats
   val clear_cache_stats : unit -> unit
 end