code cleaning;

exception raised in of_in_channel upon second iteration

sequence.ml

@@ -36,17 +36,11 @@ type (+'a, +'b) t2 = ('a -> 'b -> unit) -> unit
 (** Build a sequence from a iter function *)
 let from_iter f = f
 
-(** Call the function repeatedly until it returns None. This
+let rec from_fun f k = match f () with
-    sequence is transient, use {!persistent} if needed! *)
+  | None -> ()
-let from_fun f =
+  | Some x -> k x; from_fun f k
-  fun k ->
-    let rec next () =
-      match f () with
-      | None -> ()
-      | Some x -> (k x; next ())
-    in next ()
 
-let empty = fun k -> ()
+let empty k = ()
 
 let singleton x k = k x
 let return x k = k x
@@ -57,101 +51,70 @@ let doubleton x y k = k x; k y
 let cons x l k = k x; l k
 let snoc l x k = l k; k x
 
-(** Infinite sequence of the same element *)
+let repeat x k = while true do k x done
-let repeat x = fun k -> while true do k x done
 
-(** [iterate f x] is the infinite sequence (x, f(x), f(f(x)), ...) *)
+let rec iterate f x k =
-let iterate f x =
+  k x;
-  let rec iterate k x = k x; iterate k (f x) in
+  iterate f (f x) k
-  from_iter (fun k -> iterate k x)
 
-(** Sequence that calls the given function to produce elements *)
+let rec forever f k =
-let forever f =
+  k (f ());
-  let rec forever k = k (f ()); forever k in
+  forever f k
-  from_iter forever
 
-(** Cycle forever through the given sequence. O(n). *)
+let cycle s k = while true do s k; done
-let cycle s = fun k -> while true do s k; done
 
-(** Consume the sequence, passing all its arguments to the function *)
 let iter f seq = seq f
 
-(** Iterate on elements and their index in the sequence *)
 let iteri f seq =
   let r = ref 0 in
-  let k x =
+  seq
-    f !r x;
+    (fun x ->
-    incr r
+      f !r x;
-  in seq k
+      incr r)
 
-(** Fold over elements of the sequence, consuming it *)
 let fold f init seq =
   let r = ref init in
   seq (fun elt -> r := f !r elt);
   !r
 
-(** Fold over elements of the sequence and their index, consuming it *)
 let foldi f init seq =
   let i = ref 0 in
   let r = ref init in
-  seq (fun elt ->
+  seq
-    r := f !r !i elt;
+    (fun elt ->
-    incr i);
+      r := f !r !i elt;
+      incr i);
   !r
 
-(** Map objects of the sequence into other elements, lazily *)
+let map f seq k = seq (fun x -> k (f x))
-let map f seq =
-  let seq_fun' k = seq (fun x -> k (f x)) in
-  seq_fun'
 
-(** Map objects, along with their index in the sequence *)
+let mapi f seq k =
-let mapi f seq =
+  let i = ref 0 in
-  let seq_fun' k =
+  seq (fun x -> k (f !i x); incr i)
-    let i = ref 0 in
-    seq (fun x -> k (f !i x); incr i) in
-  seq_fun'
 
-(** Filter on elements of the sequence *)
+let filter p seq k = seq (fun x -> if p x then k x)
-let filter p seq =
-  let seq_fun' k = seq (fun x -> if p x then k x) in
-  seq_fun'
 
-(** Append two sequences *)
+let append s1 s2 k = s1 k; s2 k
-let append s1 s2 =
-  let seq_fun k = s1 k; s2 k in
-  seq_fun
 
-(** Concatenate a sequence of sequences into one sequence *)
+let concat s k = s (fun s' -> s' k)
-let concat s =
-  from_iter (fun k ->
-    (* function that is called on every sub-sequence *)
-    let k_seq seq = iter k seq in
-    s k_seq)
 
 let flatten s = concat s
 
-(** Monadic bind. It applies the function to every element of the
+let flatMap f seq k = seq (fun x -> f x k)
-    initial sequence, and calls [concat]. *)
-let flatMap f seq =
-  from_iter
-    (fun k -> seq (fun x -> (f x) k))
 
 let flat_map = flatMap
 
-let fmap f seq =
+let fmap f seq k =
-  from_iter
+  seq (fun x -> match f x with
-    (fun k ->
+      | None -> ()
-      seq (fun x -> match f x with
+      | Some y -> k y
-          | None -> ()
+      )
-          | Some y -> k y))
 
 let filter_map = fmap
 
