diff --git a/sequence.ml b/sequence.ml index 5c0d129..410b508 100644 --- a/sequence.ml +++ b/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 - sequence is transient, use {!persistent} if needed! *) -let from_fun f = - fun k -> - let rec next () = - match f () with - | None -> () - | Some x -> (k x; next ()) - in next () +let rec from_fun f k = match f () with + | None -> () + | Some x -> k x; from_fun f k -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 = fun k -> while true do k x done +let repeat x k = while true do k x done -(** [iterate f x] is the infinite sequence (x, f(x), f(f(x)), ...) *) -let iterate f x = - let rec iterate k x = k x; iterate k (f x) in - from_iter (fun k -> iterate k x) +let rec iterate f x k = + k x; + iterate f (f x) k -(** Sequence that calls the given function to produce elements *) -let forever f = - let rec forever k = k (f ()); forever k in - from_iter forever +let rec forever f k = + k (f ()); + forever f k -(** Cycle forever through the given sequence. O(n). *) -let cycle s = fun k -> while true do s k; done +let cycle s 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 = - f !r x; - incr r - in seq k + seq + (fun x -> + f !r x; + 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 -> - r := f !r !i elt; - incr i); + seq + (fun elt -> + r := f !r !i elt; + incr i); !r -(** Map objects of the sequence into other elements, lazily *) -let map f seq = - let seq_fun' k = seq (fun x -> k (f x)) in - seq_fun' +let map f seq k = seq (fun x -> k (f x)) -(** Map objects, along with their index in the sequence *) -let mapi f seq = - let seq_fun' k = - let i = ref 0 in - seq (fun x -> k (f !i x); incr i) in - seq_fun' +let mapi f seq k = + let i = ref 0 in + seq (fun x -> k (f !i x); incr i) -(** Filter on elements of the sequence *) -let filter p seq = - let seq_fun' k = seq (fun x -> if p x then k x) in - seq_fun' +let filter p seq k = seq (fun x -> if p x then k x) -(** Append two sequences *) -let append s1 s2 = - let seq_fun k = s1 k; s2 k in - seq_fun +let append s1 s2 k = s1 k; s2 k -(** Concatenate a sequence of sequences into one sequence *) -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 concat s k = s (fun s' -> s' k) let flatten s = concat s -(** Monadic bind. It applies the function to every element of the - initial sequence, and calls [concat]. *) -let flatMap f seq = - from_iter - (fun k -> seq (fun x -> (f x) k)) +let flatMap f seq k = seq (fun x -> f x k) let flat_map = flatMap -let fmap f seq = - from_iter - (fun k -> - seq (fun x -> match f x with - | None -> () - | Some y -> k y)) +let fmap f seq k = + seq (fun x -> match f x with + | None -> () + | Some y -> k y + ) let filter_map = fmap -(** Insert the given element between every element of the sequence *) -let intersperse elem seq = - fun k -> - let first = ref true in - seq (fun x -> (if !first then first := false else k elem); k x) +let intersperse elem seq k = + 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 = - fun k -> - let cur = ref [] in - seq (fun x -> - match !cur with - | [] -> cur := [x] - | (y::_) as l when eq x y -> - cur := x::l (* [x] belongs to the group *) - | (_::_) as l -> - k l; (* yield group, and start another one *) - cur := [x]); - (* last list *) - if !cur <> [] then k !cur +let group ?(eq=fun x y -> x = y) seq k = + let cur = ref [] in + seq (fun x -> + match !cur with + | [] -> cur := [x] + | (y::_) as l when eq x y -> + cur := x::l (* [x] belongs to the group *) + | (_::_) as l -> + k l; (* yield group, and start another one *) + cur := [x]); + (* last list *) + if !cur <> [] then k !cur -(** Remove consecutive duplicate elements. Basically this is - like [fun seq -> map List.hd (group seq)]. *) -let uniq ?(eq=fun x y -> x = y) seq = - fun k -> - let has_prev = ref false - and prev = ref (Obj.magic 0) in (* avoid option type, costly *) - seq (fun x -> - if !has_prev && eq !prev x - then () (* duplicate *) - else begin - has_prev := true; - prev := x; - k x - end) +let uniq ?(eq=fun x y -> x = y) seq k = + let has_prev = ref false + and prev = ref (Obj.magic 0) in (* avoid option type, costly *) + seq (fun x -> + if !has_prev && eq !prev x + then () (* duplicate *) + else begin + has_prev := true; + prev := x; + k x + end) -(** Sort the sequence and remove duplicates. Eager, same as [sort] *) -let sort_uniq ?(cmp=Pervasives.compare) seq = - let seq' = sort ~cmp seq in - uniq ~eq:(fun x y -> cmp x y = 0) seq' +let sort_uniq (type elt) ?(cmp=Pervasives.compare) seq = + let module S = Set.Make(struct + type t = elt + 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 - element of [b] using [join_row]. If [join_row] returns None, then - the two elements do not combine. Assume that [b] allows for multiple - iterations. *) -let join ~join_row s1 s2 = - fun k -> - s1 (fun a -> - s2 (fun b -> - match join_row a b with - | None -> () - | Some c -> k c)) (* yield the combination of [a] and [b] *) +let join ~join_row s1 s2 k = + s1 (fun a -> + s2 (fun 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 - yields [Some (x,b')] then [x] is returned - and unfoldr recurses with [b']. *) -let unfoldr f b = - let rec unfold k b = match f b with - | None -> () - | Some (x, b') -> k x; unfold k b' - in - from_iter (fun k -> unfold k b) +let rec unfoldr f b k = match f b with + | None -> () + | Some (x, b') -> + k x; + unfoldr f b' k -(** Sequence of intermediate results *) -let scan f acc seq = - from_iter - (fun k -> - k acc; - let acc = ref acc in - seq (fun elt -> let acc' = f !acc elt in k acc'; acc := acc')) +let scan f acc seq k = + 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 = +let take n seq k = let count = ref 0 in - if n = 0 then empty - else fun k -> - try - seq (fun x -> - incr count; - k x; - if !count = n then raise ExitSequence) - with ExitSequence -> () + try + seq (fun x -> + incr count; + k x; + if !count = n then raise 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 = +let drop n seq k = let count = ref 0 in - fun k -> seq - (fun x -> if !count >= n then k x else incr count) + seq (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 = - fun k -> () +let empty2 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 = - fun k -> seq2 (fun x y -> k (x,y)) +let zip seq2 k = seq2 (fun x y -> k (x,y)) -let unzip seq = - fun k -> seq (fun (x,y) -> k x y) +let unzip seq k = seq (fun (x,y) -> k x y) -(** Zip elements of the sequence with their index in the sequence *) -let zip_i seq = - fun k -> - let r = ref 0 in - seq (fun x -> let n = !r in incr r; k n x) +let zip_i seq k = + 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 = - seq2 f +let iter2 f seq2 = seq2 f -let map2 f seq2 = - fun k -> seq2 (fun x y -> k (f x y)) +let map2 f seq2 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 = - fun k -> seq2 (fun x y -> k (f x y) (g x y)) +let map2_2 f g seq2 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 = - fun k -> - for i = 0 to Array.length a - 1 do - k (Array.unsafe_get a i) - done +let of_array a k = + for i = 0 to Array.length a - 1 do + k (Array.unsafe_get a i) + done -let of_array_i a = - fun k -> - for i = 0 to Array.length a - 1 do - k (i, Array.unsafe_get a i) - done +let of_array_i a k = + for i = 0 to Array.length a - 1 do + k (i, Array.unsafe_get a i) + done -let of_array2 a = - fun k -> - for i = 0 to Array.length a - 1 do - k i (Array.unsafe_get a i) - done +let of_array2 a k = + for i = 0 to Array.length a - 1 do + k i (Array.unsafe_get a i) + done -(** [array_slice a i j] Sequence of elements whose indexes range - from [i] to [j] *) -let array_slice a i j = +let array_slice a i j k = assert (i >= 0 && j < Array.length a); - fun k -> - for idx = i to j do - k a.(idx); (* iterate on sub-array *) - done + for idx = i to j do + k a.(idx); (* iterate on sub-array *) + done -(** Sequence of elements of a stream (usable only once) *) -let of_stream s = - let seq k = Stream.iter k s in - from_iter seq +let of_stream s k = Stream.iter k s -(** 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 = from_iter (fun k -> Stack.iter k s) +let of_stack s k = Stack.iter k s -(** Push elements of the sequence into the queue *) -let to_queue q seq = iter (fun x -> Queue.push x q) seq +let to_queue q seq = seq (fun x -> Queue.push x q) -(** Sequence of elements contained in the queue, FIFO order *) -let of_queue q = from_iter (fun k -> Queue.iter k q) +let of_queue q 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 = - from_iter (fun k -> Hashtbl.iter (fun a b -> k (a, b)) h) +let of_hashtbl h k = Hashtbl.iter (fun a b -> k (a, b)) h -let of_hashtbl2 h = - fun k -> Hashtbl.iter k h +let of_hashtbl2 h k = Hashtbl.iter k h -let hashtbl_keys h = - from_iter (fun k -> Hashtbl.iter (fun a b -> k a) h) +let hashtbl_keys h k = Hashtbl.iter (fun a b -> k a) h -let hashtbl_values h = - from_iter (fun k -> Hashtbl.iter (fun a b -> k b) h) +let hashtbl_values h 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 = - from_iter (fun k -> - try while true do - let c = input_char ic in k c - done with End_of_file -> ()) +exception OneShotSequence + +let of_in_channel ic = + let first = ref true in + 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 = - fun k -> - for i = start to stop do k i done +let int_range ~start ~stop k = + for i = start to stop do k i done -let int_range_dec ~start ~stop = - fun k -> - for i = start downto stop do k i done +let int_range_dec ~start ~stop k = + 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 = +let random_array a k = assert (Array.length a > 0); - let seq k = - while true do - let i = Random.int (Array.length a) in - k a.(i); - done in - from_iter seq + while true do + let i = Random.int (Array.length a) in + k a.(i); + done 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 diff --git a/sequence.mli b/sequence.mli index f822a0a..f130335 100644 --- a/sequence.mli +++ b/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