update of FQueue with a richer, more consistent api

core/CCFQueue.ml

@@ -35,35 +35,42 @@ let empty = {
   tl = [];
 }
 
-let is_empty q = q.hd = [] && q.tl = []
+(* invariant: if hd=[], then tl=[] *)
+let _make hd tl = match hd with
+  | [] -> {hd=List.rev tl; tl=[] }
+  | _::_ -> {hd; tl; }
 
-let push q x = {q with tl = x :: q.tl; }
+let is_empty q = q.hd = []
 
-let rec list_last l = match l with
+let push x q = {q with tl = x :: q.tl; }
-  | [] -> assert false
-  | [x] -> x
-  | _::l' -> list_last l'
 
-let peek q =
+let snoc q x = push x 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 peek_exn q =
-let pop q =
+  match q.hd with
-  match q.hd, q.tl with
+  | [] -> assert (q.tl = []); raise (Invalid_argument "Queue.peek")
-  | [], [] -> raise (Invalid_argument "Queue.peek")
+  | x::_ -> x
-  | [], _::_ ->
+
-    (match List.rev q.tl with
+let peek q = match q.hd with
-      | x::hd -> x, { hd; tl=[]; }
+  | [] -> None
-      | [] -> assert false)
+  | x::_ -> Some x
-  | x::_, _ ->
+
-    let q' = {hd=List.tl q.hd; tl=q.tl; } in
+let pop_exn q =
+  match q.hd with
+  | [] -> assert (q.tl = []); raise (Invalid_argument "Queue.peek")
+  | x::hd' ->
+    let q' = _make hd' q.tl in
     x, q'
 
-let junk q = snd (pop q)
+let pop q =
+  try Some (pop_exn q)
+  with Invalid_argument _ -> None
+
+let junk q =
+  try
+    let _, q' = pop_exn q in
+    q'
+  with Invalid_argument _ -> q
 
 (** Append two queues. Elements from the second one come
     after elements of the first one *)
@@ -72,8 +79,12 @@ let append q1 q2 =
     tl=q2.tl @ (List.rev_append q2.hd q1.tl);
   }
 
+let map f q = { hd=List.map f q.hd; tl=List.map f q.tl; }
+
 let size q = List.length q.hd + List.length q.tl
 
+let (>|=) q f = map f q
+
 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'
@@ -86,5 +97,5 @@ let to_seq q = fun k -> iter k q
 
 let of_seq seq =
   let q = ref empty in
-  seq (fun x -> q := push !q x);
+  seq (fun x -> q := push x !q);
   !q

core/CCFQueue.mli

@@ -25,28 +25,45 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (** {1 Functional queues (fifo)} *)
 
-type 'a t
+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
+val push : 'a -> 'a t -> 'a t
 (** Push element at the end of the queue *)
 
-val peek : 'a t -> 'a
+val snoc : 'a t -> 'a -> 'a t
-  (** Get first element, or raise Invalid_argument *)
+(** Flip version of {!push} *)
 
-val pop : 'a t -> 'a * 'a t
+val peek : 'a t -> 'a option
-  (** Get and remove the first element, or raise Invalid_argument *)
+(** First element of the queue *)
+
+val peek_exn : 'a t -> 'a
+(** Same as {!peek} but
+    @raise Invalid_argument if the queue is empty *)
+
+val pop : 'a t -> ('a * 'a t) option
+(** Get and remove the first element *)
+
+val pop_exn : 'a t -> ('a * 'a t)
+(** Same as {!pop}, but fails on empty queues.
+    @raise Invalid_argument if the queue is empty *)
 
 val junk : 'a t -> 'a t
-  (** Remove first element. If queue is empty, do nothing. *)
+  (** Remove first element. If the 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 *)
+      after elements of the first one.
+      Linear in the size of the second queue. *)
+
+val map : ('a -> 'b) -> 'a t -> 'b t
+(** Map values *)
+
+val (>|=) : 'a t -> ('a -> 'b) -> 'b t
 
 val size : 'a t -> int
   (** Number of elements in the queue (linear in time) *)

tests/test_fQueue.ml

@@ -9,19 +9,19 @@ let test_empty () =
   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 = List.fold_left FQueue.snoc 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 q = List.fold_left FQueue.snoc 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
+  let x, q = FQueue.pop_exn q in
   OUnit.assert_equal 1 x;
-  let q = List.fold_left FQueue.push q [5;6;7] in
+  let q = List.fold_left FQueue.snoc q [5;6;7] in
-  OUnit.assert_equal 2 (FQueue.peek q);
+  OUnit.assert_equal 2 (FQueue.peek_exn q);
-  let x, q = FQueue.pop q in
+  let x, q = FQueue.pop_exn q in
   OUnit.assert_equal 2 x;
   ()