2017-05-26 14:30:34 +00:00
|
|
|
(* (c) 2017 Hannes Mehnert, all rights reserved *)
|
|
|
|
|
|
|
|
(* a ring buffer with N strings, dropping old ones *)
|
|
|
|
|
2018-10-25 14:02:04 +00:00
|
|
|
type 'a t = {
|
|
|
|
data : (Ptime.t * 'a) array ;
|
2017-05-26 14:30:34 +00:00
|
|
|
mutable write : int ;
|
|
|
|
size : int ;
|
|
|
|
}
|
|
|
|
|
2018-10-25 14:02:04 +00:00
|
|
|
let create ?(size = 1024) neutral () =
|
2019-01-27 12:02:10 +00:00
|
|
|
{ data = Array.make size (Ptime.min, neutral) ; write = 0 ; size }
|
2017-05-26 14:30:34 +00:00
|
|
|
|
|
|
|
let inc t = (succ t.write) mod t.size
|
|
|
|
|
2018-10-25 14:02:04 +00:00
|
|
|
let write t entry =
|
|
|
|
Array.set t.data t.write entry ;
|
2017-05-26 14:30:34 +00:00
|
|
|
t.write <- inc t
|
|
|
|
|
|
|
|
let dec t n = (pred n + t.size) mod t.size
|
|
|
|
|
2019-01-27 12:10:09 +00:00
|
|
|
let not_written ts = Ptime.equal ts Ptime.min
|
2018-09-19 19:16:44 +00:00
|
|
|
|
2019-01-27 12:10:09 +00:00
|
|
|
let entry_not_written (ts, _) = not_written ts
|
|
|
|
|
2019-01-27 21:22:57 +00:00
|
|
|
let earlier than (ts, _) =
|
2019-01-27 12:10:09 +00:00
|
|
|
if not_written ts then true else Ptime.is_earlier ts ~than
|
|
|
|
|
|
|
|
let read_some tst t =
|
2018-09-19 19:16:44 +00:00
|
|
|
let rec go s acc idx =
|
|
|
|
if idx = s then (* don't read it twice *)
|
|
|
|
acc
|
|
|
|
else
|
|
|
|
let entry = Array.get t.data idx in
|
2019-01-27 12:10:09 +00:00
|
|
|
if tst entry then acc else go s (entry :: acc) (dec t idx)
|
2018-09-19 19:16:44 +00:00
|
|
|
in
|
|
|
|
let idx = dec t t.write in
|
2019-01-27 12:10:09 +00:00
|
|
|
let entry = Array.get t.data idx in
|
|
|
|
if tst entry then [] else go idx [entry] (dec t idx)
|
2018-09-19 19:16:44 +00:00
|
|
|
|
2019-01-27 12:10:09 +00:00
|
|
|
let read t = read_some entry_not_written t
|
2017-05-26 14:30:34 +00:00
|
|
|
|
2019-01-27 12:10:09 +00:00
|
|
|
let read_history t than = read_some (earlier than) t
|