-
Notifications
You must be signed in to change notification settings - Fork 11
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Add optional
capacity
argument to Queue.create
and Stack.create
- Loading branch information
Showing
12 changed files
with
366 additions
and
95 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
Oops, something went wrong.