diff --git a/src/data/CCDeque.ml b/src/data/CCDeque.ml index 065fcb64..255c9fbf 100644 --- a/src/data/CCDeque.ml +++ b/src/data/CCDeque.ml @@ -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,48 +67,54 @@ 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) - | 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 *) + 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 = 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 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 - n.next <- elt; - d.cur.prev <- elt + 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 + | One y -> n.cell <- Two (y, x) + | Two (y,z) -> n.cell <- Three (y, z, x) + | Three _ -> + let elt = { cell = One x; next=cur; prev=n; } in + n.next <- elt; + cur.prev <- elt -let peek_front_opt d = match d.cur.cell with - | Zero -> None - | One x -> Some x - | Two (x,_) -> Some x - | Three (x,_,_) -> Some x +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 let peek_front d = match peek_front_opt d with | None -> raise Empty @@ -135,12 +139,13 @@ 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 - | One x -> Some x - | Two (_,x) -> Some x - | Three (_,_,x) -> Some x + 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 let peek_back d = match peek_back_opt d with | None -> raise Empty @@ -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,20 +179,24 @@ 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 - then ( - (* only one cell *) - decr_size_ d; - Some (take_back_node_ d.cur) - ) else ( - let n = d.cur.prev in - let x = take_back_node_ n in - decr_size_ d; - (* remove previous node *) - if is_zero_ n then remove_node_ n; - Some x - ) + match d.cur with + | Empty -> None + | Node cur -> + if Stdlib.(==) cur cur.prev + then ( + (* only one cell *) + decr_size_ d; + let is_zero, x = take_back_node_ cur in + if is_zero then d.cur <- Empty; + Some x + ) else ( + let n = cur.prev in + let is_zero, x = take_back_node_ n in + decr_size_ d; + (* remove previous node *) + if is_zero then remove_node_ n; + Some x + ) let take_back d = match take_back_opt d with | None -> raise Empty @@ -202,32 +210,35 @@ 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 - then ( - (* only one cell *) - decr_size_ d; - Some (take_front_node_ d.cur) - ) 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; - ); - Some x - ) + match d.cur with + | Empty -> None + | Node cur -> + if Stdlib.(==) cur.prev cur + then ( + (* only one cell *) + decr_size_ d; + let is_zero, x = take_front_node_ cur in + if is_zero then d.cur <- Empty; + Some x + ) else ( + decr_size_ d; + 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 + ) let take_front d = match take_front_opt d with | None -> raise Empty @@ -246,28 +257,30 @@ let remove_front d = ignore (take_front_opt d) *) let update_front d f = - match d.cur.cell with - | Zero -> () - | 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; - ) - else d.cur.cell <- Zero - | Some x -> d.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) - 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) - end + match d.cur with + | Empty -> () + | Node cur -> + match cur.cell with + | One x -> + begin match f x with + | 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 <- Empty + | Some x -> cur.cell <- One x + end + | Two (x, y) -> + begin match f x with + | None -> cur.cell <- One (y) + | Some x -> cur.cell <- Two (x,y) + end + | Three (x,y,z) -> + begin match f x with + | None -> cur.cell <- Two (y,z) + | Some x -> cur.cell <- Three (x,y,z) + end (*$T update_front let q = of_list [1;2;3;4;5;6;7] in update_front q (fun _ -> None); to_list q = [2;3;4;5;6;7] @@ -287,25 +300,27 @@ let update_front d f = *) let update_back d f = - let n = d.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 - | Some x -> n.cell <- One x - end - | Two (x, y) -> - begin match f y with - | None -> n.cell <- One (x) - | Some y -> n.cell <- Two (x,y) - end - | Three (x,y,z) -> - begin match f z with - | None -> n.cell <- Two (x,y) - | Some z -> n.cell <- Three (x,y,z) - end + match d.cur with + | Empty -> () + | Node cur -> + let n = cur.prev in + match n.cell with + | One x -> + begin match f x with + | None -> if Stdlib.(!=) cur.prev cur then remove_node_ n + else d.cur <- Empty + | Some x -> n.cell <- One x + end + | Two (x, y) -> + begin match f y with + | None -> n.cell <- One (x) + | Some y -> n.cell <- Two (x,y) + end + | Three (x,y,z) -> + begin match f z with + | None -> n.cell <- Two (x,y) + | Some z -> n.cell <- Three (x,y,z) + end (*$T update_back let q = of_list [1;2;3;4;5;6;7] in update_back q (fun _ -> None); to_list q = [1;2;3;4;5;6] @@ -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,46 +455,46 @@ 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; - 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 = if n != stop_at then ( @@ -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,22 +587,25 @@ 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 - let rec next () = match !cell with - | Zero when Stdlib.(==) (!cur).next first -> None - | Zero -> - (* go to next node *) - let n = !cur in - cur := n.next; - cell := 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 - in - next + 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 + | None when Stdlib.(==) (!cur).next first -> None + | None -> + (* go to next node *) + let n = !cur in + cur := n.next; + cell := Some (n.next.cell); + next () + | 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 (*$T of_list [1;2;3] |> to_gen |> of_gen |> to_list = [1;2;3] @@ -627,3 +671,4 @@ let pp pp_x out d = pp_x out x ) d; Format.fprintf out "}@]" +