From 6ab612c0ac3a22baaaa21c3447fe994b1e8ad81a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 1 Oct 2014 11:38:14 +0200 Subject: [PATCH 1/8] version 0.4 backported from stable --- Makefile | 10 +++++++ _oasis | 8 +++--- core/CCArray.mli | 4 +-- core/CCFlatHashtbl.mli | 2 +- core/CCHashtbl.mli | 2 +- core/CCList.mli | 2 +- core/CCRandom.mli | 4 +-- core/CCSequence.mli | 56 +++++++++++++++++++------------------- core/CCSexp.mli | 2 +- pervasives/CCPervasives.ml | 2 +- 10 files changed, 51 insertions(+), 41 deletions(-) diff --git a/Makefile b/Makefile index 034451d3..796cd868 100644 --- a/Makefile +++ b/Makefile @@ -88,6 +88,9 @@ push-stable: git push origin git checkout master +clean-generated: + rm **/*.{mldylib,mlpack,mllib} myocamlbuild.ml -f + run-test: build qtest-build ./qtest_all.native ./run_tests.native @@ -97,4 +100,11 @@ test-all: run-test qtest tags: otags *.ml *.mli +VERSION=$(shell awk '/^Version:/ {print $$2}' _oasis) + +update_next_tag: + @echo "update version to $(VERSION)..." + sed -i "s/NEXT_VERSION/$(VERSION)/g" **/*.ml **/*.mli + sed -i "s/NEXT_RELEASE/$(VERSION)/g" **/*.ml **/*.mli + .PHONY: examples push_doc tags qtest diff --git a/_oasis b/_oasis index 68d67f76..db965bfb 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.4 Name: containers -Version: dev +Version: 0.4 Homepage: https://github.com/c-cube/ocaml-containers Authors: Simon Cruanes License: BSD-2-clause @@ -192,12 +192,12 @@ Executable test_lwt BuildDepends: containers,lwt,lwt.unix,oUnit,containers.lwt Executable test_threads - Path: tests/threads/ + Path: tests/lwt/ Install: false CompiledObject: best Build$: flag(tests) && flag(thread) - MainIs: test_future.ml - BuildDepends: containers,threads,oUnit,containers.thread + MainIs: test_Future.ml + BuildDepends: containers,threads,oUnit,containers.lwt Test all Command: make test-all diff --git a/core/CCArray.mli b/core/CCArray.mli index 78a0e40b..a162f28f 100644 --- a/core/CCArray.mli +++ b/core/CCArray.mli @@ -72,12 +72,12 @@ module type S = sig val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option (** Like {!find}, but also pass the index to the predicate function. - @since NEXT_RELEASE *) + @since 0.4 *) val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option (** [find p x] returns [Some (i,x)] where [x] is the [i]-th element of [l], and [p x] holds. Otherwise returns [None] - @since NEXT_RELEASE *) + @since 0.4 *) val lookup : ?cmp:'a ord -> 'a -> 'a t -> int option (** Lookup the index of some value in a sorted array. diff --git a/core/CCFlatHashtbl.mli b/core/CCFlatHashtbl.mli index 746e31b6..364ad024 100644 --- a/core/CCFlatHashtbl.mli +++ b/core/CCFlatHashtbl.mli @@ -30,7 +30,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. This module was previously named [CCHashtbl], but the name is now used for an extension of the standard library's hashtables. -@since NEXT_RELEASE *) +@since 0.4 *) type 'a sequence = ('a -> unit) -> unit diff --git a/core/CCHashtbl.mli b/core/CCHashtbl.mli index f160a609..5eb6acf1 100644 --- a/core/CCHashtbl.mli +++ b/core/CCHashtbl.mli @@ -27,7 +27,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (** {1 Extension to the standard Hashtbl} -@since NEXT_RELEASE *) +@since 0.4 *) type 'a sequence = ('a -> unit) -> unit type 'a eq = 'a -> 'a -> bool diff --git a/core/CCList.mli b/core/CCList.mli index 5cc53b90..65356855 100644 --- a/core/CCList.mli +++ b/core/CCList.mli @@ -95,7 +95,7 @@ val find : ('a -> 'b option) -> 'a t -> 'b option val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option (** Like {!find}, but also pass the index to the predicate function. - @since NEXT_RELEASE *) + @since 0.4 *) val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option (** [find p x] returns [Some (i,x)] where [x] is the [i]-th element of [l], diff --git a/core/CCRandom.mli b/core/CCRandom.mli index 77f28ab1..0e67c6d5 100644 --- a/core/CCRandom.mli +++ b/core/CCRandom.mli @@ -57,7 +57,7 @@ val delay : (unit -> 'a t) -> 'a t small_int >>= fun i -> return (name,i) ) ]} - @since NEXT_RELEASE + @since 0.4 *) val choose : 'a t list -> 'a option t @@ -79,7 +79,7 @@ val replicate : int -> 'a t -> 'a list t val list_seq : 'a t list -> 'a list t (** Build random lists from lists of random generators - @since NEXT_RELEASE *) + @since 0.4 *) val small_int : int t diff --git a/core/CCSequence.mli b/core/CCSequence.mli index a05a0c18..e036693b 100644 --- a/core/CCSequence.mli +++ b/core/CCSequence.mli @@ -78,25 +78,25 @@ val singleton : 'a -> 'a t val doubleton : 'a -> 'a -> 'a t (** Sequence with exactly two elements - @since NEXT_RELEASE *) + @since 0.4 *) val cons : 'a -> 'a t -> 'a t (** [cons x l] yields [x], then yields from [l]. Same as [append (singleton x) l] - @since NEXT_RELEASE *) + @since 0.4 *) val snoc : 'a t -> 'a -> 'a t (** Same as {!cons} but yields the element after iterating on [l] - @since NEXT_RELEASE *) + @since 0.4 *) val return : 'a -> 'a t (** Synonym to {!singleton} - @since NEXT_RELEASE *) + @since 0.4 *) val pure : 'a -> 'a t (** Synonym to {!singleton} - @since NEXT_RELEASE *) + @since 0.4 *) val repeat : 'a -> 'a t (** Infinite sequence of the same element. You may want to look @@ -146,11 +146,11 @@ val exists : ('a -> bool) -> 'a t -> bool val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool (** Is the value a member of the sequence? @param eq the equality predicate to use (default [(=)]) - @since NEXT_RELEASE *) + @since 0.4 *) val find : ('a -> 'b option) -> 'a t -> 'b option (** Find the first element on which the function doesn't return [None] - @since NEXT_RELEASE *) + @since 0.4 *) val length : 'a t -> int (** How long is the sequence? Forces the sequence. *) @@ -179,14 +179,14 @@ val flatMap : ('a -> 'b t) -> 'a t -> 'b t val flat_map : ('a -> 'b t) -> 'a t -> 'b t (** Alias to {!flatMap} with a more explicit name - @since NEXT_RELEASE *) + @since 0.4 *) val fmap : ('a -> 'b option) -> 'a t -> 'b t (** Specialized version of {!flatMap} for options. *) val filter_map : ('a -> 'b option) -> 'a t -> 'b t (** Alias to {!fmap} with a more explicit name - @since NEXT_RELEASE *) + @since 0.4 *) val intersperse : 'a -> 'a t -> 'a t (** Insert the single element between every element of the sequence *) @@ -210,7 +210,7 @@ val persistent_lazy : 'a t -> 'a t is interrupted prematurely ({!take}, etc.) then [s'] will not be memorized, and the next call to [s'] will traverse [s] again. - @since NEXT_RELEASE *) + @since 0.4 *) (** {2 Misc} *) @@ -237,7 +237,7 @@ val product : 'a t -> 'b t -> ('a * 'b) t val product2 : 'a t -> 'b t -> ('a, 'b) t2 (** Binary version of {!product}. Same requirements. - @since NEXT_RELEASE *) + @since 0.4 *) 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 @@ -264,12 +264,12 @@ val min : ?lt:('a -> 'a -> bool) -> 'a t -> 'a option val head : 'a t -> 'a option (** First element, if any, otherwise [None] - @since NEXT_RELEASE *) + @since 0.4 *) val head_exn : 'a t -> 'a (** First element, if any, fails @raise Invalid_argument if the sequence is empty - @since NEXT_RELEASE *) + @since 0.4 *) val take : int -> 'a t -> 'a t (** Take at most [n] elements from the sequence. Works on infinite @@ -279,14 +279,14 @@ val take_while : ('a -> bool) -> 'a t -> 'a t (** Take elements while they satisfy the predicate, then stops iterating. Will work on an infinite sequence [s] if the predicate is false for at least one element of [s]. - @since NEXT_RELEASE *) + @since 0.4 *) val drop : int -> 'a t -> 'a t (** Drop the [n] first elements of the sequence. Lazy. *) val drop_while : ('a -> bool) -> 'a t -> 'a t (** Predicate version of {!drop} - @since NEXT_RELEASE *) + @since 0.4 *) val rev : 'a t -> 'a t (** Reverse the sequence. O(n) memory and time, needs the @@ -331,12 +331,12 @@ val of_list : 'a list -> 'a t val on_list : ('a t -> 'b t) -> 'a list -> 'b list (** [on_list f l] is equivalent to [to_list @@ f @@ of_list l]. - @since NEXT_RELEASE + @since 0.4 *) val to_opt : 'a t -> 'a option (** Alias to {!head} - @since NEXT_RELEASE *) + @since 0.4 *) val to_array : 'a t -> 'a array (** Convert to an array. Currently not very efficient because @@ -355,7 +355,7 @@ val array_slice : 'a array -> int -> int -> 'a t val of_opt : 'a option -> 'a t (** Iterate on 0 or 1 values. - @since NEXT_RELEASE *) + @since 0.4 *) val of_stream : 'a Stream.t -> 'a t (** Sequence of elements of a stream (usable only once) *) @@ -404,7 +404,7 @@ val to_str : char t -> string val concat_str : string t -> string (** Concatenate strings together, eagerly. Also see {!intersperse} to add a separator. - @since NEXT_RELEASE *) + @since 0.4 *) exception OneShotSequence (** Raised when the user tries to iterate several times on @@ -457,10 +457,10 @@ module Set : sig val to_seq : t -> elt sequence val to_list : t -> elt list - (** @since NEXT_RELEASE *) + (** @since 0.4 *) val of_list : elt list -> t - (** @since NEXT_RELEASE *) + (** @since 0.4 *) end (** Create an enriched Set module from the given one *) @@ -481,10 +481,10 @@ module Map : sig val values : 'a t -> 'a sequence val to_list : 'a t -> (key * 'a) list - (** @since NEXT_RELEASE *) + (** @since 0.4 *) val of_list : (key * 'a) list -> 'a t - (** @since NEXT_RELEASE *) + (** @since 0.4 *) end (** Adapt a pre-existing Map module to make it sequence-aware *) @@ -526,19 +526,19 @@ module Infix : sig val (>>=) : 'a t -> ('a -> 'b t) -> 'b t (** Monadic bind (infix version of {!flat_map} - @since NEXT_RELEASE *) + @since 0.4 *) val (>|=) : 'a t -> ('a -> 'b) -> 'b t (** Infix version of {!map} - @since NEXT_RELEASE *) + @since 0.4 *) val (<*>) : ('a -> 'b) t -> 'a t -> 'b t (** Applicative operator (product+application) - @since NEXT_RELEASE *) + @since 0.4 *) val (<+>) : 'a t -> 'a t -> 'a t (** Concatenation of sequences - @since NEXT_RELEASE *) + @since 0.4 *) end include module type of Infix @@ -576,7 +576,7 @@ By chunks of [4096] bytes: Sequence.IO.(chunks_of ~size:4096 "a" |> write_to "b");; ]} -@since NEXT_RELEASE *) +@since 0.4 *) module IO : sig val lines_of : ?mode:int -> ?flags:open_flag list -> diff --git a/core/CCSexp.mli b/core/CCSexp.mli index d2976d65..7ed78c57 100644 --- a/core/CCSexp.mli +++ b/core/CCSexp.mli @@ -25,7 +25,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (** {1 Simple and efficient S-expression parsing/printing} -@since NEXT_RELEASE *) +@since 0.4 *) type 'a or_error = [ `Ok of 'a | `Error of string ] type 'a sequence = ('a -> unit) -> unit diff --git a/pervasives/CCPervasives.ml b/pervasives/CCPervasives.ml index 0454038d..833faedb 100644 --- a/pervasives/CCPervasives.ml +++ b/pervasives/CCPervasives.ml @@ -34,7 +34,7 @@ This module is meant to be opened if one doesn't want to use both, say, end ]} -@since NEXT_RELEASE +@since 0.4 *) module Array = struct include Array include CCArray end From 3e08abf6a97d326d8de238c8c8181b5d56ee82a3 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 1 Oct 2014 11:42:54 +0200 Subject: [PATCH 2/8] generate doc for containers.advanced --- Makefile | 1 + _oasis | 8 ++++++++ 2 files changed, 9 insertions(+) diff --git a/Makefile b/Makefile index 796cd868..f228dc0d 100644 --- a/Makefile +++ b/Makefile @@ -55,6 +55,7 @@ examples: all push_doc: doc scp -r containers.docdir/* cedeela.fr:~/simon/root/software/containers/ scp -r containers_string.docdir/* cedeela.fr:~/simon/root/software/containers/string/ + scp -r containers_advanced.docdir/* cedeela.fr:~/simon/root/software/containers/advanced scp -r containers_misc.docdir/* cedeela.fr:~/simon/root/software/containers/misc/ DONTTEST=myocamlbuild.ml setup.ml diff --git a/_oasis b/_oasis index db965bfb..ed297ebf 100644 --- a/_oasis +++ b/_oasis @@ -143,6 +143,14 @@ Document containers_string XOCamlbuildPath: . XOCamlbuildLibraries: containers.string +Document containers_advanced + Title: Containers_advanced docs + Type: ocamlbuild (0.3) + BuildTools+: ocamldoc + Install: true + XOCamlbuildPath: . + XOCamlbuildLibraries: containers.advanced + Executable benchs Path: benchs/ Install: false From 293ff2958b7c58a6703c914c34cce607efd93112 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 1 Oct 2014 15:15:24 +0200 Subject: [PATCH 3/8] update of readme --- README.md | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index fad32d2e..13ef7ed8 100644 --- a/README.md +++ b/README.md @@ -15,7 +15,9 @@ ocaml-containers 3. A drop-in replacement to the standard library, `containers.pervasives`, that defined a `CCPervasives` module intented to be opened to extend some modules of the stdlib. -4. Random stuff, with *NO* *GUARANTEE* of even being barely usable or tested, +4. A sub-library with complicated abstractions, `containers.advanced` (with + a LINQ-like query module, batch operations using GADTs, and others) +5. Random stuff, with *NO* *GUARANTEE* of even being barely usable or tested, in other dirs (mostly `misc` but also `lwt` and `threads`). It's where I tend to write code when I want to test some idea, so half the modules (at least) are unfinished or don't really work. @@ -60,7 +62,6 @@ structures comprise (some modules in `misc/`, some other in `core/`): - `CCKList`, a persistent iterator structure (akin to a lazy list) - `CCList`, functions on lists, including tail-recursive implementations of `map` and `append` and many other things - `CCArray`, utilities on arrays and slices -- `CCLinq`, high-level query language over collections - `CCMultimap` and `CCMultiset`, functors defining persistent structures - `CCHashtbl`, an extension of the standard hashtbl module - `CCFlatHashtbl`, a flat (open-addressing) hashtable functorial implementation @@ -80,12 +81,25 @@ structures comprise (some modules in `misc/`, some other in `core/`): ### String +See [doc](http://cedeela.fr/~simon/software/containers/string). + In the module `Containers_string`: - `Levenshtein`: edition distance between two strings - `KMP`: Knuth-Morris-Pratt substring algorithm +### Advanced + +See [doc](http://cedeela.fr/~simon/software/containers/advanced). + +In the module `Containers_advanced`: +- `CCLinq`, high-level query language over collections +- `CCCat`, a few categorical structures +- `CCBatch`, to combine operations on collections into one traversal + ### Misc +See [doc](http://cedeela.fr/~simon/software/containers/misc). + - `PHashtbl`, a polymorphic hashtable (with open addressing) - `SplayTree`, a polymorphic splay heap implementation (not quite finished) - `SplayMap`, a polymorphic functional map based on splay trees From dc0b5873a4fcfa46121d190238c052043e6d75ec Mon Sep 17 00:00:00 2001 From: Nicolas Braud-Santoni Date: Thu, 16 Oct 2014 16:42:21 +0200 Subject: [PATCH 4/8] CCMultiset: Add meet --- core/CCMultiSet.ml | 14 ++++++++++++-- core/CCMultiSet.mli | 2 ++ 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/core/CCMultiSet.ml b/core/CCMultiSet.ml index 60640411..0dcd6707 100644 --- a/core/CCMultiSet.ml +++ b/core/CCMultiSet.ml @@ -51,6 +51,8 @@ module type S = sig val union : t -> t -> t + val meet : t -> t -> t + val intersection : t -> t -> t val diff : t -> t -> t @@ -117,11 +119,19 @@ module Make(O : Set.OrderedType) = struct M.merge (fun x n1 n2 -> match n1, n2 with | None, None -> assert false - | Some n1, None -> Some n1 - | None, Some n2 -> Some n2 + | Some n, None + | None, Some n -> Some n | Some n1, Some n2 -> Some (n1+n2)) m1 m2 + let meet m1 m2 = + M.merge + (fun _ n1 n2 -> match n1, n2 with + | None, None -> assert false + | Some n, None | None, Some n -> Some n + | Some n1, Some n2 -> Some (Pervasives.max n1 n2)) + m1 m2 + let intersection m1 m2 = M.merge (fun x n1 n2 -> match n1, n2 with diff --git a/core/CCMultiSet.mli b/core/CCMultiSet.mli index 4c994901..b11d0385 100644 --- a/core/CCMultiSet.mli +++ b/core/CCMultiSet.mli @@ -51,6 +51,8 @@ module type S = sig val union : t -> t -> t + val meet : t -> t -> t + val intersection : t -> t -> t val diff : t -> t -> t From 432f0f0abda10b57ff2514b247d76fb300c9f2b1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 16 Oct 2014 16:50:04 +0200 Subject: [PATCH 5/8] comments in CCMultiSet.mli, to explain meet/intersection/union --- core/CCMultiSet.ml | 6 +++--- core/CCMultiSet.mli | 12 +++++++++++- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/core/CCMultiSet.ml b/core/CCMultiSet.ml index 0dcd6707..2a0b2747 100644 --- a/core/CCMultiSet.ml +++ b/core/CCMultiSet.ml @@ -148,16 +148,16 @@ module Make(O : Set.OrderedType) = struct | Some n1, None -> Some n1 | None, Some n2 -> None | Some n1, Some n2 -> - if n1 > n2 + if n1 > n2 then Some (n1 - n2) else None) m1 m2 let contains m1 m2 = - try + try M.for_all (fun x c -> M.find x m1 >= c) m2 with Not_found -> false - + let compare m1 m2 = M.compare (fun x y -> x - y) m1 m2 diff --git a/core/CCMultiSet.mli b/core/CCMultiSet.mli index b11d0385..89d32f83 100644 --- a/core/CCMultiSet.mli +++ b/core/CCMultiSet.mli @@ -46,25 +46,35 @@ module type S = sig val remove : t -> elt -> t val min : t -> elt + (** Minimal element w.r.t the total ordering on elements *) val max : t -> elt val union : t -> t -> t + (** [union a b] contains as many occurrences of an element [x] + as [count a x + count b x]. *) val meet : t -> t -> t + (** [meet a b] is a multiset such that + [count (meet a b) x = max (count a x) (count b x)] *) val intersection : t -> t -> t + (** [intersection a b] is a multiset such that + [count (intersection a b) x = min (count a x) (count b x)] *) val diff : t -> t -> t + (** MultiSet difference. + [count (diff a b) x = max (count a x - count b x) 0] *) val contains : t -> t -> bool + (** [contains a x = (count m x > 0)] *) val compare : t -> t -> int val equal : t -> t -> bool val cardinal : t -> int - (** Number of distinct elements *) + (** Number of distinct elements *) val iter : t -> (int -> elt -> unit) -> unit From 22343b44696f975baf367d11a40085998620a7cd Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 18 Oct 2014 16:49:58 +0200 Subject: [PATCH 6/8] new functions in CCSexp.Traverse --- core/CCSexp.ml | 37 ++++++++++++++++++++++++++++++++ core/CCSexp.mli | 56 ++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 81 insertions(+), 12 deletions(-) diff --git a/core/CCSexp.ml b/core/CCSexp.ml index 4ef41483..c446b374 100644 --- a/core/CCSexp.ml +++ b/core/CCSexp.ml @@ -583,6 +583,8 @@ end (** {6 Traversal of S-exp} *) module Traverse = struct + type 'a conv = t -> 'a option + let return x = Some x let (>|=) e f = match e with @@ -593,6 +595,15 @@ module Traverse = struct | None -> None | Some x -> f x + let map_opt f l = + let rec recurse acc l = match l with + | [] -> Some (List.rev acc) + | x::l' -> + match f x with + | None -> None + | Some y -> recurse (y::acc) l' + in recurse [] l + let rec _list_any f l = match l with | [] -> None | x::tl -> @@ -628,14 +639,31 @@ module Traverse = struct | `List [x;y] -> Some (x,y) | _ -> None + let to_pair_with f1 f2 e = + to_pair e >>= fun (x,y) -> + f1 x >>= fun x -> + f2 y >>= fun y -> + return (x,y) + let to_triple e = match e with | `List [x;y;z] -> Some (x,y,z) | _ -> None + let to_triple_with f1 f2 f3 e = + to_triple e >>= fun (x,y,z) -> + f1 x >>= fun x -> + f2 y >>= fun y -> + f3 z >>= fun z -> + return (x,y,z) + let to_list e = match e with | `List l -> Some l | `Atom _ -> None + let to_list_with f (e:t) = match e with + | `List l -> map_opt f l + | `Atom _ -> None + let rec _get_field name l = match l with | `List [`Atom n; x] :: _ when name=n -> Some x | _ :: tl -> _get_field name tl @@ -648,6 +676,15 @@ module Traverse = struct let field name f e = get_field name e >>= f + let rec _get_field_list name l = match l with + | `List (`Atom n :: tl) :: _ when name=n -> Some tl + | _ :: tl -> _get_field_list name tl + | [] -> None + + let field_list name f e = match e with + | `List l -> _get_field_list name l >>= f + | `Atom _ -> None + let rec _get_variant s args l = match l with | [] -> None | (s', f) :: _ when s=s' -> f args diff --git a/core/CCSexp.mli b/core/CCSexp.mli index 7ed78c57..152b4b8e 100644 --- a/core/CCSexp.mli +++ b/core/CCSexp.mli @@ -250,40 +250,72 @@ Sexp.Traverse.list_all pt_of_sexp sexp;; *) module Traverse : sig - val list_any : (t -> 'a option) -> t -> 'a option + type 'a conv = t -> 'a option + (** A converter from S-expressions to 'a is a function [sexp -> 'a option]. + @since NEXT_RELEASE *) + + val map_opt : ('a -> 'b option) -> 'a list -> 'b list option + (** Map over a list, failing as soon as the function fails on any element + @since NEXT_RELEASE *) + + val list_any : 'a conv -> t -> 'a option (** [list_any f (List l)] tries [f x] for every element [x] in [List l], and returns the first non-None result (if any). *) - val list_all : (t -> 'a option) -> t -> 'a list + val list_all : 'a conv -> t -> 'a list (** [list_all f (List l)] returns the list of all [y] such that [x] in [l] and [f x = Some y] *) - val to_int : t -> int option + val to_int : int conv + (** Expect an integer *) - val to_string : t -> string option + val to_string : string conv + (** Expect a string (an atom) *) - val to_bool : t -> bool option + val to_bool : bool conv + (** Expect a boolean *) - val to_float : t -> float option + val to_float : float conv + (** Expect a float *) - val to_list : t -> t list option + val to_list : t list conv + (** Expect a list *) - val to_pair : t -> (t * t) option + val to_list_with : (t -> 'a option) -> 'a list conv + (** Expect a list, applies [f] to all the elements of the list, and succeeds + only if [f] succeeded on every element + @since NEXT_RELEASE *) - val to_triple : t -> (t * t * t) option + val to_pair : (t * t) conv + (** Expect a list of two elements *) - val get_field : string -> t -> t option + val to_pair_with : 'a conv -> 'b conv -> ('a * 'b) conv + (** Same as {!to_pair} but applies conversion functions + @since NEXT_RELEASE *) + + val to_triple : (t * t * t) conv + + val to_triple_with : 'a conv -> 'b conv -> 'c conv -> ('a * 'b * 'c) conv + (* @since NEXT_RELEASE *) + + val get_field : string -> t conv (** [get_field name e], when [e = List [(n1,x1); (n2,x2) ... ]], extracts the [xi] such that [name = ni], if it can find it. *) - val field : string -> (t -> 'a option) -> t -> 'a option + val field : string -> 'a conv -> 'a conv (** Enriched version of {!get_field}, with a converter as argument *) - val get_variant : (string * (t list -> 'a option)) list -> t -> 'a option + val get_variant : (string * (t list -> 'a option)) list -> 'a conv (** [get_variant l e] checks whether [e = List (Atom s :: args)], and if some pair of [l] is [s, f]. In this case, it calls [f args] and returns its result, otherwise it returns None. *) + val field_list : string -> (t list -> 'a option) -> 'a conv + (** [field_list name f "(... (name a b c d) ...record)"] + will look for a field based on the given [name], and expect it to have a + list of arguments dealt with by [f] (here, "a b c d"). + @since NEXT_RELEASE *) + val (>>=) : 'a option -> ('a -> 'b option) -> 'b option val (>|=) : 'a option -> ('a -> 'b) -> 'b option From 1e07897da86597e5213b7c7f01a0287b2085c4bb Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 18 Oct 2014 17:15:42 +0200 Subject: [PATCH 7/8] CCOpt.get --- core/CCOpt.ml | 4 ++++ core/CCOpt.mli | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/core/CCOpt.ml b/core/CCOpt.ml index cc087ca2..40bd8e58 100644 --- a/core/CCOpt.ml +++ b/core/CCOpt.ml @@ -92,6 +92,10 @@ let fold f acc o = match o with | None -> acc | Some x -> f acc x +let get default x = match x with + | None -> default + | Some y -> y + let get_exn = function | Some x -> x | None -> invalid_arg "CCOpt.get_exn" diff --git a/core/CCOpt.mli b/core/CCOpt.mli index cd783f77..48b7ec4a 100644 --- a/core/CCOpt.mli +++ b/core/CCOpt.mli @@ -60,6 +60,10 @@ val iter : ('a -> unit) -> 'a t -> unit val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a (** Fold on 0 or 1 elements *) +val get : 'a -> 'a t -> 'a +(** [get default x] unwraps [x], but if [x = None] it returns [default] instead. + @since NEXT_RELEASE *) + val get_exn : 'a t -> 'a (** Open the option, possibly failing if it is [None] @raise Invalid_argument if the option is [None] *) From 8bb78ab0d6bf95eea46d0cdedd8462525f2e1f7d Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 19 Oct 2014 21:01:44 +0200 Subject: [PATCH 8/8] Squashed 'sequence/' changes from 0d721a6..2691bee 2691bee version 0.5.3 a373739 merge from master 9fc9a31 bugfix: using the same ExitSequence exception in take and is_empty cannot work a193c54 added a regression test git-subtree-dir: sequence git-subtree-split: 2691bee2f68b7c27a1d1360999d0c21026f77ca9 --- CHANGELOG.md | 4 ++++ META | 6 +++--- _oasis | 4 ++-- sequence.ml | 46 ++++++++++++++++++++++++++---------------- setup.ml | 11 +++++----- tests/test_sequence.ml | 9 ++++++++- 6 files changed, 51 insertions(+), 29 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 09b514c1..c21ef641 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Changelog +## 0.5.3 + +- bugfix: interaction between `take` and `is_empty` + ## 0.5.2 - bugfix in `take` diff --git a/META b/META index ffd12c91..246e94fa 100644 --- a/META +++ b/META @@ -1,6 +1,6 @@ # OASIS_START -# DO NOT EDIT (digest: f4f3ee8dc8cda763af26a927b88956e6) -version = "0.5.2" +# DO NOT EDIT (digest: 99194977427ba82f5912e81125f6cac0) +version = "0.5.3" description = "Simple sequence (iterator) datatype and combinators" archive(byte) = "sequence.cma" archive(byte, plugin) = "sequence.cma" @@ -8,7 +8,7 @@ archive(native) = "sequence.cmxa" archive(native, plugin) = "sequence.cmxs" exists_if = "sequence.cma" package "invert" ( - version = "0.5.2" + version = "0.5.3" description = "Simple sequence (iterator) datatype and combinators" requires = "sequence delimcc" archive(byte) = "invert.cma" diff --git a/_oasis b/_oasis index 7c5a8e43..39a59224 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.4 Name: sequence -Version: 0.5.2 +Version: 0.5.3 Homepage: https://github.com/c-cube/sequence Authors: Simon Cruanes License: BSD-2-clause @@ -45,7 +45,7 @@ Document sequence XOCamlbuildLibraries: sequence Test all - Type: custom + Type: custom (0.4) Command: make run-tests TestTools: run_tests Run$: flag(tests) diff --git a/sequence.ml b/sequence.ml index 54ed7e85..00dd7cd0 100644 --- a/sequence.ml +++ b/sequence.ml @@ -319,33 +319,37 @@ let min ?(lt=fun x y -> x < y) seq = | Some y -> if lt x y then ret := Some x); !ret -exception ExitSequence +exception ExitHead let head seq = let r = ref None in try - seq (fun x -> r := Some x; raise ExitSequence); None - with ExitSequence -> !r + seq (fun x -> r := Some x; raise ExitHead); None + with ExitHead -> !r let head_exn seq = match head seq with | None -> invalid_arg "Sequence.head_exn" | Some x -> x +exception ExitTake + let take n seq k = let count = ref 0 in try seq (fun x -> - if !count = n then raise ExitSequence; + if !count = n then raise ExitTake; incr count; k x; ) - with ExitSequence -> () + with ExitTake -> () + +exception ExitTakeWhile let take_while p seq k = try - seq (fun x -> if p x then k x else raise ExitSequence) - with ExitSequence -> () + seq (fun x -> if p x then k x else raise ExitTakeWhile) + with ExitTakeWhile -> () let drop n seq k = let count = ref 0 in @@ -362,29 +366,35 @@ let rev seq = let l = MList.of_seq seq in fun k -> MList.iter_rev k l +exception ExitForall + let for_all p seq = try - seq (fun x -> if not (p x) then raise ExitSequence); + seq (fun x -> if not (p x) then raise ExitForall); true - with ExitSequence -> false + with ExitForall -> false + +exception ExitExists (** Exists there some element satisfying the predicate? *) let exists p seq = try - seq (fun x -> if p x then raise ExitSequence); + seq (fun x -> if p x then raise ExitExists); false - with ExitSequence -> true + with ExitExists -> true let mem ?(eq=(=)) x seq = exists (eq x) seq +exception ExitFind + let find f seq = let r = ref None in begin try seq (fun x -> match f x with | None -> () - | Some _ as res -> r := res + | Some _ as res -> r := res; raise ExitFind ); - with ExitSequence -> () + with ExitFind -> () end; !r @@ -393,17 +403,19 @@ let length seq = seq (fun _ -> incr r); !r +exception ExitIsEmpty + let is_empty seq = - try seq (fun _ -> raise ExitSequence); true - with ExitSequence -> false + try seq (fun _ -> raise ExitIsEmpty); true + with ExitIsEmpty -> false (** {2 Transform a sequence} *) let empty2 k = () let is_empty2 seq2 = - try ignore (seq2 (fun _ _ -> raise ExitSequence)); true - with ExitSequence -> false + try ignore (seq2 (fun _ _ -> raise ExitIsEmpty)); true + with ExitIsEmpty -> false let length2 seq2 = let r = ref 0 in diff --git a/setup.ml b/setup.ml index 72507e21..51aae2fc 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.4.4 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 3e1599f233d66e02cd17bbb3a1c71d9e) *) +(* DO NOT EDIT (digest: 1c260750474eb19b8e9212954217b6fd) *) (* Regenerated by OASIS v0.4.4 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6826,7 +6826,7 @@ let setup_t = alpha_features = []; beta_features = []; name = "sequence"; - version = "0.5.2"; + version = "0.5.3"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -7044,7 +7044,7 @@ let setup_t = cs_plugin_data = [] }, { - test_type = (`Test, "custom", None); + test_type = (`Test, "custom", Some "0.4"); test_command = [(OASISExpr.EBool true, ("make", ["run-tests"]))]; test_custom = @@ -7192,8 +7192,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.4"; - oasis_digest = - Some "\142\243\242-\024\139\245\030\1867\186\147D\175\251\192"; + oasis_digest = Some "\214\tqh\b\169>\243\237\213\012\180\162\155`L"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7201,6 +7200,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7205 "setup.ml" +# 7204 "setup.ml" (* OASIS_STOP *) let () = setup ();; diff --git a/tests/test_sequence.ml b/tests/test_sequence.ml index 1b6c8623..549fc859 100644 --- a/tests/test_sequence.ml +++ b/tests/test_sequence.ml @@ -6,7 +6,8 @@ open Sequence.Infix let pp_ilist l = let b = Buffer.create 15 in - Format.bprintf b "@[%a@]" (S.pp_seq Format.pp_print_int) (S.of_list l); + let fmt = Format.formatter_of_buffer b in + Format.fprintf fmt "@[%a@]" (S.pp_seq Format.pp_print_int) (S.of_list l); Buffer.contents b let test_empty () = @@ -197,6 +198,11 @@ let test_take () = OUnit.assert_equal ~printer:pp_ilist [1;2;3;4;5] l; () +let test_regression1 () = + let s = S.(take 10 (repeat 1)) in + OUnit.assert_bool "not empty" (not (S.is_empty s)); + () + let suite = "test_sequence" >::: [ "test_empty" >:: test_empty; @@ -225,4 +231,5 @@ let suite = "test_hashtbl" >:: test_hashtbl; "test_int_range" >:: test_int_range; "test_take" >:: test_take; + "test_regression1" >:: test_regression1 ]