unikernel/duniverse/ke/lib/dune

@@ -0,0 +1,4 @@
+(library
+ (name ke)
+ (public_name ke)
+ (libraries fmt))

unikernel/duniverse/ke/lib/fke.ml

@@ -0,0 +1,352 @@
+[@@@warning "-37"]
+
+module Peano = struct
+  type zero = Zero
+  type 'a succ = Succ
+  type one = zero succ
+  type two = zero succ succ
+  type three = zero succ succ
+end
+
+type ('a, 'l) digit =
+  | Zero : ('a, Peano.zero) digit
+  | One : 'a -> ('a, Peano.one) digit
+  | Two : 'a * 'a -> ('a, Peano.two) digit
+  | Three : 'a * 'a * 'a -> ('a, Peano.three) digit
+
+type 'a t =
+  | Shallow : ('a, 'l) digit -> 'a t
+  | Deep : {
+      s : int;
+      f : ('a, 'f Peano.succ) digit;
+      m : ('a * 'a) t Lazy.t;
+      r : ('a, 'r Peano.succ) digit;
+    }
+      -> 'a t
+
+let empty = Shallow Zero
+
+exception Empty
+
+let _one x = Shallow (One x)
+let _two x y = Shallow (Two (x, y))
+let _three x y z = Shallow (Three (x, y, z))
+let _deep s f m r = Deep { s; f; m; r }
+
+let is_empty : type a. a t -> bool = function
+  | Shallow Zero -> true
+  | Shallow _ | Deep _ -> false
+
+let rec push : type a. a t -> a -> a t =
+ fun q x ->
+  match q with
+  | Shallow Zero -> _one x
+  | Shallow (One y) -> _two y x
+  | Shallow (Two (y, z)) -> _three y z x
+  | Shallow (Three (a, b, c)) ->
+      _deep 4 (Two (a, b)) (Lazy.from_val empty) (Two (c, x))
+  | Deep { s; f; m; r = One y } -> _deep (s + 1) f m (Two (y, x))
+  | Deep { s; f; m; r = Two (y, z) } -> _deep (s + 1) f m (Three (y, z, x))
+  | Deep { s; f; m = (lazy q'); r = Three (y, z, z') } ->
+      _deep (s + 1) f (lazy (push q' (y, z))) (Two (z', x))
+
+let rec pop_exn : type a. a t -> a * a t =
+ fun q ->
+  match q with
+  | Shallow Zero -> raise Empty
+  | Shallow (One x) -> (x, empty)
+  | Shallow (Two (x, y)) -> (x, _one y)
+  | Shallow (Three (x, y, z)) -> (x, _two y z)
+  | Deep { s; f = One x; m = (lazy q'); r } ->
+      if is_empty q' then (x, Shallow r)
+      else
+        let (y, z), q' = pop_exn q' in
+        (x, _deep (s - 1) (Two (y, z)) (Lazy.from_val q') r)
+  | Deep { s; f = Two (x, y); m; r } -> (x, _deep (s - 1) (One y) m r)
+  | Deep { s; f = Three (x, y, z); m; r } -> (x, _deep (s - 1) (Two (y, z)) m r)
+
+let rec tail_exn : type a. a t -> a t * a =
+ fun q ->
+  match q with
+  | Shallow Zero -> raise Empty
+  | Shallow (One x) -> (empty, x)
+  | Shallow (Two (x, y)) -> (_one x, y)
+  | Shallow (Three (x, y, z)) -> (_two x y, z)
+  | Deep { s; f; m = (lazy q'); r = One x } ->
+      if is_empty q' then (Shallow f, x)
+      else
+        let q'', (y, z) = tail_exn q' in
+        (_deep (s - 1) f (Lazy.from_val q'') (Two (y, z)), x)
+  | Deep { s; f; m; r = Two (x, y) } -> (_deep (s - 1) f m (One x), y)
+  | Deep { s; f; m; r = Three (x, y, z) } -> (_deep (s - 1) f m (Two (x, y)), z)
+
+let peek_exn : type a. a t -> a =
+ fun q ->
+  match q with
+  | Shallow Zero -> raise Empty
+  | Shallow (One x) -> x
+  | Shallow (Two (x, _)) -> x
+  | Shallow (Three (x, _, _)) -> x
+  | Deep { f = One x; _ } -> x
+  | Deep { f = Two (x, _); _ } -> x
+  | Deep { f = Three (x, _, _); _ } -> x
+
+let pop q = try Some (pop_exn q) with Empty -> None
+let tail q = try Some (tail_exn q) with Empty -> None
+let peek q = try Some (peek_exn q) with Empty -> None
+
+let rec cons : type a. a t -> a -> a t =
+ fun q x ->
+  match q with
+  | Shallow Zero -> _one x
+  | Shallow (One y) -> _two x y
+  | Shallow (Two (y, z)) -> _three x y z
+  | Shallow (Three (y, z, z')) ->
+      _deep 4 (Two (x, y)) (Lazy.from_val empty) (Two (z, z'))
+  | Deep { s; f = One y; m; r } -> _deep (s + 1) (Two (x, y)) m r
+  | Deep { s; f = Two (y, z); m; r } -> _deep (s + 1) (Three (x, y, z)) m r
+  | Deep { s; f = Three (y, z, z'); m = (lazy q'); r } ->
+      _deep (s + 1) (Three (x, y, z)) (lazy (cons q' (z, z'))) r
+
+let iter : type a. (a -> unit) -> a t -> unit =
+ fun f q ->
+  let rec go : type a. (a -> unit) -> a t -> unit =
+   fun f -> function
+    | Shallow Zero -> ()
+    | Shallow (One x) -> f x
+    | Shallow (Two (x, y)) ->
+        f x;
+        f y
+    | Shallow (Three (x, y, z)) ->
+        f x;
+        f y;
+        f z
+    | Deep { f = hd; m = (lazy q); r = tl; _ } ->
+        go f (Shallow hd);
+        go
+          (fun (x, y) ->
+            f x;
+            f y)
+          q;
+        go f (Shallow tl)
+  in
+  go f q
+
+let rev_iter : type a. (a -> unit) -> a t -> unit =
+ fun f q ->
+  let rec go : type a. (a -> unit) -> a t -> unit =
+   fun f -> function
+    | Shallow Zero -> ()
+    | Shallow (One x) -> f x
+    | Shallow (Two (y, x)) ->
+        f x;
+        f y
+    | Shallow (Three (z, y, x)) ->
+        f x;
+        f y;
+        f z
+    | Deep { f = hd; m = (lazy q); r = tl; _ } ->
+        go f (Shallow tl);
+        go
+          (fun (y, x) ->
+            f x;
+            f y)
+          q;
+        go f (Shallow hd)
+  in
+  go f q
+
+let fold : type acc x. (acc -> x -> acc) -> acc -> x t -> acc =
+ fun f a q ->
+  let rec go : type acc x. (acc -> x -> acc) -> acc -> x t -> acc =
+   fun f a -> function
+    | Shallow Zero -> a
+    | Shallow (One x) -> f a x
+    | Shallow (Two (x, y)) -> f (f a x) y
+    | Shallow (Three (x, y, z)) -> f (f (f a x) y) z
+    | Deep { f = hd; m = (lazy q); r = tl; _ } ->
+        let a = go f a (Shallow hd) in
+        let a = go (fun a (x, y) -> f (f a x) y) a q in
+        go f a (Shallow tl)
+  in
+  go f a q
+
+let length = function
+  | Deep { s; _ } -> s
+  | Shallow Zero -> 0
+  | Shallow (One _) -> 1
+  | Shallow (Two _) -> 2
+  | Shallow (Three _) -> 3
+
+let pp ?sep pp_elt = Fmt.iter ?sep iter pp_elt
+let dump pp_elt = Fmt.Dump.iter iter (Fmt.any "fke") pp_elt
+
+module Weighted = struct
+  type ('a, 'b) t = {
+    r : int;
+    w : int;
+    c : int;
+    k : ('a, 'b) Bigarray.kind;
+    v : ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t;
+  }
+
+  exception Empty
+  exception Full
+
+  let[@inline always] mask t v = v land (t.c - 1)
+  let[@inline always] empty t = t.r = t.w
+  let[@inline always] size t = t.w - t.r
+  let[@inline always] full t = size t = t.c
+  let[@inline always] available t = t.c - (t.w - t.r)
+  let is_empty t = (empty [@inlined]) t
+  let length q = size q
+
+  let[@inline always] to_power_of_two v =
+    let res = ref (pred v) in
+    res := !res lor (!res lsr 1);
+    res := !res lor (!res lsr 2);
+    res := !res lor (!res lsr 4);
+    res := !res lor (!res lsr 8);
+    res := !res lor (!res lsr 16);
+    succ !res
+
+  let[@inline always] is_power_of_two v = v <> 0 && v land (lnot v + 1) = v
+
+  let create ?capacity kind =
+    let capacity =
+      match capacity with
+      | None | Some 0 -> 1
+      | Some n ->
+          if n < 0 then Fmt.invalid_arg "Rke.Weighted.create"
+          else to_power_of_two n
+    in
+    ( {
+        r = 0;
+        w = 0;
+        c = capacity;
+        k = kind;
+        v = Bigarray.Array1.create kind Bigarray.c_layout capacity;
+      },
+      capacity )
+
+  let copy t =
+    let v = Bigarray.Array1.create t.k Bigarray.c_layout t.c in
+    Bigarray.Array1.blit t.v v;
+    { r = t.r; w = t.w; c = t.c; v; k = t.k }
+
+  let from v =
+    if not (is_power_of_two (Bigarray.Array1.dim v)) then
+      Fmt.invalid_arg "RBA.from";
+    let c = Bigarray.Array1.dim v in
+    let k = Bigarray.Array1.kind v in
+    { r = 0; w = 0; c; k; v }
+
+  let push_exn t v =
+    if (full [@inlined]) t then raise Full;
+    Bigarray.Array1.unsafe_set t.v ((mask [@inlined]) t t.w) v;
+    { t with w = t.w + 1 }
+
+  let push t v = try Some (push_exn t v) with Full -> None
+
+  let cons_exn t v =
+    if (full [@inlined]) t then raise Full;
+    let i = t.r - 1 in
+    Bigarray.Array1.unsafe_set t.v ((mask [@inlined]) t i) v;
+    { t with r = i }
+
+  let cons t v = try Some (cons_exn t v) with Full -> None
+
+  let pop_exn t =
+    if (empty [@inlined]) t then raise Empty;
+    let r = Bigarray.Array1.unsafe_get t.v ((mask [@inlined]) t t.r) in
+    (r, { t with r = t.r + 1 })
+
+  let pop t = try Some (pop_exn t) with Empty -> None
+
+  let peek_exn t =
+    if (empty [@inlined]) t then raise Empty;
+    Bigarray.Array1.unsafe_get t.v ((mask [@inlined]) t t.r)
+
+  let peek t = try Some (peek_exn t) with Empty -> None
+
+  module N = struct
+    type ('a, 'b) bigarray = ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
+    type ('a, 'b) blit = 'a -> int -> 'b -> int -> int -> unit
+    type 'a length = 'a -> int
+
+    let push_exn t ~blit ~length ?(off = 0) ?len v =
+      let len = match len with None -> length v - off | Some len -> len in
+      if (available [@inlined]) t < len then raise Full;
+      let msk = (mask [@inlined]) t t.w in
+      let pre = t.c - msk in
+      let rst = len - pre in
+      let ret =
+        if rst > 0 then (
+          blit v off t.v msk pre;
+          blit v (off + pre) t.v 0 rst;
+          [
+            Bigarray.Array1.sub t.v ((mask [@inlined]) t t.w) pre;
+            Bigarray.Array1.sub t.v 0 rst;
+          ])
+        else (
+          blit v off t.v msk len;
+          [ Bigarray.Array1.sub t.v ((mask [@inlined]) t t.w) len ])
+      in
+      (ret, { t with w = t.w + len })
+
+    let push t ~blit ~length ?off ?len v =
+      try Some (push_exn t ~blit ~length ?off ?len v) with Full -> None
+
+    let keep_exn t ~blit ~length ?(off = 0) ?len v =
+      let len = match len with None -> length v | Some len -> len in
+      if (size [@inlined]) t < len then raise Empty;
+      let msk = (mask [@inlined]) t t.r in
+      let pre = t.c - msk in
+      let rst = len - pre in
+      if rst > 0 then (
+        blit t.v msk v off pre;
+        blit t.v 0 v (off + pre) rst)
+      else blit t.v msk v off len
+
+    let keep t ~blit ~length ?off ?len v =
+      try Some (keep_exn t ~blit ~length ?off ?len v) with Empty -> None
+
+    let unsafe_shift t len = { t with r = t.r + len }
+
+    let shift_exn t len =
+      if (size [@inlined]) t < len then raise Empty;
+      unsafe_shift t len
+
+    let shift t len = try Some (shift_exn t len) with Empty -> None
+  end
+
+  let iter f t =
+    let idx = ref t.r in
+    let max = t.w in
+    while !idx <> max do
+      f (Bigarray.Array1.unsafe_get t.v ((mask [@inlined]) t !idx));
+      incr idx
+    done
+
+  let rev_iter f t =
+    if t.r == t.w then ()
+    else
+      let idx = ref (pred t.w) in
+      let min = t.r in
+      while
+        f (Bigarray.Array1.unsafe_get t.v ((mask [@inlined]) t !idx));
+        !idx <> min
+      do
+        decr idx
+      done
+
+  let fold f a t =
+    let a = ref a in
+    iter (fun x -> a := f !a x) t;
+    !a
+
+  let clear t = { t with r = 0; w = 0 }
+  let unsafe_bigarray { v; _ } = v
+  let pp ?sep pp_elt = Fmt.iter ?sep iter pp_elt
+  let dump pp_elt = Fmt.Dump.iter iter (Fmt.any "fke:weighted") pp_elt
+end

unikernel/duniverse/ke/lib/fke.mli

@@ -0,0 +1,2 @@
+include Sigs.F
+module Weighted : Sigs.Weighted.F

unikernel/duniverse/ke/lib/ke.ml

@@ -0,0 +1,3 @@
+module Sigs = Sigs
+module Fke = Fke
+module Rke = Rke

unikernel/duniverse/ke/lib/ke.mli

@@ -0,0 +1,3 @@
+module Sigs = Sigs
+module Fke = Fke
+module Rke = Rke

unikernel/duniverse/ke/lib/rke.ml

@@ -0,0 +1,400 @@
+type ('a, 'b) t = {
+  mutable r : int;
+  mutable w : int;
+  mutable c : int;
+  k : ('a, 'b) Bigarray.kind;
+  mutable v : ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t;
+}
+
+exception Empty
+
+external ( = ) : 'a -> 'a -> bool = "%equal"
+
+let ( = ) (a : int) b = a = b
+let[@inline always] mask t v = v land (t.c - 1)
+let[@inline always] empty t = t.r = t.w
+let[@inline always] size t = t.w - t.r
+let[@inline always] available t = t.c - (t.w - t.r)
+let[@inline always] full t = size t = t.c
+let length q = size q
+
+let[@inline always] to_power_of_two v =
+  let res = ref (pred v) in
+  res := !res lor (!res lsr 1);
+  res := !res lor (!res lsr 2);
+  res := !res lor (!res lsr 4);
+  res := !res lor (!res lsr 8);
+  res := !res lor (!res lsr 16);
+  succ !res
+
+let[@inline always] is_power_of_two v = v <> 0 && v land (lnot v + 1) = v
+let is_empty t = (empty [@inlined]) t
+
+let create ?capacity kind =
+  let capacity =
+    match capacity with
+    | None | Some 0 -> 1
+    | Some n ->
+        if n < 0 then Fmt.invalid_arg "Rke.create" else to_power_of_two n
+  in
+  {
+    r = 0;
+    w = 0;
+    c = capacity;
+    k = kind;
+    v = Bigarray.Array1.create kind Bigarray.c_layout capacity;
+  }
+
+let capacity { c; _ } = c
+
+let copy t =
+  let v = Bigarray.Array1.create t.k Bigarray.c_layout t.c in
+  Bigarray.Array1.blit t.v v;
+  { r = t.r; w = t.w; c = t.c; v; k = t.k }
+
+let grow t want =
+  let max : int -> int -> int = max in
+  let c = to_power_of_two (max 1 (max want (size t))) in
+  if c <> Bigarray.Array1.dim t.v then (
+    let dst = Bigarray.Array1.create t.k Bigarray.c_layout c in
+    let sze = (size [@inlined]) t in
+    let msk = (mask [@inlined]) t t.r in
+    let pre = t.c - msk in
+    let rst = sze - pre in
+    (if rst > 0 then (
+     Bigarray.Array1.(blit (sub t.v msk pre) (sub dst 0 pre));
+     Bigarray.Array1.(blit (sub t.v 0 rst) (sub dst pre rst)))
+    else Bigarray.Array1.(blit (sub t.v msk sze) (sub dst 0 sze)));
+    t.v <- dst;
+    t.w <- sze;
+    t.c <- c;
+    t.r <- 0)
+
+let push t v =
+  if (full [@inlined]) t then grow t (2 * (size [@inlined]) t);
+  Bigarray.Array1.unsafe_set t.v ((mask [@inlined]) t t.w) v;
+  t.w <- t.w + 1
+
+let cons t v =
+  if (full [@inlined]) t then grow t (2 * (size [@inlined]) t);
+  let i = t.r - 1 in
+  Bigarray.Array1.unsafe_set t.v ((mask [@inlined]) t i) v;
+  t.r <- i
+
+let pop_exn t =
+  if (empty [@inlined]) t then raise Empty;
+  let r = Bigarray.Array1.unsafe_get t.v ((mask [@inlined]) t t.r) in
+  t.r <- t.r + 1;
+  r
+
+let pop t = try Some (pop_exn t) with Empty -> None
+
+let peek_exn t =
+  if (empty [@inlined]) t then raise Empty;
+  Bigarray.Array1.unsafe_get t.v ((mask [@inlined]) t t.r)
+
+let peek t = try Some (peek_exn t) with Empty -> None
+
+let blit src src_off dst dst_off len =
+  let a = Bigarray.Array1.sub src src_off len in
+  let b = Bigarray.Array1.sub dst dst_off len in
+  Bigarray.Array1.blit a b
+
+let compress t =
+  let len = length t in
+  let msk = (mask [@inlined]) t t.r in
+  let pre = t.c - msk in
+  let rst = len - pre in
+  if rst > 0 then (
+    if (available [@inlined]) t >= pre then (
+      (* XXX(dinosaure): in this case, [pre + rst <= msk], so [blit] will not
+         overlap bytes at the end of [t.v] (at offset [msk]). *)
+      blit t.v 0 t.v pre rst;
+      blit t.v msk t.v 0 pre)
+    else
+      let tmp = Bigarray.Array1.create t.k Bigarray.c_layout pre in
+      blit t.v msk tmp 0 pre;
+      blit t.v 0 t.v pre rst;
+      blit tmp 0 t.v 0 pre)
+  else blit t.v msk t.v 0 len;
+  t.r <- 0;
+  t.w <- len
+
+module N = struct
+  type ('a, 'b) bigarray = ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
+  type ('a, 'b) blit = 'a -> int -> 'b -> int -> int -> unit
+  type 'a length = 'a -> int
+
+  let push t ~blit ~length ?(off = 0) ?len v =
+    let len = match len with None -> length v - off | Some len -> len in
+    if (available [@inlined]) t < len then grow t (len + (size [@inlined]) t);
+    let msk = (mask [@inlined]) t t.w in
+    let pre = t.c - msk in
+    let rst = len - pre in
+    if rst > 0 then (
+      blit v off t.v msk pre;
+      blit v (off + pre) t.v 0 rst)
+    else blit v off t.v msk len;
+    t.w <- t.w + len
+
+  let keep_exn t ~blit ~length ?(off = 0) ?len v =
+    let len = match len with None -> length v - off | Some len -> len in
+    if (size [@inlined]) t < len then raise Empty;
+    let msk = (mask [@inlined]) t t.r in
+    let pre = t.c - msk in
+    let rst = len - pre in
+    if rst > 0 then (
+      blit t.v msk v off pre;
+      blit t.v 0 v (off + pre) rst)
+    else blit t.v msk v off len
+
+  let keep t ~blit ~length ?off ?len v =
+    try Some (keep_exn t ~blit ~length ?off ?len v) with Empty -> None
+
+  let peek t =
+    let len = (size [@inlined]) t in
+    if len == 0 then []
+    else
+      let msk = (mask [@inlined]) t t.r in
+      let pre = t.c - msk in
+      let rst = len - pre in
+      if rst > 0 then
+        [ Bigarray.Array1.sub t.v msk pre; Bigarray.Array1.sub t.v 0 rst ]
+      else [ Bigarray.Array1.sub t.v msk len ]
+
+  let unsafe_shift t len = t.r <- t.r + len
+
+  let shift_exn t len =
+    if (size [@inlined]) t < len then raise Empty;
+    unsafe_shift t len
+
+  let shift t len = try Some (shift_exn t len) with Empty -> None
+end
+
+let iter f t =
+  let idx = ref t.r in
+  let max = t.w in
+  while !idx <> max do
+    f (Bigarray.Array1.unsafe_get t.v ((mask [@inlined]) t !idx));
+    incr idx
+  done
+
+let rev_iter f t =
+  if t.r == t.w then ()
+  else
+    let idx = ref (pred t.w) in
+    let min = t.r in
+    while
+      f (Bigarray.Array1.unsafe_get t.v ((mask [@inlined]) t !idx));
+      !idx <> min
+    do
+      decr idx
+    done
+
+let fold f a t =
+  let a = ref a in
+  iter (fun x -> a := f !a x) t;
+  !a
+
+let pp ?sep pp_elt = Fmt.iter ?sep iter pp_elt
+let dump pp_elt = Fmt.Dump.iter iter (Fmt.any "rke") pp_elt
+
+let clear q =
+  q.r <- 0;
+  q.w <- 0
+
+module Weighted = struct
+  type ('a, 'b) t = {
+    mutable r : int;
+    mutable w : int;
+    c : int;
+    k : ('a, 'b) Bigarray.kind;
+    v : ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t;
+  }
+
+  exception Empty
+  exception Full
+
+  let[@inline always] mask t v = v land (t.c - 1)
+  let[@inline always] empty t = t.r = t.w
+  let[@inline always] size t = t.w - t.r
+  let[@inline always] full t = size t = t.c
+  let[@inline always] available t = t.c - (t.w - t.r)
+  let is_empty t = (empty [@inlined]) t
+  let length q = size q
+
+  let create ?capacity kind =
+    let capacity =
+      match capacity with
+      | None | Some 0 -> 1
+      | Some n ->
+          if n < 0 then Fmt.invalid_arg "Rke.Weighted.create"
+          else to_power_of_two n
+    in
+    ( {
+        r = 0;
+        w = 0;
+        c = capacity;
+        k = kind;
+        v = Bigarray.Array1.create kind Bigarray.c_layout capacity;
+      },
+      capacity )
+
+  let copy t =
+    let v = Bigarray.Array1.create t.k Bigarray.c_layout t.c in
+    Bigarray.Array1.blit t.v v;
+    { r = t.r; w = t.w; c = t.c; v; k = t.k }
+
+  let from v =
+    if not (is_power_of_two (Bigarray.Array1.dim v)) then
+      Fmt.invalid_arg "RBA.from";
+    let c = Bigarray.Array1.dim v in
+    let k = Bigarray.Array1.kind v in
+    { r = 0; w = 0; c; k; v }
+
+  let push_exn t v =
+    if (full [@inlined]) t then raise Full;
+    Bigarray.Array1.unsafe_set t.v ((mask [@inlined]) t t.w) v;
+    t.w <- t.w + 1
+
+  let push t v = try Some (push_exn t v) with Full -> None
+
+  let cons_exn t v =
+    if (full [@inlined]) t then raise Full;
+    let i = t.r - 1 in
+    Bigarray.Array1.unsafe_set t.v ((mask [@inlined]) t i) v;
+    t.r <- i
+
+  let cons t v = try Some (cons_exn t v) with Full -> None
+
+  let pop_exn t =
+    if (empty [@inlined]) t then raise Empty;
+    let r = Bigarray.Array1.unsafe_get t.v ((mask [@inlined]) t t.r) in
+    t.r <- t.r + 1;
+    r
+
+  let pop t = try Some (pop_exn t) with Empty -> None
+
+  let peek_exn t =
+    if (empty [@inlined]) t then raise Empty;
+    Bigarray.Array1.unsafe_get t.v ((mask [@inlined]) t t.r)
+
+  let peek t = try Some (peek_exn t) with Empty -> None
+
+  let compress t =
+    let len = length t in
+    let msk = (mask [@inlined]) t t.r in
+    let pre = t.c - msk in
+    let rst = len - pre in
+    if rst > 0 then (
+      if (available [@inlined]) t >= pre then (
+        (* XXX(dinosaure): in this case, [pre + rst <= msk], so [blit] will not
+           overlap bytes at the end of [t.v] (at offset [msk]). *)
+        blit t.v 0 t.v pre rst;
+        blit t.v msk t.v 0 pre)
+      else
+        let tmp = Bigarray.Array1.create t.k Bigarray.c_layout pre in
+        blit t.v msk tmp 0 pre;
+        blit t.v 0 t.v pre rst;
+        blit tmp 0 t.v 0 pre)
+    else blit t.v msk t.v 0 len;
+    t.r <- 0;
+    t.w <- len
+
+  module N = struct
+    type ('a, 'b) bigarray = ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
+    type ('a, 'b) blit = 'a -> int -> 'b -> int -> int -> unit
+    type 'a length = 'a -> int
+
+    let push_exn t ~blit ~length ?(off = 0) ?len v =
+      let len = match len with None -> length v - off | Some len -> len in
+      if (available [@inlined]) t < len then raise Full;
+      let msk = (mask [@inlined]) t t.w in
+      let pre = t.c - msk in
+      let rst = len - pre in
+      let ret =
+        if rst > 0 then (
+          blit v off t.v msk pre;
+          blit v (off + pre) t.v 0 rst;
+          [
+            Bigarray.Array1.sub t.v ((mask [@inlined]) t t.w) pre;
+            Bigarray.Array1.sub t.v 0 rst;
+          ])
+        else (
+          blit v off t.v msk len;
+          [ Bigarray.Array1.sub t.v ((mask [@inlined]) t t.w) len ])
+      in
+      t.w <- t.w + len;
+      ret
+
+    let push t ~blit ~length ?off ?len v =
+      try Some (push_exn t ~blit ~length ?off ?len v) with Full -> None
+
+    let keep_exn t ~blit ~length ?(off = 0) ?len v =
+      let len = match len with None -> length v - off | Some len -> len in
+      if (size [@inlined]) t < len then raise Empty;
+      let msk = (mask [@inlined]) t t.r in
+      let pre = t.c - msk in
+      let rst = len - pre in
+      if rst > 0 then (
+        blit t.v msk v off pre;
+        blit t.v 0 v (off + pre) rst)
+      else blit t.v msk v off len
+
+    let keep t ~blit ~length ?off ?len v =
+      try Some (keep_exn t ~blit ~length ?off ?len v) with Empty -> None
+
+    let peek t =
+      let len = (size [@inlined]) t in
+      if len == 0 then []
+      else
+        let msk = (mask [@inlined]) t t.r in
+        let pre = t.c - msk in
+        let rst = len - pre in
+        if rst > 0 then
+          [ Bigarray.Array1.sub t.v msk pre; Bigarray.Array1.sub t.v 0 rst ]
+        else [ Bigarray.Array1.sub t.v msk len ]
+
+    let unsafe_shift t len = t.r <- t.r + len
+
+    let shift_exn t len =
+      if (size [@inlined]) t < len then raise Empty;
+      unsafe_shift t len
+
+    let shift t len = try Some (shift_exn t len) with Empty -> None
+  end
+
+  let iter f t =
+    let idx = ref t.r in
+    let max = t.w in
+    while !idx <> max do
+      f (Bigarray.Array1.unsafe_get t.v ((mask [@inlined]) t !idx));
+      incr idx
+    done
+
+  let rev_iter f t =
+    if t.r == t.w then ()
+    else
+      let idx = ref (pred t.w) in
+      let min = t.r in
+      while
+        f (Bigarray.Array1.unsafe_get t.v ((mask [@inlined]) t !idx));
+        !idx <> min
+      do
+        decr idx
+      done
+
+  let fold f a t =
+    let a = ref a in
+    iter (fun x -> a := f !a x) t;
+    !a
+
+  let pp ?sep pp_elt = Fmt.iter ?sep iter pp_elt
+  let dump pp_elt = Fmt.Dump.iter iter (Fmt.any "rke:weighted") pp_elt
+
+  let clear q =
+    q.r <- 0;
+    q.w <- 0
+
+  let unsafe_bigarray { v; _ } = v
+end

unikernel/duniverse/ke/lib/rke.mli

@@ -0,0 +1,2 @@
+include Sigs.R
+module Weighted : Sigs.Weighted.R

unikernel/duniverse/ke/lib/sigs.ml

@@ -0,0 +1,532 @@
+module type F = sig
+  type 'a t
+  (** The type of queues containing elements of type ['a]. *)
+
+  exception Empty
+  (** Raised when {!peek_exn} or {!pop_exn} is applied to an empty queue. *)
+
+  val empty : 'a t
+  (** An empty queue. *)
+
+  val is_empty : 'a t -> bool
+  (** Return [true] if the given queue is empty, [false] otherwise. *)
+
+  val length : 'a t -> int
+  (** Number of elements in the queue. *)
+
+  val push : 'a t -> 'a -> 'a t
+  (** Push element at the end of the queue. *)
+
+  val cons : 'a t -> 'a -> 'a t
+  (** Push element at the front of the queue. *)
+
+  val peek : 'a t -> 'a option
+  (** [peek q] returns the first element in the queue [q], without removing it
+     from the queue. If [q] is empty, it returns [None]. *)
+
+  val peek_exn : 'a t -> 'a
+  (** Same as {!peek} but it raises an exception if [q] is empty. *)
+
+  val pop : 'a t -> ('a * 'a t) option
+  (** Get and remove the first element. If [q] is empty, it returns [None]. *)
+
+  val pop_exn : 'a t -> 'a * 'a t
+  (** Same as {!pop} but it raises an exception if [q] is empty. *)
+
+  val tail : 'a t -> ('a t * 'a) option
+  (** Get and remove the {b last} element. If [q] is empty, it returns [None]. *)
+
+  val tail_exn : 'a t -> 'a t * 'a
+  (** Same as {!tail} but it raises an exception if [q] is empty. *)
+
+  val iter : ('a -> unit) -> 'a t -> unit
+  (** [iter f q] applies [f] in turn to all elements of [q], from the least
+     recently entered to the most recently entered. The queue itself is
+     unchanged. *)
+
+  val rev_iter : ('a -> unit) -> 'a t -> unit
+  (** [rev_iter f q] applies [f] in turn to all elements of [q], from the most
+     recently entered to the least recently entered. The queue itself is
+     unchanged. *)
+
+  val fold : ('acc -> 'x -> 'acc) -> 'acc -> 'x t -> 'acc
+  (** [fold f a q] is equivalent to [List.fold_left f a l], where [l] is the
+     list of [q]'s elements. The queue remains unchanged. *)
+
+  val pp : ?sep:unit Fmt.t -> 'a Fmt.t -> 'a t Fmt.t
+  (** Pretty-printer of {!t}. *)
+
+  val dump : 'a Fmt.t -> 'a t Fmt.t
+  (** Human-readable pretty-printer of {!t}. *)
+end
+
+module type R = sig
+  type ('a, 'b) t
+  (** The type of queues containing elements of type ['a]. *)
+
+  exception Empty
+  (** Raised when {!peek_exn}, {!pop_exn}, {!N.keep_exn} or {!N.shift_exn} is
+     applied to an empty queue. *)
+
+  val is_empty : ('a, 'b) t -> bool
+  (** Return [true] if the given queue is empty, [false] otherwise. *)
+
+  val create : ?capacity:int -> ('a, 'b) Bigarray.kind -> ('a, 'b) t
+  (** Return a new queue, initially empty. *)
+
+  val capacity : ('a, 'b) t -> int
+  (** Returns how many objects [t] can store. *)
+
+  val length : ('a, 'b) t -> int
+  (** Number of elements in the queue. *)
+
+  val push : ('a, 'b) t -> 'a -> unit
+  (** [push q x] adds the elements [x] at the end of the queue [q]. *)
+
+  val pop : ('a, 'b) t -> 'a option
+  (** [pop q] removes and returns the first element in queue [q]. If [q] is
+     empty, it returns [None]. *)
+
+  val pop_exn : ('a, 'b) t -> 'a
+  (** [pop_exn] is the same as {!pop} but it raises {!Empty} when the given
+     queue [q] is empty. *)
+
+  val peek : ('a, 'b) t -> 'a option
+  (** [peek q] returns the first element in the queue [q], without removing it
+     from the queue. If [q] is empty, it returns [None]. *)
+
+  val peek_exn : ('a, 'b) t -> 'a
+  (** Same as {!peek} but it raises {!Empty} if [q] is empty. *)
+
+  val cons : ('a, 'b) t -> 'a -> unit
+  (** [cons q x] adds element [x] at the front of the given queue [q]. It
+     returns [None] if it fails. *)
+
+  val copy : ('a, 'b) t -> ('a, 'b) t
+  (** Return a copy of the given queue. *)
+
+  val clear : ('a, 'b) t -> unit
+  (** Discard all elements from a queue. *)
+
+  val compress : ('a, 'b) t -> unit
+  (** Compress queue, read cursor will be setted to [0] and data will be move
+     to. This operation allows to provide much more space for a
+     {!push}/{!N.push} operation - but it can not ensure enough free space. *)
+
+  module N : sig
+    type ('a, 'b) bigarray = ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
+    (** The type of the internal bigarray of {!t}. *)
+
+    type ('a, 'b) blit = 'a -> int -> 'b -> int -> int -> unit
+    (** The type of the [blit] function. *)
+
+    type 'a length = 'a -> int
+    (** The type of the [length] function. *)
+
+    val push :
+      ('a, 'b) t ->
+      blit:('src, ('a, 'b) bigarray) blit ->
+      length:'src length ->
+      ?off:int ->
+      ?len:int ->
+      'src ->
+      unit
+    (** [push q ~blit ~length ?off ?len src] {i blits} elements in [src] to the
+       given queue [q] at the end (like a fast iterative {!R.push}). Default
+       value of [off] is [0]. Default value of [len] is [length src - off]. *)
+
+    val keep_exn :
+      ('a, 'b) t ->
+      blit:(('a, 'b) bigarray, 'dst) blit ->
+      length:'dst length ->
+      ?off:int ->
+      ?len:int ->
+      'dst ->
+      unit
+    (** [keep_exn q ~blit ~length ?off ?len dst] {i blits} elements of the given
+       queue [q] in [dst] from the front to the end of [dst] (like a fast
+       iterative {!R.pop_exn}). Default value of [off] is [0]. Default value of
+       [len] is [length dst - off]. If the given [q] does not have enough
+       elements to write on [dst], it raises {!Empty} and the given queue is
+       unchanged. *)
+
+    val keep :
+      ('a, 'b) t ->
+      blit:(('a, 'b) bigarray, 'dst) blit ->
+      length:'dst length ->
+      ?off:int ->
+      ?len:int ->
+      'dst ->
+      unit option
+    (** Same as {!keep_exn} but if it fails, it returns [None]. *)
+
+    val peek : ('a, 'b) t -> ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t list
+    (** Returns a sub-part of available to read payloads. *)
+
+    val unsafe_shift : ('a, 'b) t -> int -> unit
+    (** [unsafe_shift q l] discards [l] elements in the given queue [q] without
+       any verification. Mostly used after {!keep_exn}, if the last one does not
+       raise {!Empty}, it's safe to use it. *)
+
+    val shift_exn : ('a, 'b) t -> int -> unit
+    (** [shift_exn q l] discards [l] elements in the given queue [q]. If [q]
+       does not have enough elements, it raises {!Empty} and the given queue is
+       unchanged. *)
+
+    val shift : ('a, 'b) t -> int -> unit option
+    (** Same as {!shift_exn} but if it fails, it returns [None]. *)
+  end
+
+  val iter : ('a -> unit) -> ('a, 'b) t -> unit
+  (** [iter f q] applies [f] in turn to all elements of [q], from the least
+     recently entered to the most recently entered. The queue itself is
+     unchanged. *)
+
+  val rev_iter : ('a -> unit) -> ('a, 'b) t -> unit
+  (** [iter f q] applies [f] in turn to all elements of [q], from the most
+     recently entered to the least recently entered. The queue itself is
+     unchanged. *)
+
+  val fold : ('acc -> 'x -> 'acc) -> 'acc -> ('x, 'b) t -> 'acc
+  (** [fold f a q] is equivalent to [List.fold_left f a l], where [l] is the
+     list of [q]'s elements. The queue remains unchanged. *)
+
+  val pp : ?sep:unit Fmt.t -> 'a Fmt.t -> ('a, 'b) t Fmt.t
+  (** Pretty-printer of {!t}. *)
+
+  val dump : 'a Fmt.t -> ('a, 'b) t Fmt.t
+  (** Human-readable pretty-printer of {!t}. *)
+end
+
+module Weighted = struct
+  module type R = sig
+    type ('a, 'b) t
+    (** The type of queues containing elements of type ['a]. *)
+
+    exception Full
+    (** Raised when {!push_exn} or {!N.push_exn} is applied to an empty queue. *)
+
+    exception Empty
+    (** Raised when {!peek_exn}, {!pop_exn} is applied to an empty queue. *)
+
+    val is_empty : ('a, 'b) t -> bool
+    (** Return [true] if the given queue is empty, [false] otherwise. *)
+
+    val create : ?capacity:int -> ('a, 'b) Bigarray.kind -> ('a, 'b) t * int
+    (** Return a new queue, initially empty with the real capacity of it. *)
+
+    val length : ('a, 'b) t -> int
+    (** Number of elements in the queue. *)
+
+    val available : ('a, 'b) t -> int
+    (** Free cells availables on the queue. *)
+
+    val push_exn : ('a, 'b) t -> 'a -> unit
+    (** [push_exn q x] adds the elements [x] at the end of the queue [q]. It
+       raises {!Full} if the given queue [q] is full. *)
+
+    val push : ('a, 'b) t -> 'a -> unit option
+    (** [push q x] is the same as {!push_exn} but returns [None] if it fails. *)
+
+    val pop : ('a, 'b) t -> 'a option
+    (** [pop q] removes and returns the first element in the given queue [q]. If
+       [q] is empty, it returns [None]. *)
+
+    val pop_exn : ('a, 'b) t -> 'a
+    (** [pop_exn q] is the same as {!pop} but it raises an {!Empty} if the given
+       queue is empty. *)
+
+    val peek : ('a, 'b) t -> 'a option
+    (** [peek q] returns the first element in the given queue [q]. If [q] is
+       empty, it returns [None]. *)
+
+    val peek_exn : ('a, 'b) t -> 'a
+    (** [peek_exn q] returns the first element in the given queue [q]. If [q] is
+       empty, it raises {!Empty}. *)
+
+    val cons_exn : ('a, 'b) t -> 'a -> unit
+    (** [cons_exn q x] adds element [x] at the front of the given queue [q]. It
+       raises {!Full} if the queue is full. *)
+
+    val cons : ('a, 'b) t -> 'a -> unit option
+    (** [cons q x] adds element [x] at the front of the given queue [q]. It
+       returns [None] if it fails. *)
+
+    val copy : ('a, 'b) t -> ('a, 'b) t
+    (** Return a copy of the given queue. *)
+
+    val clear : ('a, 'b) t -> unit
+    (** Discard all elements from a queue. *)
+
+    val compress : ('a, 'b) t -> unit
+    (** Compress queue, read cursor will be setted to [0] and data will be move
+       to. This operation allows to provide much more space for a
+       {!push}/{!N.push} operation - but it can not ensure enough free space. *)
+
+    module N : sig
+      type ('a, 'b) bigarray = ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
+      (** The type of the internal bigarray of {!t}. *)
+
+      type ('a, 'b) blit = 'a -> int -> 'b -> int -> int -> unit
+      (** The type of the [blit] function. *)
+
+      type 'a length = 'a -> int
+      (** The type of the [length] function. *)
+
+      val push_exn :
+        ('a, 'b) t ->
+        blit:('src, ('a, 'b) bigarray) blit ->
+        length:'src length ->
+        ?off:int ->
+        ?len:int ->
+        'src ->
+        ('a, 'b) bigarray list
+      (** [push_exn q ~blit ~length ?off ?len src] {i blits} elements in [src]
+         to the given queue [q] at the end (like a fast iterative {!R.push}).
+         Default value of [off] is [0]. Default value of [len] is [length src - off].
+         It returns a list of internal {!bigarray}s which contain [dst].
+         If the given [q] does not have enough free space to write [src], it
+         raises {!Full} and the given queue is unchanged. *)
+
+      val push :
+        ('a, 'b) t ->
+        blit:('src, ('a, 'b) bigarray) blit ->
+        length:'src length ->
+        ?off:int ->
+        ?len:int ->
+        'src ->
+        ('a, 'b) bigarray list option
+      (** Same as {!push_exn} but it returns [None] if it fails. *)
+
+      val keep_exn :
+        ('a, 'b) t ->
+        blit:(('a, 'b) bigarray, 'dst) blit ->
+        length:'dst length ->
+        ?off:int ->
+        ?len:int ->
+        'dst ->
+        unit
+      (** [keep_exn q ~blit ~length ?off ?len dst] {i blits} elements of the
+         given queue [q] in [dst] from the front to the end of [dst] (like a
+         fast iterative {!R.pop_exn}). Default value of [off] is [0]. Default
+         value of [len] is [length dst - off]. If the given [q] does not have
+         enough elements to write on [dst], it raises {!Empty}. In any case, the
+         given queue is unchanged. *)
+
+      val keep :
+        ('a, 'b) t ->
+        blit:(('a, 'b) bigarray, 'dst) blit ->
+        length:'dst length ->
+        ?off:int ->
+        ?len:int ->
+        'dst ->
+        unit option
+      (** Same as {!keep_exn} but if it fails, it returns [None]. *)
+
+      val peek :
+        ('a, 'b) t -> ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t list
+      (** Returns a sub-part of available to read payloads. *)
+
+      val unsafe_shift : ('a, 'b) t -> int -> unit
+      (** [unsafe_shift q l] discards [l] elements in the given queue [q]
+         without any verification. Mostly used after {!keep_exn}, if the last
+         one does not raise {!Empty}, it's safe to use it. *)
+
+      val shift_exn : ('a, 'b) t -> int -> unit
+      (** [shift_exn q l] discards [l] elements in the given queue [q]. If [q]
+         does not have enough elements, it raises {!Empty} and the given queue
+         is unchanged. *)
+
+      val shift : ('a, 'b) t -> int -> unit option
+      (** Same as {!shift_exn} but if it fails, it returns [None]. *)
+    end
+
+    val iter : ('a -> unit) -> ('a, 'b) t -> unit
+    (** [iter f q] applies [f] in turn to all elements of [q], from the least
+       recently entered to the most recently entered. The queue itself is
+       unchanged. *)
+
+    val rev_iter : ('a -> unit) -> ('a, 'b) t -> unit
+    (** [iter f q] applies [f] in turn to all elements of [q], from the most
+       recently entered to the least recently entered. The queue itself is
+       unchanged. *)
+
+    val fold : ('acc -> 'x -> 'acc) -> 'acc -> ('x, 'b) t -> 'acc
+    (** [fold f a q] is equivalent to [List.fold_left f a l], where [l] is the
+       list of [q]'s elements. The queue remains unchanged. *)
+
+    val pp : ?sep:unit Fmt.t -> 'a Fmt.t -> ('a, 'b) t Fmt.t
+    (** Pretty-printer of {!t}. *)
+
+    val dump : 'a Fmt.t -> ('a, 'b) t Fmt.t
+    (** Human-readable pretty-printer of {!t}. *)
+
+    val unsafe_bigarray :
+      ('a, 'b) t -> ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
+    (** / **)
+
+    val from : ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t -> ('a, 'b) t
+  end
+
+  module type F = sig
+    type ('a, 'b) t
+    (** The type of queues containing elements of type ['a]. *)
+
+    exception Empty
+    (** Raised when {!push_exn} or {!N.push_exn} is applied to an empty queue. *)
+
+    exception Full
+    (** Raised when {!peek_exn}, {!pop_exn} is applied to an empty queue. *)
+
+    val is_empty : ('a, 'b) t -> bool
+    (** Return [true] if the given queue is empty, [false] otherwise. *)
+
+    val create : ?capacity:int -> ('a, 'b) Bigarray.kind -> ('a, 'b) t * int
+    (** Return a new queue, initially empty with the real capacity of it. *)
+
+    val length : ('a, 'b) t -> int
+    (** Number of elements in the queue. *)
+
+    val available : ('a, 'b) t -> int
+    (** Free cells availables on the queue. *)
+
+    val push_exn : ('a, 'b) t -> 'a -> ('a, 'b) t
+    (** [push_exn q x] adds the elements [x] at the end of the queue [q] and
+       returns the new queue [q']. It raises {!Full} if the given queue [q] is
+       full. *)
+
+    val push : ('a, 'b) t -> 'a -> ('a, 'b) t option
+    (** [push q x] is the same as {!push_exn} but returns [None] if it fails. *)
+
+    val pop : ('a, 'b) t -> ('a * ('a, 'b) t) option
+    (** [pop q] removes and returns the first element in the given queue [q] and
+       returns the new queue [q']. If [q] is empty, it returns [None]. *)
+
+    val pop_exn : ('a, 'b) t -> 'a * ('a, 'b) t
+    (** [pop_exn q] is the same as {!pop} but it raises an {!Empty} if the given
+       queue is empty. *)
+
+    val peek : ('a, 'b) t -> 'a option
+    (** [peek q] returns the first element in the given queue [q]. If [q] is
+       empty, it returns [None]. The given queue [q] is unchanged. *)
+
+    val peek_exn : ('a, 'b) t -> 'a
+    (** [peek_exn q] returns the first element in the given queue [q]. If [q] is
+       empty, it raises {!Empty}. *)
+
+    val cons : ('a, 'b) t -> 'a -> ('a, 'b) t option
+    (** [cons q x] adds element [x] at the front of the given queue [q]. It
+       returns [None] if it fails or the new queue [q']. *)
+
+    val cons_exn : ('a, 'b) t -> 'a -> ('a, 'b) t
+    (** [cons q x] adds element [x] at the front of the given queue [q]. It
+       raises {!Empty} if the given queue [q] is full or the new queue [q']. *)
+
+    val copy : ('a, 'b) t -> ('a, 'b) t
+    (** Return a copy of the given queue. *)
+
+    val clear : ('a, 'b) t -> ('a, 'b) t
+    (** Discard all elements from a queue. *)
+
+    module N : sig
+      type ('a, 'b) bigarray = ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
+      (** The type of the internal bigarray of {!t}. *)
+
+      type ('a, 'b) blit = 'a -> int -> 'b -> int -> int -> unit
+      (** The type of the [blit] function. *)
+
+      type 'a length = 'a -> int
+      (** The type of the [length] function. *)
+
+      val push_exn :
+        ('a, 'b) t ->
+        blit:('src, ('a, 'b) bigarray) blit ->
+        length:'src length ->
+        ?off:int ->
+        ?len:int ->
+        'src ->
+        ('a, 'b) bigarray list * ('a, 'b) t
+      (** [push_exn q ~blit ~length ?off ?len src] {i blits} elements in [src]
+         to the given queue [q] at the end (like a fast iterative {!R.push}).
+         Default value of [off] is [0]. Default value of [len] is [length src - off].
+         It returns a list of internal {!bigarray}s which contain [dst].
+         If the given [q] does not have enough free space to write [src], it
+         raises {!Full} and the given queue is unchanged. *)
+
+      val push :
+        ('a, 'b) t ->
+        blit:('src, ('a, 'b) bigarray) blit ->
+        length:'src length ->
+        ?off:int ->
+        ?len:int ->
+        'src ->
+        (('a, 'b) bigarray list * ('a, 'b) t) option
+      (** Same as {!push_exn} but it returns [None] if it fails. *)
+
+      val keep_exn :
+        ('a, 'b) t ->
+        blit:(('a, 'b) bigarray, 'dst) blit ->
+        length:'dst length ->
+        ?off:int ->
+        ?len:int ->
+        'dst ->
+        unit
+      (** [keep_exn q ~blit ~length ?off ?len dst] {i blits} elements of the
+         given queue [q] in [dst] from the front to the end of [dst] (like a
+         fast iterative {!R.pop_exn}). Default value of [off] is [0]. Default
+         value of [len] is [length dst - off]. If the given [q] does not have
+         enough elements to write on [dst], it raises {!Empty}. In any case, the
+         given queue is unchanged. *)
+
+      val keep :
+        ('a, 'b) t ->
+        blit:(('a, 'b) bigarray, 'dst) blit ->
+        length:'dst length ->
+        ?off:int ->
+        ?len:int ->
+        'dst ->
+        unit option
+      (** Same as {!keep_exn} but if it fails, it returns [None]. *)
+
+      val unsafe_shift : ('a, 'b) t -> int -> ('a, 'b) t
+      (** [unsafe_shift q l] discards [l] elements in the given queue [q]
+         without any verification. Mostly used after {!keep_exn}, if the last
+         one does not raise {!Empty}, it's safe to use it. *)
+
+      val shift_exn : ('a, 'b) t -> int -> ('a, 'b) t
+      (** [shift_exn q l] discards [l] elements in the given queue [q]. If [q]
+         does not have enough elements, it raises {!Empty} and the given queue
+         is unchanged. *)
+
+      val shift : ('a, 'b) t -> int -> ('a, 'b) t option
+      (** Same as {!shift_exn} but if it fails, it returns [None]. *)
+    end
+
+    val iter : ('a -> unit) -> ('a, 'b) t -> unit
+    (** [iter f q] applies [f] in turn to all elements of [q], from the least
+       recently entered to the most recently entered. The queue itself is
+       unchanged. *)
+
+    val rev_iter : ('a -> unit) -> ('a, 'b) t -> unit
+    (** [iter f q] applies [f] in turn to all elements of [q], from the most
+       recently entered to the least recently entered. The queue itself is
+       unchanged. *)
+
+    val fold : ('acc -> 'x -> 'acc) -> 'acc -> ('x, 'b) t -> 'acc
+    (** [fold f a q] is equivalent to [List.fold_left f a l], where [l] is the
+       list of [q]'s elements. The queue remains unchanged. *)
+
+    val pp : ?sep:unit Fmt.t -> 'a Fmt.t -> ('a, 'b) t Fmt.t
+    (** Pretty-printer of {!t}. *)
+
+    val dump : 'a Fmt.t -> ('a, 'b) t Fmt.t
+    (** Human-readable pretty-printer of {!t}. *)
+
+    (** / **)
+
+    val unsafe_bigarray :
+      ('a, 'b) t -> ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
+
+    val from : ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t -> ('a, 'b) t
+  end
+end