Add optional capacity argument to Queue.create and Stack.create

Author: polytypic

src/kcas_data/elems.ml

@@ -41,3 +41,14 @@ let rev_prepend_to_seq t tl =
         | `Reversed t' -> t'
       in
       prepend_to_seq t tl ()
+
+let rec of_list_rev tl length = function
+  | [] -> tl
+  | x :: xs ->
+      let length = length + 1 in
+      of_list_rev { value = x; tl; length } length xs
+
+let of_list_rev = function
+  | [] -> empty
+  | x :: xs -> of_list_rev (singleton x) 1 xs
+  [@@inline]

src/kcas_data/elems.mli

@@ -18,3 +18,4 @@ val prepend_to_seq : 'a t -> 'a Seq.t -> 'a Seq.t
 val to_seq : 'a t -> 'a Seq.t
 val of_seq_rev : 'a Seq.t -> 'a t
 val rev_prepend_to_seq : 'a t -> 'a Seq.t -> 'a Seq.t
+val of_list_rev : 'a list -> 'a t

src/kcas_data/list_with_capacity.ml

@@ -0,0 +1,121 @@
+open Kcas
+
+type 'a t = { capacity : int; length : int; list : 'a list; limit : int }
+
+let empty_unlimited =
+  { capacity = Int.max_int; length = 0; list = []; limit = Int.max_int }
+
+let make_empty ~capacity =
+  if capacity = Int.max_int then empty_unlimited
+  else { capacity; length = 0; list = []; limit = capacity }
+  [@@inline]
+
+let make ~capacity ~length ~list ~limit = { capacity; length; list; limit }
+  [@@inline]
+
+let to_rev_elems t = Elems.of_list_rev t.list [@@inline]
+let is_empty t = t.length = 0 [@@inline]
+let length t = t.length [@@inline]
+let capacity t = t.capacity [@@inline]
+let limit t = t.limit [@@inline]
+let list t = t.list [@@inline]
+
+let tl_safe = function
+  | { list = []; _ } as t -> t
+  | { capacity; length; list = _ :: list; _ } as t ->
+      let limit = if capacity = Int.max_int then capacity else t.limit in
+      { capacity; length = length - 1; list; limit }
+  [@@inline]
+
+let tl_or_retry = function
+  | { list = []; _ } -> Retry.later ()
+  | { capacity; length; list = _ :: list; _ } as t ->
+      let limit = if capacity = Int.max_int then capacity else t.limit in
+      { capacity; length = length - 1; list; limit }
+  [@@inline]
+
+let hd_opt t = match t.list with [] -> None | x :: _ -> Some x [@@inline]
+
+let hd_or_retry t = match t.list with [] -> Retry.later () | x :: _ -> x
+  [@@inline]
+
+let hd_unsafe t = List.hd t.list [@@inline]
+
+let cons_safe x ({ capacity; _ } as t) =
+  if capacity = Int.max_int then
+    let { length; list; _ } = t in
+    { capacity; length = length + 1; list = x :: list; limit = capacity }
+  else
+    let { length; limit; _ } = t in
+    if length < limit then
+      let { list; _ } = t in
+      { capacity; length = length + 1; list = x :: list; limit }
+    else t
+  [@@inline]
+
+let cons_or_retry x ({ capacity; _ } as t) =
+  if capacity = Int.max_int then
+    let { length; list; _ } = t in
+    { capacity; length = length + 1; list = x :: list; limit = capacity }
+  else
+    let { length; limit; _ } = t in
+    if length < limit then
+      let { list; _ } = t in
+      { capacity; length = length + 1; list = x :: list; limit }
+    else Retry.later ()
+  [@@inline]
+
+let move ({ capacity; _ } as t) =
+  if capacity = Int.max_int then empty_unlimited
+  else
+    let { length; _ } = t in
+    if length = 0 then t
+    else
+      let { limit; _ } = t in
+      { capacity; length = 0; list = []; limit = limit - length }
+  [@@inline]
+
+let move_last ({ capacity; _ } as t) =
+  if capacity = Int.max_int then empty_unlimited
+  else
+    let { length; _ } = t in
+    let limit = capacity - length in
+    if length = 0 && t.limit = limit then t
+    else { capacity; length = 0; list = []; limit }
+
+let clear ({ capacity; _ } as t) =
+  if capacity = Int.max_int then empty_unlimited
+  else if t.length = 0 && t.limit = capacity then t
+  else make_empty ~capacity
+  [@@inline]
+
+let rec prepend_to_seq xs tl =
+  match xs with
+  | [] -> tl
+  | x :: xs -> fun () -> Seq.Cons (x, prepend_to_seq xs tl)
+
+let to_seq { list; _ } = prepend_to_seq list Seq.empty
+
+let rev_prepend_to_seq { length; list; _ } tl =
+  if length <= 1 then prepend_to_seq list tl
+  else
+    let t = ref (`Original list) in
+    fun () ->
+      let t =
+        match !t with
+        | `Original t' ->
+            (* This is domain safe as the result is always equivalent. *)
+            let t' = List.rev t' in
+            t := `Reversed t';
+            t'
+        | `Reversed t' -> t'
+      in
+      prepend_to_seq t tl ()
+
+let of_list ?(capacity = Int.max_int) list =
+  let length = List.length list in
+  let limit = Int.min 0 (capacity - length) in
+  { capacity; length; list; limit }
+
+let of_seq_rev ?capacity xs =
+  of_list ?capacity (Seq.fold_left (fun xs x -> x :: xs) [] xs)

src/kcas_data/list_with_capacity.mli

@@ -0,0 +1,24 @@
+type !'a t
+
+val empty_unlimited : 'a t
+val make_empty : capacity:int -> 'a t
+val make : capacity:int -> length:int -> list:'a list -> limit:int -> 'a t
+val is_empty : 'a t -> bool
+val length : 'a t -> int
+val capacity : 'a t -> int
+val limit : 'a t -> int
+val list : 'a t -> 'a list
+val cons_safe : 'a -> 'a t -> 'a t
+val cons_or_retry : 'a -> 'a t -> 'a t
+val move : 'a t -> 'a t
+val move_last : 'a t -> 'a t
+val clear : 'a t -> 'a t
+val to_rev_elems : 'a t -> 'a Elems.t
+val to_seq : 'a t -> 'a Seq.t
+val rev_prepend_to_seq : 'a t -> 'a Seq.t -> 'a Seq.t
+val of_seq_rev : ?capacity:int -> 'a Seq.t -> 'a t
+val tl_safe : 'a t -> 'a t
+val tl_or_retry : 'a t -> 'a t
+val hd_opt : 'a t -> 'a option
+val hd_or_retry : 'a t -> 'a
+val hd_unsafe : 'a t -> 'a