Skip to content

Commit

Permalink
Add optional capacity argument to Queue.create and Stack.create
Browse files Browse the repository at this point in the history
  • Loading branch information
polytypic committed Jun 27, 2023
1 parent c7950b0 commit b204e29
Show file tree
Hide file tree
Showing 12 changed files with 376 additions and 97 deletions.
11 changes: 11 additions & 0 deletions src/kcas_data/elems.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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]
1 change: 1 addition & 0 deletions src/kcas_data/elems.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
121 changes: 121 additions & 0 deletions src/kcas_data/list_with_capacity.ml
Original file line number Diff line number Diff line change
@@ -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)
24 changes: 24 additions & 0 deletions src/kcas_data/list_with_capacity.mli
Original file line number Diff line number Diff line change
@@ -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
Loading

0 comments on commit b204e29

Please sign in to comment.