albatross/src/vmm_ring.ml

(* (c) 2017 Hannes Mehnert, all rights reserved *)

(* a ring buffer with N strings, dropping old ones *)

type 'a t = {
  data : (Ptime.t * 'a) array ;
  mutable write : int ;
  size : int ;
}

let create ?(size = 1024) neutral () =
  { data = Array.make size (Ptime.min, neutral) ; write = 0 ; size }

let inc t = (succ t.write) mod t.size

let write t entry =
  Array.set t.data t.write entry ;
  t.write <- inc t

let dec t n = (pred n + t.size) mod t.size

let get_valid t idx =
  let our = Array.get t.data idx in
  if Ptime.equal (fst our) Ptime.min then
    None
  else
    Some our

let read_last t ?(tst = fun _ -> true) n =
  let rec one idx count acc =
    if count = 0 then
      acc
    else match get_valid t idx with
      | None -> acc
      | Some our ->
        if tst (snd our) then
          one (dec t idx) (pred count) (our :: acc)
        else
          one (dec t idx) count acc
  in
  one (dec t t.write) n []

let read_history t ?(tst = fun _ -> true) since =
  let rec go idx acc =
    match get_valid t idx with
    | None -> acc
    | Some entry ->
      if Ptime.is_earlier (fst entry) ~than:since then
        acc
      else if tst (snd entry) then
        go (dec t idx) (entry :: acc)
      else
        go (dec t idx) acc
  in
  go (dec t t.write) []