add rotating cache data structure

lib/server/cache.ml

@@ -0,0 +1,54 @@
+open! Import
+
+include (val Logging.sublogs logger "Wheel")
+
+type ('k, 'v) t = {
+  mutable index : int;
+  entries : ('k, 'v) entry array;
+  lookup : ('k, int Dllist.t) Hashtbl.t;
+}
+
+and ('k, 'v) entry =
+  | Empty
+  | Entry of 'k * 'v
+
+let make n = {
+  index = 0;
+  entries = Array.make n Empty;
+  lookup = Hashtbl.create (n * 2);
+}
+
+let find_all t k =
+  match Hashtbl.find t.lookup k with
+  | hist ->
+    Dllist.fold_r
+      (fun i vs ->
+         match t.entries.(i) with
+         | Empty -> failwith "Cache.find: BUG! empty entry"
+         | Entry (_, v) -> v :: vs)
+      hist []
+  | exception Not_found ->
+    []
+
+let evict t =
+  match t.entries.(t.index) with
+  | Empty -> ()
+  | Entry (k, _) ->
+    let hist = Hashtbl.find t.lookup k in
+    let i = Dllist.take_r hist in
+    assert (i = t.index);
+    if Dllist.is_empty hist then Hashtbl.remove t.lookup k;
+    t.entries.(i) <- Empty
+
+let add t k v =
+  evict t;
+  let i = t.index in
+  let hist = try Hashtbl.find t.lookup k
+    with Not_found ->
+      let l = Dllist.create () in
+      Hashtbl.replace t.lookup k l;
+      l
+  in
+  Dllist.add_l i hist |> ignore;
+  t.entries.(i) <- Entry (k, v);
+  t.index <- succ i mod Array.length t.entries

lib/server/test_cache.ml

@@ -0,0 +1,49 @@
+let%expect_test _ =
+  let print_list print_ele xs =
+    let rec iter pre post = function
+      | [] -> print_string post
+      | x :: xs ->
+        print_string pre;
+        print_ele x;
+        iter ";" "]" xs
+    in
+    iter "[" "[]" xs
+  in
+
+  let print_history_nl ch k =
+    print_list print_int (Cache.find_all ch k);
+    print_newline ()
+  in
+
+  let ch = Cache.make 4 in
+  Cache.add ch "x" 1;
+  Cache.add ch "y" 2;
+  Cache.add ch "y" 3;
+  Cache.add ch "z" 4;
+
+  print_history_nl ch "x"; [%expect {| [1] |}];
+  print_history_nl ch "y"; [%expect {| [3;2] |}];
+  print_history_nl ch "z"; [%expect {| [4] |}];
+  print_history_nl ch "w"; [%expect {| [] |}];
+
+  Cache.add ch "w" 5; (* evict "x:=1" *)
+
+  print_history_nl ch "x"; [%expect {| [] |}];
+  print_history_nl ch "y"; [%expect {| [3;2] |}];
+  print_history_nl ch "z"; [%expect {| [4] |}];
+  print_history_nl ch "w"; [%expect {| [5] |}];
+
+  Cache.add ch "w" 6; (* evict "y:=2" *)
+
+  print_history_nl ch "x"; [%expect {| [] |}];
+  print_history_nl ch "y"; [%expect {| [3] |}];
+  print_history_nl ch "z"; [%expect {| [4] |}];
+  print_history_nl ch "w"; [%expect {| [6;5] |}];
+
+  Cache.add ch "x" 7; (* evict "y:=3" *)
+  Cache.add ch "w" 8; (* evict "z:=4" *)
+
+  print_history_nl ch "x"; [%expect {| [7] |}];
+  print_history_nl ch "y"; [%expect {| [] |}];
+  print_history_nl ch "z"; [%expect {| [] |}];
+  print_history_nl ch "w"; [%expect {| [8;6;5] |}];