From 37be810bbf1bd913402a5996057971268339dc79 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 28 Aug 2013 15:03:05 +0200 Subject: [PATCH] updated version of Sequence --- sequence.ml | 44 +++++++++++++++++++++++++++++++++++----- sequence.mli | 57 ++++++++++++++++++++++++++++++++++++++-------------- smallSet.mli | 2 +- 3 files changed, 82 insertions(+), 21 deletions(-) diff --git a/sequence.ml b/sequence.ml index b6cf53d9..cf7d1a50 100644 --- a/sequence.ml +++ b/sequence.ml @@ -23,7 +23,7 @@ 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 Transient iterators, that abstract on a finite sequence of elements. *) +(** {1 Transient iterators, that abstract on a finite sequence of elements.} *) (** Sequence abstract iterator type *) type 'a t = ('a -> unit) -> unit @@ -36,6 +36,16 @@ 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 empty = fun k -> () let singleton x = fun k -> k x @@ -111,16 +121,26 @@ let concat s = 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 initial sequence, and calls [concat]. *) let flatMap f seq = from_iter (fun k -> seq (fun x -> (f x) k)) -(** Insert the second element between every element of the sequence *) -let intersperse seq elem = +let fmap f seq = from_iter - (fun k -> seq (fun x -> k x; k elem)) + (fun k -> + seq (fun x -> match f x with + | None -> () + | Some y -> k y)) + +(** 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) (** Mutable unrolled list to serve as intermediate storage *) module MList = struct @@ -173,7 +193,9 @@ module MList = struct let rec push x l = if l.len = Array.length l.content then begin (* insert in the next block *) - (if l.tl == _empty () then l.tl <- make (Array.length l.content)); + (if l.tl == _empty () then + let n = Array.length l.content in + l.tl <- make (n + n lsr 1)); push x l.tl end else begin (* insert in l *) l.content.(l.len) <- x; @@ -263,6 +285,18 @@ let product outer inner = outer (fun x -> 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] *) + (** [unfoldr f b] will apply [f] to [b]. If it yields [Some (x,b')] then [x] is returned and unfoldr recurses with [b']. *) diff --git a/sequence.mli b/sequence.mli index 2653ff6f..c6602b01 100644 --- a/sequence.mli +++ b/sequence.mli @@ -11,21 +11,32 @@ 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. +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. *) -(** Transient iterators, that abstract on a finite sequence of elements. They - are designed to allow easy transfer (mappings) between data structures, - without defining n^2 conversions between the n types. *) +(** {1 Transient iterators, that abstract on a finite sequence of elements.} *) + +(** The iterators are designed to allow easy transfer (mappings) between data + structures, without defining n^2 conversions between the n types. The + implementation relies on the assumption that a sequence can be iterated + on as many times as needed; this choice allows for high performance + of many combinators. However, for transient iterators, the {!persistent} + function is provided, storing elements of a transient iterator + in memory; the iterator can then be used several times. + + Note that some combinators also return sequences (e.g. {!group}). The + transformation is computed on the fly every time one iterates over + the resulting sequence. If a transformation performs heavy computation, + {!persistent} can also be used as intermediate storage. *) type +'a t = ('a -> unit) -> unit (** Sequence abstract iterator type, representing a finite sequence of @@ -41,6 +52,10 @@ type (+'a, +'b) t2 = ('a -> 'b -> unit) -> unit val from_iter : (('a -> unit) -> unit) -> 'a t (** Build a sequence from a iter function *) +val from_fun : (unit -> 'a option) -> 'a t + (** Call the function repeatedly until it returns None. This + sequence is transient, use {!persistent} if needed! *) + val empty : 'a t (** Empty sequence *) @@ -103,11 +118,17 @@ val append : 'a t -> 'a t -> 'a t val concat : 'a t t -> 'a t (** Concatenate a sequence of sequences into one sequence *) +val flatten : 'a t t -> 'a t + (** Alias for {!concat} *) + val flatMap : ('a -> 'b t) -> 'a t -> 'b t (** Monadic bind. It applies the function to every element of the initial sequence, and calls [concat]. *) -val intersperse : 'a t -> 'a -> 'a t +val fmap : ('a -> 'b option) -> 'a t -> 'b t + (** Specialized version of {!flatMap} for options. *) + +val intersperse : 'a -> 'a t -> 'a t (** Insert the second element between every element of the sequence *) val persistent : 'a t -> 'a t @@ -132,6 +153,12 @@ val product : 'a t -> 'b t -> ('a * 'b) t by calling [persistent] on it, so that it can be traversed several times (outer loop of the product) *) +val join : join_row:('a -> 'b -> 'c option) -> 'a t -> 'b t -> 'c t + (** [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. *) + val unfoldr : ('b -> ('a * 'b) option) -> 'b -> 'a t (** [unfoldr f b] will apply [f] to [b]. If it yields [Some (x,b')] then [x] is returned @@ -246,7 +273,7 @@ val hashtbl_keys : ('a, 'b) Hashtbl.t -> 'a t val hashtbl_values : ('a, 'b) Hashtbl.t -> 'b t val of_str : string -> char t -val to_str : char t -> string +val to_str : char t -> string val of_in_channel : in_channel -> char t val to_buffer : char t -> Buffer.t -> unit diff --git a/smallSet.mli b/smallSet.mli index 0176f4cd..79a9239b 100644 --- a/smallSet.mli +++ b/smallSet.mli @@ -35,7 +35,7 @@ type 'a t val empty : cmp:('a -> 'a -> int) -> 'a t (** Create an empty set *) -val is_empty : 'a t -> bool +val is_empty : _ t -> bool (** Is the set empty? *) val mem : 'a t -> 'a -> bool