albatross/src/vmm_ring.ml

56 lines
1.3 KiB
OCaml
Raw Normal View History

2017-05-26 14:30:34 +00:00
(* (c) 2017 Hannes Mehnert, all rights reserved *)
(* a ring buffer with N strings, dropping old ones *)
type 'a t = {
data : (Ptime.t * 'a) array ;
2017-05-26 14:30:34 +00:00
mutable write : int ;
size : int ;
}
let create ?(size = 1024) neutral () =
{ 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
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-10-29 19:31:25 +00:00
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 =
2019-10-29 19:31:25 +00:00
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 []
2019-01-27 12:10:09 +00:00
let read_history t ?(tst = fun _ -> true) since =
2019-10-29 19:31:25 +00:00
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
2019-10-29 19:31:25 +00:00
else if tst (snd entry) then
go (dec t idx) (entry :: acc)
else
2019-10-29 19:31:25 +00:00
go (dec t idx) acc
in
2019-10-29 19:31:25 +00:00
go (dec t t.write) []