Add a LRU cache to limit indexing memory usage.

CHANGES.md

@@ -7,6 +7,10 @@ Tue Jun 23 12:15:42 CEST 2026
     - Fix signature-help with type aliases (#2067, fixes #1927)
     - Fix locate on punned let bindings, to use the common identifier as the
       expression (instead of the pattern) (#2066)
+  + index format
+    - Use a LRU to reduce memory usage when indexing. Change the way small
+      values are stored. Make sub-indexes paths relative to the working
+      directory of the indexer. (#2079)
   + test suite
     - Remove the FIXME line for #1404 as the issue was already fixed and add two tests (#2073).
 

src/analysis/occurrences.ml

@@ -224,25 +224,26 @@ let get_external_locs ~(config : Mconfig.t) ~current_buffer_path uid :
 let lookup_related_uids_in_indexes ~(config : Mconfig.t) uid =
   let title = "lookup_related_uids_in_indexes" in
   let open Index_format in
-  let related_uids =
-    List.fold_left ~init:(Uid_map.empty ()) config.merlin.index_files
-      ~f:(fun acc index_file ->
+  let store, related_uids =
+    List.fold_left
+      ~init:(Uid_map.empty (), Uid_map.empty ())
+      config.merlin.index_files
+      ~f:(fun (store, acc) index_file ->
         try
           let index = Index_cache.read index_file in
-          Uid_map.union
-            (fun _ a b -> Some (Union_find.union a b))
-            index.related_uids acc
+          Union_find.merge_union store index.related_uids
+            index.related_uids_store acc
         with
         | Index_format.Not_an_index _
         | Sys_error _
         | Granular_marshal.Outdated_store _
         ->
           log ~title "Could not load index %s" index_file;
-          acc)
+          (store, acc))
   in
   Uid_map.find_opt uid related_uids
   |> Option.value_map ~default:[] ~f:(fun x ->
-      x |> Union_find.get |> Uid_set.to_list)
+      x |> Union_find.get store |> Uid_set.elements)
 
 let find_linked_uids ~config ~scope ~name uid =
   let title = "find_linked_uids" in

src/index-format/dbllist.ml

@@ -0,0 +1,145 @@
+type 'a cell =
+  { content : 'a; weight : int; mutable prev : 'a cell; mutable next : 'a cell }
+
+type stats =
+  { mutable total_cap : int;
+    mutable promote_count : int;
+    mutable add_count : int;
+    mutable discard_count : int;
+    mutable add_size : int;
+    mutable discarded_size : int
+  }
+
+type 'a dbll =
+  | Nil of int
+  | List of { first : 'a cell; last : 'a cell; size : int; cap : int }
+
+type 'a t = { mutable dbll : 'a dbll; stats : stats }
+
+exception Action_on_empty_list of string
+
+let pp_stats t =
+  let size =
+    match t.dbll with
+    | Nil _ -> 0
+    | List l -> l.size
+  in
+  Printf.eprintf
+    "total_cap \t\t: %d\n\
+     size \t\t: %d\n\
+     promote_count \t: %d\n\
+     add_count \t\t: %d\n\
+     discard_count \t: %d\n\
+     add_size \t\t: %d\n\
+     discard_size \t: %d\n\
+     volume_conservation \t: %d = %d + %d : %b\n\
+     %!"
+    t.stats.total_cap size t.stats.promote_count t.stats.add_count
+    t.stats.discard_count t.stats.add_size t.stats.discarded_size
+    t.stats.add_size t.stats.discarded_size size
+    (t.stats.add_size = t.stats.discarded_size + size)
+
+let create cap =
+  let stats =
+    { total_cap = cap;
+      promote_count = 0;
+      add_count = 0;
+      discard_count = 0;
+      add_size = 0;
+      discarded_size = 0
+    }
+  in
+  { dbll = Nil cap; stats }
+
+let add_front t (v, w) =
+  t.stats.add_count <- t.stats.add_count + 1;
+  t.stats.add_size <- t.stats.add_size + w;
+  match t.dbll with
+  | Nil cap ->
+    let rec c = { content = v; weight = w; prev = c; next = c } in
+    t.dbll <- List { first = c; last = c; size = w; cap };
+    c
+  | List l ->
+    let rec new_first =
+      { content = v; weight = w; prev = new_first; next = l.first }
+    in
+    l.first.prev <- new_first;
+    t.dbll <-
+      List { first = new_first; last = l.last; size = l.size + w; cap = l.cap };
+    new_first
+
+let discard t =
+  t.stats.discard_count <- t.stats.discard_count + 1;
+  match t.dbll with
+  | Nil _ ->
+    raise
+      (Action_on_empty_list
+         "Unable to discard the last element, the doubly linked list is empty.")
+  | List l ->
+    if l.first == l.last then (
+      t.dbll <- Nil l.cap;
+      t.stats.discarded_size <- t.stats.discarded_size + l.last.weight;
+      l.last.content)
+    else
+      let discarded_value = l.last.content in
+      let discarded_weight = l.last.weight in
+      t.stats.discarded_size <- t.stats.discarded_size + discarded_weight;
+      let new_last = l.last.prev in
+      (* TODO Should we explicitely disconnect last's pointers ? *)
+      new_last.next <- new_last;
+      (* TODO Int.max 0 (l.size - discarded_weight) does seems useless.
+         We could use an assert to check it. *)
+      (* Unlinking the discaded cell is not strictly necessary but not doing it
+         could lead to memory leaks if the user of the cache keeps a reference
+         to the cell. *)
+      l.last.next <- l.last;
+      l.last.prev <- l.last;
+      t.dbll <-
+        List
+          { first = l.first;
+            last = new_last;
+            size = Int.max 0 (l.size - discarded_weight);
+            cap = l.cap
+          };
+      discarded_value
+
+let discard_size t s =
+  (* this is fold not iter *)
+  let rec iter acc t =
+    match t.dbll with
+    | Nil _ -> acc
+    | List l -> if l.size + s <= l.cap then acc else iter (discard t :: acc) t
+  in
+  iter [] t
+
+let promote t c =
+  t.stats.promote_count <- t.stats.promote_count + 1;
+  match t.dbll with
+  | Nil _ ->
+    raise
+      (Action_on_empty_list
+         "Unable to promote a cell, the doubly linked list is empty.")
+  | List l ->
+    if l.first == c then ()
+    else if l.last == c then (
+      let new_last = l.last.prev in
+      new_last.next <- new_last;
+      let new_first = c in
+      new_first.next <- l.first;
+      new_first.prev <- new_first;
+      l.first.prev <- new_first;
+      t.dbll <-
+        List { first = new_first; last = new_last; size = l.size; cap = l.cap })
+    else
+      let voisin_prev = c.prev in
+      let voisin_next = c.next in
+      voisin_prev.next <- voisin_next;
+      voisin_next.prev <- voisin_prev;
+      let new_first = c in
+      new_first.prev <- new_first;
+      new_first.next <- l.first;
+      l.first.prev <- new_first;
+      t.dbll <-
+        List { first = new_first; last = l.last; size = l.size; cap = l.cap }
+
+let get c = c.content

src/index-format/dbllist.mli

@@ -0,0 +1,26 @@
+type 'a cell =
+  { content : 'a; weight : int; mutable prev : 'a cell; mutable next : 'a cell }
+
+type stats =
+  { mutable total_cap : int;
+    mutable promote_count : int;
+    mutable add_count : int;
+    mutable discard_count : int;
+    mutable add_size : int;
+    mutable discarded_size : int
+  }
+
+type 'a dbll =
+  | Nil of int
+  | List of { first : 'a cell; last : 'a cell; size : int; cap : int }
+
+type 'a t = { mutable dbll : 'a dbll; stats : stats }
+
+exception Action_on_empty_list of string
+
+val pp_stats : 'a t -> unit
+val create : int -> 'a t
+val add_front : 'a t -> 'a * int -> 'a cell
+val discard_size : 'a t -> int -> 'a list
+val promote : 'a t -> 'a cell -> unit
+val get : 'a cell -> 'a

src/index-format/dune

@@ -7,4 +7,4 @@
   -open Ocaml_typing
   -open Ocaml_utils
   -open Merlin_utils)
- (libraries ocaml_parsing ocaml_typing ocaml_utils merlin_utils))
+ (libraries unix ocaml_parsing ocaml_typing ocaml_utils merlin_utils))

src/index-format/granular_map.ml

@@ -31,6 +31,7 @@ module type S = sig
   val choose_opt : 'a t -> (key * 'a) option
   val iter : (key -> 'a -> unit) -> 'a t -> unit
   val iter_in_memory : (key -> 'a -> unit) -> 'a t -> unit
+
   val fold : (key -> 'a -> 'acc -> 'acc) -> 'a t -> 'acc -> 'acc
   val map : ('a -> 'b) -> 'a t -> 'b t
   val is_empty : 'a t -> bool