create wheel data structure for implementing pings

lib/server/test_wheel.ml

@@ -0,0 +1,37 @@
+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_ints_nl xs = print_list print_int xs; print_newline () in
+
+  let wh = Wheel.make 4 in
+  (* t=0 *)
+  Wheel.add wh 1 |> ignore;
+  Wheel.add wh 2 |> ignore;
+  Wheel.add wh 3 |> ignore;
+  (* t=1 *)
+  print_ints_nl (Wheel.tick wh); [%expect {| [] |}];
+  Wheel.add wh 4 |> ignore;
+  Wheel.add wh 5 |> ignore;
+  (* t=2 *)
+  print_ints_nl (Wheel.tick wh); [%expect {| [] |}];
+  Wheel.add wh 6 |> ignore;
+  (* t=3 *)
+  print_ints_nl (Wheel.tick wh); [%expect {| [] |}];
+  (* t=0 *)
+  print_ints_nl (Wheel.tick wh); [%expect {| [1;2;3] |}];
+  (* t=1 *)
+  print_ints_nl (Wheel.tick wh); [%expect {| [4;5] |}];
+  (* t=2 *)
+  print_ints_nl (Wheel.tick wh); [%expect {| [6] |}];
+  (* t=3 *)
+  print_ints_nl (Wheel.tick wh); [%expect {| [] |}];
+  (* t=0 *)
+  print_ints_nl (Wheel.tick wh); [%expect {| [] |}];

lib/server/wheel.ml

@@ -0,0 +1,28 @@
+open Import
+
+include (val Logging.sublogs logger "Wheel")
+
+type 'a t = {
+  entries : 'a Dllist.t array;
+  mutable index : int;
+}
+
+let make n = {
+  entries = Array.init n (fun _ -> Dllist.create ());
+  index = 0;
+}
+
+let queue t =
+  t.entries.(t.index)
+
+let add t v =
+  Dllist.add_r v (queue t) |> ignore
+
+let[@tail_mod_cons] rec empty t =
+  match Dllist.take_l (queue t) with
+  | x -> x :: empty t
+  | exception Dllist.Empty -> []
+
+let tick t =
+  t.index <- (t.index + 1) mod Array.length t.entries;
+  empty t