mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 11:15:31 -05:00
change type of CCDeque
Change the definition of the type in CCDeque to remove the Zero cell. This new type enforce one invariant.
This commit is contained in:
Fardale
Simon Cruanes
parent
b3ce398624
commit
2fa12665dd
1 changed files with 219 additions and 174 deletions
|
|
@ -3,23 +3,23 @@
|
|||
(** {1 Imperative deque} *)
|
||||
|
||||
type 'a cell =
|
||||
| Zero
|
||||
| One of 'a
|
||||
| Two of 'a * 'a
|
||||
| Three of 'a * 'a * 'a
|
||||
(** A cell holding a small number of elements *)
|
||||
|
||||
type 'a node = {
|
||||
type 'a inner_node = {
|
||||
mutable cell : 'a cell;
|
||||
mutable next : 'a node;
|
||||
mutable prev : 'a node;
|
||||
mutable next : 'a inner_node;
|
||||
mutable prev : 'a inner_node;
|
||||
}
|
||||
|
||||
type 'a node = Empty | Node of 'a inner_node
|
||||
(** Linked list of cells.
|
||||
|
||||
invariant: only the first and last cells are allowed to
|
||||
be anything but [Three] (all the intermediate ones are [Three])
|
||||
The first and last cell are [Zero] if and only if the
|
||||
deque is empty *)
|
||||
*)
|
||||
|
||||
type 'a t = {
|
||||
mutable cur : 'a node;
|
||||
|
|
@ -48,12 +48,10 @@ type 'a t = {
|
|||
exception Empty
|
||||
|
||||
let create () =
|
||||
let rec cur = { cell=Zero; prev=cur; next=cur } in
|
||||
{ cur; size=0 }
|
||||
{ cur = Empty; size=0 }
|
||||
|
||||
let clear q =
|
||||
let rec cur = { cell=Zero; prev=cur; next=cur } in
|
||||
q.cur <- cur;
|
||||
q.cur <- Empty;
|
||||
q.size <- 0;
|
||||
()
|
||||
|
||||
|
|
@ -69,45 +67,51 @@ let clear q =
|
|||
let incr_size_ d = d.size <- d.size + 1
|
||||
let decr_size_ d = d.size <- d.size - 1
|
||||
|
||||
let is_zero_ n = match n.cell with
|
||||
| Zero -> true
|
||||
| One _
|
||||
| Two _
|
||||
| Three _ -> false
|
||||
|
||||
let bool_eq (a : bool) b = Stdlib.(=) a b
|
||||
|
||||
let is_empty d =
|
||||
let res = d.size = 0 in
|
||||
assert (bool_eq res (is_zero_ d.cur));
|
||||
assert (bool_eq res (d.cur = Empty));
|
||||
res
|
||||
|
||||
(*let rec cur = { cell=Zero; prev=cur; next=cur } in*)
|
||||
let push_front d x =
|
||||
incr_size_ d;
|
||||
match d.cur.cell with
|
||||
| Zero -> d.cur.cell <- One x
|
||||
| One y -> d.cur.cell <- Two (x, y)
|
||||
| Two (y, z) -> d.cur.cell <- Three (x,y,z)
|
||||
match d.cur with
|
||||
| Empty ->
|
||||
let rec node = { cell=One x; prev = node; next = node } in
|
||||
d.cur <- Node node
|
||||
| Node n ->
|
||||
match n.cell with
|
||||
| One y -> n.cell <- Two (x, y)
|
||||
| Two (y, z) -> n.cell <- Three (x,y,z)
|
||||
| Three _ ->
|
||||
let node = { cell = One x; prev = d.cur.prev; next=d.cur; } in
|
||||
d.cur.prev.next <- node;
|
||||
d.cur.prev <- node;
|
||||
d.cur <- node (* always point to first node *)
|
||||
let node = { cell = One x; prev = n.prev; next = n; } in
|
||||
n.prev.next <- node;
|
||||
n.prev <- node;
|
||||
d.cur <- Node node (* always point to first node *)
|
||||
|
||||
let push_back d x =
|
||||
incr_size_ d;
|
||||
let n = d.cur.prev in (* last node *)
|
||||
match d.cur with
|
||||
| Empty ->
|
||||
let rec node = { cell=One x; prev = node; next = node } in
|
||||
d.cur <- Node node
|
||||
| Node cur ->
|
||||
let n = cur.prev in (* last node *)
|
||||
match n.cell with
|
||||
| Zero -> n.cell <- One x
|
||||
| One y -> n.cell <- Two (y, x)
|
||||
| Two (y,z) -> n.cell <- Three (y, z, x)
|
||||
| Three _ ->
|
||||
let elt = { cell = One x; next=d.cur; prev=n; } in
|
||||
let elt = { cell = One x; next=cur; prev=n; } in
|
||||
n.next <- elt;
|
||||
d.cur.prev <- elt
|
||||
cur.prev <- elt
|
||||
|
||||
let peek_front_opt d = match d.cur.cell with
|
||||
| Zero -> None
|
||||
let peek_front_opt d =
|
||||
match d.cur with
|
||||
| Empty -> None
|
||||
| Node cur ->
|
||||
match cur.cell with
|
||||
| One x -> Some x
|
||||
| Two (x,_) -> Some x
|
||||
| Three (x,_,_) -> Some x
|
||||
|
|
@ -135,9 +139,10 @@ let peek_front d = match peek_front_opt d with
|
|||
*)
|
||||
|
||||
let peek_back_opt d =
|
||||
if is_empty d then None
|
||||
else match d.cur.prev.cell with
|
||||
| Zero -> assert false
|
||||
match d.cur with
|
||||
| Empty -> None
|
||||
| Node cur ->
|
||||
match cur.prev.cell with
|
||||
| One x -> Some x
|
||||
| Two (_,x) -> Some x
|
||||
| Three (_,_,x) -> Some x
|
||||
|
|
@ -164,10 +169,9 @@ let peek_back d = match peek_back_opt d with
|
|||
*)
|
||||
|
||||
let take_back_node_ n = match n.cell with
|
||||
| Zero -> assert false
|
||||
| One x -> n.cell <- Zero; x
|
||||
| Two (x,y) -> n.cell <- One x; y
|
||||
| Three (x,y,z) -> n.cell <- Two (x,y); z
|
||||
| One x -> (true, x)
|
||||
| Two (x,y) -> n.cell <- One x; (false, y)
|
||||
| Three (x,y,z) -> n.cell <- Two (x,y); (false, z)
|
||||
|
||||
let remove_node_ n =
|
||||
let next = n.next in
|
||||
|
|
@ -175,18 +179,22 @@ let remove_node_ n =
|
|||
next.prev <- n.prev
|
||||
|
||||
let take_back_opt d =
|
||||
if is_empty d then None
|
||||
else if Stdlib.(==) d.cur d.cur.prev
|
||||
match d.cur with
|
||||
| Empty -> None
|
||||
| Node cur ->
|
||||
if Stdlib.(==) cur cur.prev
|
||||
then (
|
||||
(* only one cell *)
|
||||
decr_size_ d;
|
||||
Some (take_back_node_ d.cur)
|
||||
let is_zero, x = take_back_node_ cur in
|
||||
if is_zero then d.cur <- Empty;
|
||||
Some x
|
||||
) else (
|
||||
let n = d.cur.prev in
|
||||
let x = take_back_node_ n in
|
||||
let n = cur.prev in
|
||||
let is_zero, x = take_back_node_ n in
|
||||
decr_size_ d;
|
||||
(* remove previous node *)
|
||||
if is_zero_ n then remove_node_ n;
|
||||
if is_zero then remove_node_ n;
|
||||
Some x
|
||||
)
|
||||
|
||||
|
|
@ -202,29 +210,32 @@ let take_back d = match take_back_opt d with
|
|||
*)
|
||||
|
||||
let take_front_node_ n = match n.cell with
|
||||
| Zero -> assert false
|
||||
| One x -> n.cell <- Zero; x
|
||||
| Two (x,y) -> n.cell <- One y; x
|
||||
| Three (x,y,z) -> n.cell <- Two (y,z); x
|
||||
| One x -> (true, x)
|
||||
| Two (x,y) -> n.cell <- One y; (false, x)
|
||||
| Three (x,y,z) -> n.cell <- Two (y,z); (false, x)
|
||||
|
||||
(*$T
|
||||
let q = of_list [1;2;3] in take_front q = 1 && to_list q = [2;3]
|
||||
*)
|
||||
|
||||
let take_front_opt d =
|
||||
if is_empty d then None
|
||||
else if Stdlib.(==) d.cur.prev d.cur
|
||||
match d.cur with
|
||||
| Empty -> None
|
||||
| Node cur ->
|
||||
if Stdlib.(==) cur.prev cur
|
||||
then (
|
||||
(* only one cell *)
|
||||
decr_size_ d;
|
||||
Some (take_front_node_ d.cur)
|
||||
let is_zero, x = take_front_node_ cur in
|
||||
if is_zero then d.cur <- Empty;
|
||||
Some x
|
||||
) else (
|
||||
decr_size_ d;
|
||||
let x = take_front_node_ d.cur in
|
||||
if is_zero_ d.cur then (
|
||||
d.cur.prev.next <- d.cur.next;
|
||||
d.cur.next.prev <- d.cur.prev;
|
||||
d.cur <- d.cur.next;
|
||||
let is_zero, x = take_front_node_ cur in
|
||||
if is_zero then (
|
||||
cur.prev.next <- cur.next;
|
||||
cur.next.prev <- cur.prev;
|
||||
d.cur <- Node cur.next;
|
||||
);
|
||||
Some x
|
||||
)
|
||||
|
|
@ -246,27 +257,29 @@ let remove_front d = ignore (take_front_opt d)
|
|||
*)
|
||||
|
||||
let update_front d f =
|
||||
match d.cur.cell with
|
||||
| Zero -> ()
|
||||
match d.cur with
|
||||
| Empty -> ()
|
||||
| Node cur ->
|
||||
match cur.cell with
|
||||
| One x ->
|
||||
begin match f x with
|
||||
| None -> if Stdlib.(!=) d.cur.prev d.cur then (
|
||||
d.cur.prev.next <- d.cur.next;
|
||||
d.cur.next.prev <- d.cur.prev;
|
||||
d.cur <- d.cur.next;
|
||||
| None -> if Stdlib.(!=) cur.prev cur then (
|
||||
cur.prev.next <- cur.next;
|
||||
cur.next.prev <- cur.prev;
|
||||
d.cur <- Node cur.next;
|
||||
)
|
||||
else d.cur.cell <- Zero
|
||||
| Some x -> d.cur.cell <- One x
|
||||
else d.cur <- Empty
|
||||
| Some x -> cur.cell <- One x
|
||||
end
|
||||
| Two (x, y) ->
|
||||
begin match f x with
|
||||
| None -> d.cur.cell <- One (y)
|
||||
| Some x -> d.cur.cell <- Two (x,y)
|
||||
| None -> cur.cell <- One (y)
|
||||
| Some x -> cur.cell <- Two (x,y)
|
||||
end
|
||||
| Three (x,y,z) ->
|
||||
begin match f x with
|
||||
| None -> d.cur.cell <- Two (y,z)
|
||||
| Some x -> d.cur.cell <- Three (x,y,z)
|
||||
| None -> cur.cell <- Two (y,z)
|
||||
| Some x -> cur.cell <- Three (x,y,z)
|
||||
end
|
||||
|
||||
(*$T update_front
|
||||
|
|
@ -287,13 +300,15 @@ let update_front d f =
|
|||
*)
|
||||
|
||||
let update_back d f =
|
||||
let n = d.cur.prev in
|
||||
match d.cur with
|
||||
| Empty -> ()
|
||||
| Node cur ->
|
||||
let n = cur.prev in
|
||||
match n.cell with
|
||||
| Zero -> ()
|
||||
| One x ->
|
||||
begin match f x with
|
||||
| None -> if Stdlib.(!=) d.cur.prev d.cur then remove_node_ n
|
||||
else n.cell <- Zero
|
||||
| None -> if Stdlib.(!=) cur.prev cur then remove_node_ n
|
||||
else d.cur <- Empty
|
||||
| Some x -> n.cell <- One x
|
||||
end
|
||||
| Two (x, y) ->
|
||||
|
|
@ -327,14 +342,16 @@ let update_back d f =
|
|||
let iter f d =
|
||||
let rec iter f ~first n =
|
||||
begin match n.cell with
|
||||
| Zero -> ()
|
||||
| One x -> f x
|
||||
| Two (x,y) -> f x; f y
|
||||
| Three (x,y,z) -> f x; f y; f z
|
||||
end;
|
||||
if n.next != first then iter f ~first n.next
|
||||
in
|
||||
iter f ~first:d.cur d.cur
|
||||
match d.cur with
|
||||
| Empty -> ()
|
||||
| Node cur ->
|
||||
iter f ~first:cur cur
|
||||
|
||||
(*$T
|
||||
let n = ref 0 in iter (fun _ -> incr n) (of_list [1;2;3]); !n = 3
|
||||
|
|
@ -362,14 +379,16 @@ let append_back ~into q = iter (push_back into) q
|
|||
let fold f acc d =
|
||||
let rec aux ~first f acc n =
|
||||
let acc = match n.cell with
|
||||
| Zero -> acc
|
||||
| One x -> f acc x
|
||||
| Two (x,y) -> f (f acc x) y
|
||||
| Three (x,y,z) -> f (f (f acc x) y) z
|
||||
in
|
||||
if Stdlib.(==) n.next first then acc else aux ~first f acc n.next
|
||||
in
|
||||
aux ~first:d.cur f acc d.cur
|
||||
match d.cur with
|
||||
| Empty -> acc
|
||||
| Node cur ->
|
||||
aux ~first:cur f acc cur
|
||||
|
||||
(*$T
|
||||
fold (+) 0 (of_list [1;2;3]) = 6
|
||||
|
|
@ -436,45 +455,45 @@ let to_rev_list q = fold (fun l x -> x::l) [] q
|
|||
let to_list q = List.rev (to_rev_list q)
|
||||
|
||||
let size_cell_ = function
|
||||
| Zero -> 0
|
||||
| One _ -> 1
|
||||
| Two _ -> 2
|
||||
| Three _ -> 3
|
||||
|
||||
(* filter over a cell *)
|
||||
let filter_cell_ f = function
|
||||
| Zero -> Zero
|
||||
| One x as c -> if f x then c else Zero
|
||||
| One x as c -> if f x then Some c else None
|
||||
| Two (x,y) as c ->
|
||||
let fx = f x in
|
||||
let fy = f y in
|
||||
begin match fx, fy with
|
||||
| true, true -> c
|
||||
| true, false -> One x
|
||||
| false, true -> One y
|
||||
| _ -> Zero
|
||||
| true, true -> Some c
|
||||
| true, false -> Some (One x)
|
||||
| false, true -> Some (One y)
|
||||
| _ -> None
|
||||
end
|
||||
| Three (x,y,z) as c ->
|
||||
let fx = f x in
|
||||
let fy = f y in
|
||||
let fz = f z in
|
||||
begin match fx, fy, fz with
|
||||
| true, true, true -> c
|
||||
| true, true, false -> Two (x,y)
|
||||
| true, false, true -> Two (x,z)
|
||||
| true, false, false -> One x
|
||||
| false, true, true -> Two (y,z)
|
||||
| false, true, false -> One y
|
||||
| false, false, true -> One z
|
||||
| false, false, false -> Zero
|
||||
| true, true, true -> Some c
|
||||
| true, true, false -> Some (Two (x,y))
|
||||
| true, false, true -> Some (Two (x,z))
|
||||
| true, false, false -> Some (One x)
|
||||
| false, true, true -> Some (Two (y,z))
|
||||
| false, true, false -> Some (One y)
|
||||
| false, false, true -> Some (One z)
|
||||
| false, false, false -> None
|
||||
end
|
||||
|
||||
let filter_in_place (d:_ t) f : unit =
|
||||
(* update size, compute new cell *)
|
||||
let update_local_ n =
|
||||
d.size <- d.size - size_cell_ n.cell;
|
||||
let new_cell = filter_cell_ f n.cell in
|
||||
d.size <- d.size + size_cell_ new_cell;
|
||||
match filter_cell_ f n.cell with
|
||||
| None -> None
|
||||
|Some n as new_cell->
|
||||
d.size <- d.size + size_cell_ n;
|
||||
new_cell
|
||||
in
|
||||
let rec loop ~stop_at n : unit =
|
||||
|
|
@ -484,21 +503,43 @@ let filter_in_place (d:_ t) f : unit =
|
|||
let new_cell = update_local_ n in
|
||||
(* merge into previous cell *)
|
||||
begin match n_prev.cell, new_cell with
|
||||
| _, Zero -> remove_node_ n
|
||||
| Zero, _ -> remove_node_ n; n_prev.cell <- new_cell;
|
||||
| Three _, _ -> n.cell <- new_cell
|
||||
| One x, One y -> remove_node_ n; n_prev.cell <- Two (x,y)
|
||||
| One (x), Two (y,z)
|
||||
| Two (x,y), One z -> remove_node_ n; n_prev.cell <- Three (x,y,z)
|
||||
| One x, Three (y,z,w)
|
||||
| Two (x,y), Two (z,w) -> n_prev.cell <- Three (x,y,z); n.cell <- One w
|
||||
| Two (x,y), Three (z,w1,w2) -> n_prev.cell <- Three (x,y,z); n.cell <- Two (w1,w2)
|
||||
| _, None -> remove_node_ n
|
||||
| Three _, Some new_cell -> n.cell <- new_cell
|
||||
| One x, Some (One y) -> remove_node_ n; n_prev.cell <- Two (x,y)
|
||||
| One (x), Some (Two (y,z))
|
||||
| Two (x,y), Some (One z) -> remove_node_ n; n_prev.cell <- Three (x,y,z)
|
||||
| One x, Some (Three (y,z,w))
|
||||
| Two (x,y), Some (Two (z,w)) -> n_prev.cell <- Three (x,y,z); n.cell <- One w
|
||||
| Two (x,y), Some (Three (z,w1,w2)) -> n_prev.cell <- Three (x,y,z); n.cell <- Two (w1,w2)
|
||||
end;
|
||||
loop ~stop_at n_next;
|
||||
);
|
||||
in
|
||||
d.cur.cell <- update_local_ d.cur; (* special case for first cell *)
|
||||
loop ~stop_at:d.cur d.cur.next
|
||||
let rec new_first_cell ~stop_at n =
|
||||
if n != stop_at then (
|
||||
match update_local_ n with
|
||||
| None ->
|
||||
new_first_cell ~stop_at n.next
|
||||
| Some c ->
|
||||
n.cell <- c; Some n
|
||||
) else None
|
||||
in
|
||||
match d.cur with
|
||||
| Empty -> ()
|
||||
| Node cur ->
|
||||
(* special case for first cell *)
|
||||
match update_local_ cur with
|
||||
| None ->
|
||||
begin match new_first_cell ~stop_at:cur cur.next with
|
||||
| None -> d.cur <- Empty
|
||||
| Some n ->
|
||||
cur.prev.next <- n;
|
||||
n.prev <- cur.prev;
|
||||
d.cur <- Node n;
|
||||
loop ~stop_at:n n.next
|
||||
end
|
||||
| Some c -> cur.cell <- c;
|
||||
loop ~stop_at:cur cur.next
|
||||
|
||||
(*$R
|
||||
let q = of_list [1;2;3;4;5;6] in
|
||||
|
|
@ -546,20 +587,23 @@ let of_gen g =
|
|||
q
|
||||
|
||||
let to_gen q =
|
||||
let first = q.cur in
|
||||
let cell = ref q.cur.cell in
|
||||
let cur = ref q.cur in
|
||||
match q.cur with
|
||||
| Empty -> (fun () -> None)
|
||||
| Node cur ->
|
||||
let first = cur in
|
||||
let cell = ref (Some cur.cell) in
|
||||
let cur = ref cur in
|
||||
let rec next () = match !cell with
|
||||
| Zero when Stdlib.(==) (!cur).next first -> None
|
||||
| Zero ->
|
||||
| None when Stdlib.(==) (!cur).next first -> None
|
||||
| None ->
|
||||
(* go to next node *)
|
||||
let n = !cur in
|
||||
cur := n.next;
|
||||
cell := n.next.cell;
|
||||
cell := Some (n.next.cell);
|
||||
next ()
|
||||
| One x -> cell := Zero; Some x
|
||||
| Two (x,y) -> cell := One y; Some x
|
||||
| Three (x,y,z) -> cell := Two (y,z); Some x
|
||||
| Some (One x) -> cell := None; Some x
|
||||
| Some (Two (x,y)) -> cell := Some (One y); Some x
|
||||
| Some (Three (x,y,z)) -> cell := Some (Two (y,z)); Some x
|
||||
in
|
||||
next
|
||||
|
||||
|
|
@ -627,3 +671,4 @@ let pp pp_x out d =
|
|||
pp_x out x
|
||||
) d;
|
||||
Format.fprintf out "}@]"
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue