Add LRU to improve the memory usage of the indexer

src/index-format/dbllist.ml

@@ -0,0 +1,192 @@
+type 'a cell =
+  { mutable content : 'a;
+    weight : int;
+    mutable prev : 'a cell;
+    mutable next : 'a cell
+  }
+
+type stats = {
+  mutable total_cap : int;
+  mutable promote : int;
+  mutable add : int;
+  mutable discard : int;
+}
+
+type 'a dbll =
+  | Nil of int
+  | List of
+      { mutable first : 'a cell;
+        mutable last : 'a cell;
+        mutable size : int;
+        cap : int;
+      }
+
+type 'a t = { mutable dbll : 'a dbll; stats : stats }
+
+exception Action_on_empty_list of string
+
+(* let pp_stats oc t =
+  Printf.fprintf oc "total_cap \t: %d\nsize \t: %d\npromote \t: %d\nadd \t\t: %d\ndiscard \t: %d\n%!"
+  t.stats.total_cap
+  (match t.dbll with | Nil _ -> 0 | List l -> l.size)
+  t.stats.promote
+  t.stats.add
+  t.stats.discard *)
+
+let pp_stats t =
+  Format.eprintf "total_cap \t: %d\nsize \t: %d\npromote \t: %d\nadd \t\t: %d\ndiscard \t: %d\n%!"
+  t.stats.total_cap
+  (match t.dbll with | Nil _ -> 0 | List l -> l.size)
+  t.stats.promote
+  t.stats.add
+  t.stats.discard
+
+
+(* let clear t =
+  match !t with
+  | Nil _ -> ()
+  | List l -> t := Nil l.cap *)
+
+let create cap =
+  let stats = { total_cap = cap; promote = 0; add = 0; discard = 0; } in
+  { dbll = Nil cap; stats }
+
+(* let is_empty l =
+  match !l with
+  | Nil _ -> true
+  | List _ -> false *)
+
+let add_front t (v, w) =
+  t.stats.add <- t.stats.add + 1;
+  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 <- t.stats.discard + 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;
+      l.last.content)
+    else
+      let discarded_value = l.last.content in
+      let discarded_weight = l.last.weight in
+      let new_last = l.last.prev in
+      new_last.next <- new_last;
+      t.dbll <-
+        List
+          { first = l.first;
+            last = new_last;
+            size = l.size - discarded_weight;
+            cap = l.cap;
+          };
+      discarded_value
+
+let discard_size t s =
+  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 discard_cell t c =
+  match !t with
+  | Nil _ ->
+    raise
+      (Action_on_empty_list
+         "Unable to discard a cell, the doubly linked list is empty.")
+  | List l ->
+    (if l.first == c && l.last == c then t := Nil l.cap
+     else if l.last == c then (
+       l.last <- c.prev;
+       c.prev.next <- c.prev)
+     else if l.first == c then (
+       l.first <- c.next;
+       c.next.prev <- c.next)
+     else
+       let voisin_prev = c.prev in
+       let voisin_next = c.next in
+       voisin_prev.next <- voisin_next;
+       voisin_next.prev <- voisin_prev);
+    c.content *)
+
+let promote_update t c v =
+  t.stats.promote <- t.stats.promote + 1;
+  match t.dbll with
+  | Nil _ ->
+    raise
+      (Action_on_empty_list
+         "Unable to promote a cell, the doubly linked list is empty.")
+  | List l ->
+    c.content <- v;
+    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 promote t c = promote_update t c c.content
+
+let get c = c.content
+
+let length t =
+  let rec iter c acc =
+    Format.eprintf "dbllist.length\n%!";
+    if c == c.next then acc else
+    iter c.next (acc + 1)
+  in
+  match t.dbll with
+  | Nil _ -> 0
+  | List l -> iter l.first 1
+
+let mem t v =
+  match t.dbll with
+  | Nil _ -> false
+  | List l ->
+    let rec iter c =
+      Format.eprintf "dbllist.mem\n%!";
+      if c.content = v then true
+      else if c.next == c then false
+      else iter c.next
+    in
+    iter l.first
+
+let get_first t =
+  match t.dbll with
+  | Nil _ -> None
+  | List l -> Some l.first
+
+let is_last c = c == c.next
+
+let get_next c = c.next

src/index-format/dbllist.mli

@@ -0,0 +1,27 @@
+type 'a cell =
+  { mutable content : 'a;
+    weight : int;
+    mutable prev : 'a cell;
+    mutable next : 'a cell
+  }
+
+type 'a t
+
+(* val clear : 'a t -> unit *)
+val create : int -> 'a t
+(* val is_empty : 'a t -> bool *)
+val add_front : 'a t -> 'a * int -> 'a cell
+val discard : 'a t -> 'a
+val discard_size : 'a t -> int -> 'a list
+(* val discard_cell : 'a t -> 'a cell -> 'a *)
+val promote : 'a t -> 'a cell -> unit
+val get : 'a cell -> 'a
+val promote_update : 'a t -> 'a cell -> 'a -> unit
+(* val pp_stats : out_channel -> 'a t -> unit *)
+val pp_stats : 'a t -> unit
+val length : 'a t -> int
+val mem : 'a t -> 'a -> bool
+
+val get_first : 'a t -> 'a cell option
+val is_last : 'a cell -> bool
+val get_next : 'a cell -> 'a cell

src/index-format/granular_map.ml

@@ -30,6 +30,7 @@ module type S = sig
   val find_opt : key -> 'a t -> 'a option
   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
@@ -191,6 +192,15 @@ module Make (Ord : Map.OrderedType) = struct
       f v d;
       iter f r
 
+  let rec iter_in_memory f s =
+    if Granular_marshal.is_on_disk s then
+      match fetch s with
+      | Empty -> ()
+      | Node { l; v; d; r; _ } ->
+        iter_in_memory f l;
+        f v d;
+        iter_in_memory f r
+
   let rec map f s =
     match fetch s with
     | Empty -> empty ()

src/index-format/granular_map.mli

@@ -28,6 +28,7 @@ module type S = sig
   val find_opt : key -> 'a t -> 'a option
   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