diff --git a/deque.ml b/deque.ml index 4cc9e0c2..4003515d 100644 --- a/deque.ml +++ b/deque.ml @@ -23,78 +23,111 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) -(** Imperative deque *) +(** {1 Imperative deque} *) type 'a elt = { content : 'a; mutable prev : 'a elt; mutable next : 'a elt; -} - -type 'a t = { - mutable first : 'a elt; - mutable length : int; -} +} (** A cell holding a single element *) +and 'a t = 'a elt option ref + (** The deque, a double linked list of cells *) exception Empty -let create () = { - first = Obj.magic None; - length = 0; -} +let create () = ref None -let is_empty d = d.length = 0 - -let length d = d.length - -let mk_elt x = - let rec elt = { - content = x; - prev = elt; - next = elt; - } in elt +let is_empty d = + match !d with + | None -> true + | Some _ -> false let push_front d x = - let elt = mk_elt x in - (if d.length > 0 - then begin - d.first.prev <- elt; - let last = d.first.prev in - last.next <- elt; - elt.next <- d.first; - elt.prev <- last; - end); - d.first <- elt; - d.length <- d.length + 1 + match !d with + | None -> + let rec elt = { + content = x; prev = elt; next = elt; + } in + d := Some elt + | Some first -> + let elt = { content = x; prev = first.prev; next=first; } in + first.prev.next <- elt; + first.prev <- elt; + d := Some elt let push_back d x = - let elt = mk_elt x in - (if d.length > 0 - then begin - let last = d.first.prev in - last.next <- elt; - d.first.prev <- elt; - elt.prev <- last; - elt.next <- d.first; - end else d.first <- elt); - d.length <- d.length + 1 + match !d with + | None -> + let rec elt = { + content = x; prev = elt; next = elt; } in + d := Some elt + | Some first -> + let elt = { content = x; next=first; prev=first.prev; } in + first.prev.next <- elt; + first.prev <- elt + +let peek_front d = + match !d with + | None -> raise Empty + | Some first -> first.content + +let peek_back d = + match !d with + | None -> raise Empty + | Some first -> first.prev.content let take_back d = - (if d.length = 0 then raise Empty); - let elt = d.first.prev in - let new_last = elt.prev in - d.length <- d.length - 1; - new_last.next <- d.first; - d.first.next <- new_last; - elt.content + match !d with + | None -> raise Empty + | Some first when first == first.prev -> + (* only one element *) + d := None; + first.content + | Some first -> + let elt = first.prev in + elt.prev.next <- first; + first.prev <- elt.prev; (* remove [first.prev] from list *) + elt.content let take_front d = - (if d.length = 0 then raise Empty); - let elt = d.first in - let new_first = elt.next in - d.length <- d.length - 1; - let last = d.first.prev in - new_first.prev <- last; - last.next <- new_first; - elt.content + match !d with + | None -> raise Empty + | Some first when first == first.prev -> + (* only one element *) + d := None; + first.content + | Some first -> + first.prev.next <- first.next; (* remove [first] from list *) + first.next.prev <- first.prev; + d := Some first.next; + first.content +let iter f d = + match !d with + | None -> () + | Some first -> + let rec iter elt = + f elt.content; + if elt.next != first then iter elt.next + in + iter first + +let length (d : _ t) = + match !d with + | None -> 0 + | Some _ -> + let r = ref 0 in + iter (fun _ -> incr r) d; + !r + +let of_seq ?(deque=create ()) seq = + Sequence.iter (fun x -> push_back deque x) seq; + deque + +let to_seq d = Sequence.from_iter (fun k -> iter k d) + +(* naive implem of copy, for now *) +let copy d = + let d' = create () in + iter (fun x -> push_back d' x) d; + d' diff --git a/deque.mli b/deque.mli index 4628b183..0ce7128d 100644 --- a/deque.mli +++ b/deque.mli @@ -23,22 +23,45 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) -(** Imperative deque *) +(** {1 Imperative deque} *) type 'a t + (** Contains 'a elements, queue in both ways *) exception Empty val create : unit -> 'a t + (** New deque *) val is_empty : 'a t -> bool + (** Is the deque empty? *) val length : 'a t -> int + (** Number of elements (linear) *) val push_front : 'a t -> 'a -> unit + (** Push value at the front *) val push_back : 'a t -> 'a -> unit + (** Push value at the back *) + +val peek_front : 'a t -> 'a + (** First value, or Empty *) + +val peek_back : 'a t -> 'a + (** Last value, or Empty *) val take_back : 'a t -> 'a + (** Take last value, or raise Empty *) val take_front : 'a t -> 'a + (** Take first value, or raise Empty *) + +val iter : ('a -> unit) -> 'a t -> unit + (** Iterate on elements *) + +val of_seq : ?deque:'a t -> 'a Sequence.t -> 'a t +val to_seq : 'a t -> 'a Sequence.t + +val copy : 'a t -> 'a t + (** Fresh copy *) diff --git a/tests/test_deque.ml b/tests/test_deque.ml new file mode 100644 index 00000000..be59c0a9 --- /dev/null +++ b/tests/test_deque.ml @@ -0,0 +1,52 @@ + +open OUnit + +open Sequence.Infix + +let plist l = Utils.sprintf "%a" (Sequence.pp_seq Format.pp_print_int) (Sequence.of_list l) +let pint i = string_of_int i + +let test_length () = + let d = Deque.of_seq (1 -- 10) in + OUnit.assert_equal ~printer:pint 10 (Deque.length d) + +let test_front () = + let d = Deque.of_seq (1 -- 10) in + let printer = pint in + OUnit.assert_equal ~printer 1 (Deque.peek_front d); + Deque.push_front d 42; + OUnit.assert_equal ~printer 42 (Deque.peek_front d); + OUnit.assert_equal ~printer 42 (Deque.take_front d); + OUnit.assert_equal ~printer 1 (Deque.take_front d); + OUnit.assert_equal ~printer 2 (Deque.take_front d); + OUnit.assert_equal ~printer 3 (Deque.take_front d); + OUnit.assert_equal ~printer 10 (Deque.peek_back d); + () + +let test_back () = + let d = Deque.of_seq (1 -- 10) in + let printer = pint in + OUnit.assert_equal ~printer 1 (Deque.peek_front d); + Deque.push_back d 42; + OUnit.assert_equal ~printer 42 (Deque.peek_back d); + OUnit.assert_equal ~printer 42 (Deque.take_back d); + OUnit.assert_equal ~printer 10 (Deque.take_back d); + OUnit.assert_equal ~printer 9 (Deque.take_back d); + OUnit.assert_equal ~printer 8 (Deque.take_back d); + OUnit.assert_equal ~printer 1 (Deque.peek_front d); + () + +let test_iter () = + let d = Deque.of_seq (1 -- 5) in + let s = Sequence.from_iter (fun k -> Deque.iter k d) in + let l = Sequence.to_list s in + OUnit.assert_equal ~printer:plist [1;2;3;4;5] l; + () + +let suite = + "test_deque" >::: + [ "test_length" >:: test_length; + "test_front" >:: test_front; + "test_back" >:: test_back; + "test_iter" >:: test_iter; + ] diff --git a/tests/tests.ml b/tests/tests.ml index a4ff0022..8c0f01f3 100644 --- a/tests/tests.ml +++ b/tests/tests.ml @@ -5,6 +5,7 @@ open OUnit let suite = "all_tests" >::: [ Test_pHashtbl.suite; + Test_deque.suite; Test_fHashtbl.suite; Test_fQueue.suite; Test_flatHashtbl.suite; diff --git a/utils.ml b/utils.ml new file mode 100644 index 00000000..6d281b0e --- /dev/null +++ b/utils.ml @@ -0,0 +1,17 @@ + +(** {1 Some very basic utils} *) + +(* val sprintf : ('a, Format.formatter, unit, string) format4 -> 'a *) + +let sprintf format = + let buffer = Buffer.create 32 in + let fmt = Format.formatter_of_buffer buffer in + Format.kfprintf + (begin fun fmt -> + Format.pp_print_flush fmt (); + let s = Buffer.contents buffer in + Buffer.clear buffer; + s + end) + fmt + format