added a functional Queue implementation

containers.mllib

@@ -3,6 +3,7 @@ Deque
 Graph
 Cache
 FlatHashtbl
+FQueue
 SplayTree
 PHashtbl
 Heap

fQueue.ml

@@ -0,0 +1,85 @@
+(*
+Copyright (c) 2013, Simon Cruanes
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+Redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  Redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+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.
+*)
+
+(** {1 Functional queues (fifo)} *)
+
+type 'a t = {
+  hd : 'a list;
+  tl : 'a list;
+} (** Queue containing elements of type 'a *)
+
+let empty = {
+  hd = [];
+  tl = [];
+}
+
+let is_empty q = q.hd = [] && q.tl = []
+
+let push q x = {q with tl = x :: q.tl; }
+
+let rec list_last l = match l with
+  | [] -> assert false
+  | [x] -> x
+  | _::l' -> list_last l'
+
+let peek q =
+  match q.hd, q.tl with
+  | [], [] -> raise (Invalid_argument "Queue.peek")
+  | [], _::_ ->
+    list_last q.tl
+  | x::_, _ -> x
+
+(* pop first element of the queue *)
+let pop q =
+  match q.hd, q.tl with
+  | [], [] -> raise (Invalid_argument "Queue.peek")
+  | [], _::_ ->
+    (match List.rev q.tl with
+      | x::hd -> x, { hd; tl=[]; }
+      | [] -> assert false)
+  | x::_, _ ->
+    let q' = {hd=List.tl q.hd; tl=q.tl; } in
+    x, q'
+
+let junk q = snd (pop q)
+
+(** Append two queues. Elements from the second one come
+    after elements of the first one *)
+let append q1 q2 =
+  { hd=q1.hd;
+    tl=q2.tl @ (List.rev_append q2.hd q1.tl);
+  }
+
+let size q = List.length q.hd + List.length q.tl
+
+let fold f acc q =
+  let acc' = List.fold_left f acc q.hd in
+  List.fold_right (fun x acc -> f acc x) q.tl acc'
+
+let iter f q = fold (fun () x -> f x) () q
+
+let to_seq q = fun k -> iter k q
+
+let of_seq seq = Sequence.fold push empty seq

fQueue.mli

@@ -0,0 +1,61 @@
+(*
+Copyright (c) 2013, Simon Cruanes
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+Redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  Redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+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.
+*)
+
+(** {1 Functional queues (fifo)} *)
+
+type 'a t
+  (** Queue containing elements of type 'a *)
+
+val empty : 'a t
+
+val is_empty : 'a t -> bool
+
+val push : 'a t -> 'a -> 'a t
+  (** Push element at the end of the queue *)
+
+val peek : 'a t -> 'a
+  (** Get first element, or raise Invalid_argument *)
+
+val pop : 'a t -> 'a * 'a t
+  (** Get and remove the first element, or raise Invalid_argument *)
+
+val junk : 'a t -> 'a t
+  (** Remove first element. If queue is empty, do nothing. *)
+
+val append : 'a t -> 'a t -> 'a t
+  (** Append two queues. Elements from the second one come
+      after elements of the first one *)
+
+val size : 'a t -> int
+  (** Number of elements in the queue (linear in time) *)
+
+val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
+
+val iter : ('a -> unit) -> 'a t -> unit
+
+val to_seq : 'a t -> 'a Sequence.t
+
+val of_seq : 'a Sequence.t -> 'a t
+

tests/test_fQueue.ml

@@ -0,0 +1,44 @@
+
+open OUnit
+
+let test_empty () =
+  let q = FQueue.empty in
+  OUnit.assert_bool "is_empty" (FQueue.is_empty q)
+
+let test_push () =
+  let q = List.fold_left FQueue.push FQueue.empty [1;2;3;4;5] in
+  let q = FQueue.junk q in
+  let q = List.fold_left FQueue.push q [6;7;8] in
+  let l = Sequence.to_list (FQueue.to_seq q) in
+  OUnit.assert_equal [2;3;4;5;6;7;8] l
+
+let test_pop () =
+  let q = FQueue.of_seq (Sequence.of_list [1;2;3;4]) in
+  let x, q = FQueue.pop q in
+  OUnit.assert_equal 1 x;
+  let q = List.fold_left FQueue.push q [5;6;7] in
+  OUnit.assert_equal 2 (FQueue.peek q);
+  let x, q = FQueue.pop q in
+  OUnit.assert_equal 2 x;
+  ()
+
+let test_append () =
+  let q1 = FQueue.of_seq (Sequence.of_list [1;2;3;4]) in 
+  let q2 = FQueue.of_seq (Sequence.of_list [5;6;7;8]) in 
+  let q = FQueue.append q1 q2 in
+  let l = Sequence.to_list (FQueue.to_seq q) in
+  OUnit.assert_equal [1;2;3;4;5;6;7;8] l
+
+let test_fold () =
+  let q = FQueue.of_seq (Sequence.of_list [1;2;3;4]) in
+  let n = FQueue.fold (+) 0 q in
+  OUnit.assert_equal 10 n;
+  ()
+
+let suite =
+  "test_pQueue" >:::
+    [ "test_empty" >:: test_empty;
+      "test_push" >:: test_push;
+      "test_pop" >:: test_pop;
+      "test_fold" >:: test_fold;
+    ]

tests/tests.ml

@@ -6,6 +6,7 @@ let suite =
   "all_tests" >:::
     [ Test_pHashtbl.suite;
       Test_fHashtbl.suite;
+      Test_fQueue.suite;
       Test_flatHashtbl.suite;
       Test_heap.suite;
       Test_graph.suite;