banawa-chat/rb.ml

70 lines
1.7 KiB
OCaml
Raw Normal View History

type ('c, 'a) t =
{ arr : 'a option array; mutable rd_cursor : int; mutable wr_cursor : int }
constraint 'c = < .. >
type ro = < rd : unit >
type wo = < wr : unit >
type rdwr = < rd : unit ; wr : unit >
type 'a rd = < rd : unit ; .. > as 'a
type 'a wr = < wr : unit ; .. > as 'a
let make len = { arr = Array.make len None; rd_cursor = 0; wr_cursor = 0 }
exception Full
exception Empty
let length t =
if t.rd_cursor <= t.wr_cursor then t.wr_cursor - t.rd_cursor
else
let len = Array.length t.arr in
len - t.rd_cursor + t.wr_cursor
let is_empty t = length t = 0
let available t = Array.length t.arr - length t
let is_full t = length t = Array.length t.arr
let mask t v = v mod Array.length t.arr
let push t v =
if is_full t then raise Full;
t.arr.(t.wr_cursor) <- Some v;
t.wr_cursor <- mask t (t.wr_cursor + 1)
let pop t =
if is_empty t then raise Empty;
let[@warning "-8"] (Some v) = t.arr.(t.rd_cursor) in
t.rd_cursor <- mask t (t.rd_cursor + 1);
v
let fit_and_push t v =
if is_full t then ignore (pop t);
push t v
let drop t =
if is_empty t then raise Empty;
t.wr_cursor <- mask t (t.wr_cursor - 1)
let iter ~f t a =
let i = ref t.rd_cursor in
let a = ref a in
while !i <> t.wr_cursor do
a := f (Option.get t.arr.(mask t !i)) !a;
incr i
done;
!a
let rev_iter ~f t a =
let i = ref (t.wr_cursor - 1) in
let a = ref a in
while !i >= t.rd_cursor do
a := f (Option.get t.arr.(mask t !i)) !a;
decr i
done;
!a
let ( .%[] ) t idx =
if idx >= length t then invalid_arg "Out of bounds";
Option.get t.arr.(mask t (t.rd_cursor + idx))
external to_ro : ('c rd, 'a) t -> (ro, 'a) t = "%identity"
external to_wo : ('c wr, 'a) t -> (wo, 'a) t = "%identity"