rewrote Deque to be safe (no Obj anymore);

more functions in Deque, especially w.r.t. Sequence;
unit tests for Deque

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;
+  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'

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 *)

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;
+    ]

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;

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