-(** Insert the given element between every element of the sequence *)
+let intersperse elem seq k =
-let intersperse elem seq =
+  let first = ref true in
-  fun k ->
+  seq (fun x -> (if !first then first := false else k elem); k x)
-    let first = ref true in
-    seq (fun x -> (if !first then first := false else k elem); k x)
 
 (** Mutable unrolled list to serve as intermediate storage *)
 module MList = struct
@@ -255,8 +218,6 @@ module MList = struct
     in make (l,0)
 end
 
-(** Iterate on the sequence, storing elements in a data structure.
-    The resulting sequence can be iterated on as many times as needed. *)
 let persistent seq =
   let l = MList.of_seq seq in
   MList.to_seq l
@@ -275,49 +236,45 @@ let persistent_lazy (seq:'a t) =
         let seq' = MList.of_seq_with seq k in
         r := LazyCached (MList.to_seq seq')
 
-(** Sort the sequence. Eager, O(n) ram and O(n ln(n)) time. *)
 let sort ?(cmp=Pervasives.compare) seq =
   (* use an intermediate list, then sort the list *)
   let l = fold (fun l x -> x::l) [] seq in
   let l = List.fast_sort cmp l in
   fun k -> List.iter k l
 
-(** Group equal consecutive elements. *)
+let group ?(eq=fun x y -> x = y) seq k =
-let group ?(eq=fun x y -> x = y) seq =
+  let cur = ref [] in
-  fun k ->
+  seq (fun x ->
-    let cur = ref [] in
+    match !cur with
-    seq (fun x ->
+    | [] -> cur := [x]
-      match !cur with
+    | (y::_) as l when eq x y ->
-      | [] -> cur := [x]
+      cur := x::l  (* [x] belongs to the group *)
-      | (y::_) as l when eq x y ->
+    | (_::_) as l ->
-        cur := x::l  (* [x] belongs to the group *)
+      k l; (* yield group, and start another one *)
-      | (_::_) as l ->
+      cur := [x]);
-        k l; (* yield group, and start another one *)
+  (* last list *)
-        cur := [x]);
+  if !cur <> [] then k !cur
-    (* last list *)
-    if !cur <> [] then k !cur
 
-(** Remove consecutive duplicate elements. Basically this is
+let uniq ?(eq=fun x y -> x = y) seq k =
-    like [fun seq -> map List.hd (group seq)]. *)
+  let has_prev = ref false
-let uniq ?(eq=fun x y -> x = y) seq =
+  and prev = ref (Obj.magic 0) in  (* avoid option type, costly *)
-  fun k ->
+  seq (fun x ->
-    let has_prev = ref false
+    if !has_prev && eq !prev x
-    and prev = ref (Obj.magic 0) in  (* avoid option type, costly *)
+      then ()  (* duplicate *)
-    seq (fun x ->
+      else begin
-      if !has_prev && eq !prev x
+        has_prev := true;
-        then ()  (* duplicate *)
+        prev := x;
-        else begin
+        k x
-          has_prev := true;
+      end)
-          prev := x;
-          k x
-        end)
 
-(** Sort the sequence and remove duplicates. Eager, same as [sort] *)
+let sort_uniq (type elt) ?(cmp=Pervasives.compare) seq =
-let sort_uniq ?(cmp=Pervasives.compare) seq =
+  let module S = Set.Make(struct
-  let seq' = sort ~cmp seq in
+    type t = elt
-  uniq ~eq:(fun x y -> cmp x y = 0) seq'
+    let compare = cmp
+  end) in
+  let set = fold (fun acc x -> S.add x acc) S.empty seq in
+  fun k -> S.iter k set
 
-(** Cartesian product of the sequences. *)
 let product outer inner k =
   outer (fun x ->
     inner (fun y -> k (x,y))
@@ -328,35 +285,25 @@ let product2 outer inner k =
     inner (fun y -> k x y)
   )
 
-(** [join ~join_row a b] combines every element of [a] with every
+let join ~join_row s1 s2 k =
-    element of [b] using [join_row]. If [join_row] returns None, then
+  s1 (fun a ->
-    the two elements do not combine. Assume that [b] allows for multiple
+    s2 (fun b ->
-    iterations. *)
+      match join_row a b with
-let join ~join_row s1 s2 =
+      | None -> ()
-  fun k ->
+      | Some c -> k c
-    s1 (fun a ->
+      )
-      s2 (fun b ->
+    )  (* yield the combination of [a] and [b] *)
-        match join_row a b with
-        | None -> ()
-        | Some c -> k c))  (* yield the combination of [a] and [b] *)
 
-(** [unfoldr f b] will apply [f] to [b]. If it
+let rec unfoldr f b k = match f b with
-    yields [Some (x,b')] then [x] is returned
+  | None -> ()
-    and unfoldr recurses with [b']. *)
+  | Some (x, b') ->
-let unfoldr f b =
+      k x;
-  let rec unfold k b = match f b with
+      unfoldr f b' k
-    | None -> ()
-    | Some (x, b') -> k x; unfold k b'
-  in
-  from_iter (fun k -> unfold k b)
 
-(** Sequence of intermediate results *)
+let scan f acc seq k =
-let scan f acc seq =
+  k acc;
-  from_iter
+  let acc = ref acc in
-    (fun k ->
+  seq (fun elt -> let acc' = f !acc elt in k acc'; acc := acc')
-      k acc;
-      let acc = ref acc in
-      seq (fun elt -> let acc' = f !acc elt in k acc'; acc := acc'))
 
 let max ?(lt=fun x y -> x < y) seq =
   let ret = ref None in
@@ -374,28 +321,24 @@ let min ?(lt=fun x y -> x < y) seq =
 
 exception ExitSequence
 
-(** Take at most [n] elements from the sequence *)
+let take n seq k =
-let take n seq =
   let count = ref 0 in
-  if n = 0 then empty
+  try
-    else fun k ->
+    seq (fun x ->
-      try
+      incr count;
-        seq (fun x ->
+      k x;
-          incr count;
+      if !count = n then raise ExitSequence
-          k x;
+    )
-          if !count = n then raise ExitSequence)
+  with ExitSequence -> ()
-      with ExitSequence -> ()
 
 let take_while p seq k =
   try
     seq (fun x -> if p x then k x else raise ExitSequence)
   with ExitSequence -> ()
 
-(** Drop the [n] first elements of the sequence *)
+let drop n seq k =
-let drop n seq =
   let count = ref 0 in
-  fun k -> seq
+  seq (fun x -> if !count >= n then k x else incr count)
-    (fun x -> if !count >= n then k x else incr count)
 
 let drop_while p seq k =
   let drop = ref true in
@@ -404,12 +347,10 @@ let drop_while p seq k =
     then if p x then () else (drop := false; k x)
     else k x)
 
-(** Reverse the sequence. O(n) memory. *)
 let rev seq =
   let l = MList.of_seq seq in
-  from_iter (fun k -> MList.iter_rev k l)
+  fun k -> MList.iter_rev k l
 
-(** Do all elements satisfy the predicate? *)
 let for_all p seq =
   try
     seq (fun x -> if not (p x) then raise ExitSequence);
@@ -436,21 +377,18 @@ let find f seq =
   end;
   !r
 
-(** How long is the sequence? *)
 let length seq =
   let r = ref 0 in
   seq (fun _ -> incr r);
   !r
 
-(** Is the sequence empty? *)
 let is_empty seq =
   try seq (fun _ -> raise ExitSequence); true
   with ExitSequence -> false
 
 (** {2 Transform a sequence} *)
 
-let empty2 =
+let empty2 k = ()
-  fun k -> ()
 
 let is_empty2 seq2 =
   try ignore (seq2 (fun _ _ -> raise ExitSequence)); true
@@ -461,32 +399,25 @@ let length2 seq2 =
   seq2 (fun _ _ -> incr r);
   !r
 
-let zip seq2 =
+let zip seq2 k = seq2 (fun x y -> k (x,y))
-  fun k -> seq2 (fun x y -> k (x,y))
 
-let unzip seq =
+let unzip seq k = seq (fun (x,y) -> k x y)
-  fun k -> seq (fun (x,y) -> k x y)
 
-(** Zip elements of the sequence with their index in the sequence *)
+let zip_i seq k =
-let zip_i seq =
+  let r = ref 0 in
-  fun k ->
+  seq (fun x -> let n = !r in incr r; k n x)
-    let r = ref 0 in
-    seq (fun x -> let n = !r in incr r; k n x)
 
 let fold2 f acc seq2 =
   let acc = ref acc in
   seq2 (fun x y -> acc := f !acc x y);
   !acc
 
-let iter2 f seq2 =
+let iter2 f seq2 = seq2 f
-  seq2 f
 
-let map2 f seq2 =
+let map2 f seq2 k = seq2 (fun x y -> k (f x y))
-  fun k -> seq2 (fun x y -> k (f x y))
 
-(** [map2_2 f g seq2] maps each [x, y] of seq2 into [f x y, g x y] *)
+let map2_2 f g seq2 k =
-let map2_2 f g seq2 =
+  seq2 (fun x y -> k (f x y) (g x y))
-  fun k -> seq2 (fun x y -> k (f x y) (g x y))
 
 (** {2 Basic data structures converters} *)
 
@@ -494,7 +425,7 @@ let to_list seq = List.rev (fold (fun y x -> x::y) [] seq)
 
 let to_rev_list seq = fold (fun y x -> x :: y) [] seq
 
-let of_list l = from_iter (fun k -> List.iter k l)
+let of_list l k = List.iter k l
 
 let to_array seq =
   let l = MList.of_seq seq in
@@ -507,60 +438,46 @@ let to_array seq =
       a
     end
 
-let of_array a =
+let of_array a k =
-  fun k ->
+  for i = 0 to Array.length a - 1 do
-    for i = 0 to Array.length a - 1 do
+    k (Array.unsafe_get a i)
-      k (Array.unsafe_get a i)
+  done
-    done
 
-let of_array_i a =
+let of_array_i a k =
-  fun k ->
+  for i = 0 to Array.length a - 1 do
-    for i = 0 to Array.length a - 1 do
+    k (i, Array.unsafe_get a i)
-      k (i, Array.unsafe_get a i)
+  done
-    done
 
-let of_array2 a =
+let of_array2 a k =
-  fun k ->
+  for i = 0 to Array.length a - 1 do
-    for i = 0 to Array.length a - 1 do
+    k i (Array.unsafe_get a i)
-      k i (Array.unsafe_get a i)
+  done
-    done
 
-(** [array_slice a i j] Sequence of elements whose indexes range
+let array_slice a i j k =
-    from [i] to [j] *)
-let array_slice a i j =
   assert (i >= 0 && j < Array.length a);
-  fun k ->
+  for idx = i to j do
-    for idx = i to j do
+    k a.(idx);  (* iterate on sub-array *)
-      k a.(idx);  (* iterate on sub-array *)
+  done
-    done
 
-(** Sequence of elements of a stream (usable only once) *)
+let of_stream s k = Stream.iter k s
-let of_stream s =
-  let seq k = Stream.iter k s in
-  from_iter seq
 
-(** Convert to a stream. The sequence is made persistent. *)
 let to_stream seq =
   let l = MList.of_seq seq in
   MList.to_stream l
 
-(** Push elements of the sequence on the stack *)
 let to_stack s seq = iter (fun x -> Stack.push x s) seq
 
-(** Sequence of elements of the stack (same order as [Stack.iter]) *)
+let of_stack s k = Stack.iter k s
-let of_stack s = from_iter (fun k -> Stack.iter k s)
 
-(** Push elements of the sequence into the queue *)
+let to_queue q seq = seq (fun x -> Queue.push x q)
-let to_queue q seq = iter (fun x -> Queue.push x q) seq
 
-(** Sequence of elements contained in the queue, FIFO order *)
+let of_queue q k = Queue.iter k q
-let of_queue q = from_iter (fun k -> Queue.iter k q)
 
 let hashtbl_add h seq =
-  iter (fun (k,v) -> Hashtbl.add h k v) seq
+  seq (fun (k,v) -> Hashtbl.add h k v)
 
 let hashtbl_replace h seq =
-  iter (fun (k,v) -> Hashtbl.replace h k v) seq
+  seq (fun (k,v) -> Hashtbl.replace h k v)
 
 let to_hashtbl seq =
   let h = Hashtbl.create 3 in
@@ -572,19 +489,15 @@ let to_hashtbl2 seq2 =
   seq2 (fun k v -> Hashtbl.replace h k v);
   h
 
-let of_hashtbl h =
+let of_hashtbl h k = Hashtbl.iter (fun a b -> k (a, b)) h
-  from_iter (fun k -> Hashtbl.iter (fun a b -> k (a, b)) h)
 
-let of_hashtbl2 h =
+let of_hashtbl2 h k = Hashtbl.iter k h
-  fun k -> Hashtbl.iter k h
 
-let hashtbl_keys h =
+let hashtbl_keys h k = Hashtbl.iter (fun a b -> k a) h
-  from_iter (fun k -> Hashtbl.iter (fun a b -> k a) h)
 
-let hashtbl_values h =
+let hashtbl_values h k = Hashtbl.iter (fun a b -> k b) h
-  from_iter (fun k -> Hashtbl.iter (fun a b -> k b) h)
 
-let of_str s = from_iter (fun k -> String.iter k s)
+let of_str s k = String.iter k s
 
 let to_str seq =
   let b = Buffer.create 64 in
@@ -596,32 +509,36 @@ let concat_str seq =
   iter (Buffer.add_string b) seq;
   Buffer.contents b
 
-let of_in_channel ic =
+exception OneShotSequence
-  from_iter (fun k ->
+
-    try while true do
+let of_in_channel ic =
-      let c = input_char ic in k c
+  let first = ref true in
-    done with End_of_file -> ())
+  fun k ->
+    if not !first
+    then raise OneShotSequence
+    else (
+      first := false;
+      try
+        while true do
+          let c = input_char ic in k c
+        done
+      with End_of_file -> ()
+    )
 
-(** Copy content of the sequence into the buffer *)
 let to_buffer seq buf =
-  iter (fun c -> Buffer.add_char buf c) seq
+  seq (fun c -> Buffer.add_char buf c)
 
 (** Iterator on integers in [start...stop] by steps 1 *)
-let int_range ~start ~stop =
+let int_range ~start ~stop k =
-  fun k ->
+  for i = start to stop do k i done
-    for i = start to stop do k i done
 
-let int_range_dec ~start ~stop =
+let int_range_dec ~start ~stop k =
-  fun k ->
+  for i = start downto stop do k i done
-    for i = start downto stop do k i done
 
-(** Convert the given set to a sequence. The set module must be provided. *)
 let of_set (type s) (type v) m set =
   let module S = (val m : Set.S with type t = s and type elt = v) in
-  from_iter
+  fun k -> S.iter k set
-    (fun k -> S.iter k set)
 
-(** Convert the sequence to a set, given the proper set module *)
 let to_set (type s) (type v) m seq =
   let module S = (val m : Set.S with type t = s and type elt = v) in
   fold
@@ -716,15 +633,12 @@ let random_bool = forever Random.bool
 
 let random_float bound = forever (fun () -> Random.float bound)
 
-(** Sequence of choices of an element in the array *)
+let random_array a k =
-let random_array a =
   assert (Array.length a > 0);
-  let seq k =
+  while true do
-    while true do
+    let i = Random.int (Array.length a) in
-      let i = Random.int (Array.length a) in
+    k a.(i);
-      k a.(i);
+  done
-    done in
-  from_iter seq
 
 let random_list l = random_array (Array.of_list l)
 
@@ -753,7 +667,7 @@ include Infix
     to print each elements. An optional separator string can be provided. *)
 let pp_seq ?(sep=", ") pp_elt formatter seq =
   let first = ref true in
-  iter
+  seq
     (fun x ->
       (if !first then first := false
         else begin
@@ -761,15 +675,13 @@ let pp_seq ?(sep=", ") pp_elt formatter seq =
           Format.pp_print_cut formatter ();
         end);
       pp_elt formatter x)
-    seq
 
 let pp_buf ?(sep=", ") pp_elt buf seq =
   let first = ref true in
-  iter
+  seq
     (fun x ->
       if !first then first := false else Buffer.add_string buf sep;
       pp_elt buf x)
-    seq
 
 let to_string ?sep pp_elt seq =
   let buf = Buffer.create 25 in

sequence.mli

@@ -371,6 +371,10 @@ val concat_str : string t -> string
       Also see {!intersperse} to add a separator.
       @since NEXT_VERSION *)
 
+exception OneShotSequence
+  (** Raised when the user tries to iterate several times on
+      a transient iterator *)
+
 val of_in_channel : in_channel -> char t
   (** Iterates on characters of the input (can block when one
       iterates over the sequence). If you need to iterate