From 0e5334b673f86494d80f11210fc87a2527fa5be7 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 24 Feb 2016 22:35:24 +0100 Subject: [PATCH 01/71] add an IO section to the tutorial --- TUTORIAL.adoc | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) diff --git a/TUTORIAL.adoc b/TUTORIAL.adoc index 9d973e18..eda949b1 100644 --- a/TUTORIAL.adoc +++ b/TUTORIAL.adoc @@ -166,6 +166,76 @@ val x : int = 2 ---- +== IO helpers + +The core library contains a module called `CCIO` that provides useful +functions for reading and writing files. It provides functions that +make resource handling easy, following +the pattern `with_resource : resource -> (access -> 'a) -> 'a` where +the type `access` is a temporary handle to the resource (e.g., +imagine `resource` is a file name and `access` a file descriptor). +Calling `with_resource r f` will access `r`, give the result to `f`, +compute the result of `f` and, whether `f` succeeds or raises an +error, it will free the resource. + +Consider for instance: + +[source,OCaml] +---- +# CCIO.with_out "/tmp/foobar" + (fun out_channel -> + CCIO.write_lines_l out_channel ["hello"; "world"]);; +- : unit = () +---- + +This just opened the file '/tmp/foobar', creating it if it didn't exist, +and wrote two lines in it. We did not have to close the file descriptor +because `with_out` took care of it. By the way, the type signatures are: + +[source,OCaml] +---- +val with_out : + ?mode:int -> ?flags:open_flag list -> + string -> (out_channel -> 'a) -> 'a + +val write_lines_l : out_channel -> string list -> unit +---- + +So we see the pattern for `with_out` (which opens a function in write +mode and gives its functional argument the corresponding file descriptor). + +NOTE: you should never let the resource escape the +scope of the `with_resource` call, because it will not be valid outside. +OCaml's type system doesn't make it easy to forbid that so we rely +on convention here (it would be possible, but cumbersome, using +a record with an explicitely quantified function type). + +Now we can read the file again: + +[source,OCaml] +---- +# let lines = CCIO.with_in "/tmp/foobar" CCIO.read_lines_l ;; +val lines : string list = ["hello"; "world"] +---- + +There are some other functions in `CCIO` that return _generators_ +instead of lists. The type of generators in containers +is `type 'a gen = unit -> 'a option` (combinators can be +found in the opam library called "gen"). A generator is to be called +to obtain successive values, until it returns `None` (which means it +has been exhausted). In particular, python users might recognize +the function + +[source,OCaml] +---- +# CCIO.File.walk ;; +- : string -> walk_item gen = ;; +---- + +where `type walk_item = [ `Dir | `File ] * string` is a path +paired with a flag distinguishing files from directories. + + == To go further: containers.data There is also a sub-library called `containers.data`, with lots of From b129e23414d563224267a2ff41df40777370ff3d Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 25 Feb 2016 10:19:54 +0100 Subject: [PATCH 02/71] some modules should be deprecated properly --- src/advanced/CCLinq.mli | 2 ++ src/bigarray/CCArray1.mli | 1 + src/string/CCApp_parse.mli | 4 +++- 3 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/advanced/CCLinq.mli b/src/advanced/CCLinq.mli index 2261af3f..898eea54 100644 --- a/src/advanced/CCLinq.mli +++ b/src/advanced/CCLinq.mli @@ -33,6 +33,8 @@ Functions and operations are assumed to be referentially transparent, i.e. they should not rely on external side effects, they should not rely on the order of execution. +@deprecated use {{: https://github.com/c-cube/olinq} OLinq} (once released) + {[ CCLinq.( diff --git a/src/bigarray/CCArray1.mli b/src/bigarray/CCArray1.mli index 4cb6fbea..0365cda1 100644 --- a/src/bigarray/CCArray1.mli +++ b/src/bigarray/CCArray1.mli @@ -25,6 +25,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (** {1 Bigarrays of dimension 1} + @deprecated do not use, this was always experimental {b NOTE this module will be removed soon and should not be depended upon} {b status: deprecated} diff --git a/src/string/CCApp_parse.mli b/src/string/CCApp_parse.mli index 6cc488f6..280a2d90 100644 --- a/src/string/CCApp_parse.mli +++ b/src/string/CCApp_parse.mli @@ -50,7 +50,9 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ]} -{b status: experimental} +@deprecated CCParse is more expressive and stable + +{b status: deprecated} @since 0.10 *) From 61cb8485d2eacd1c02611f89d33f3b7b71e216bb Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 25 Feb 2016 13:26:37 +0100 Subject: [PATCH 03/71] fix broken links in README --- README.adoc | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/README.adoc b/README.adoc index 175483da..e318973e 100644 --- a/README.adoc +++ b/README.adoc @@ -190,15 +190,16 @@ Iterators: === String -See http://cedeela.fr/~simon/software/containers/string[doc]. +See http://cedeela.fr/~simon/software/containers/Containers_string[doc]. In the module `Containers_string`: - `Levenshtein`: edition distance between two strings - `KMP`: Knuth-Morris-Pratt substring algorithm +- `Parse`: simple parser combinators === Advanced -See http://cedeela.fr/~simon/software/containers/advanced[doc]. +See http://cedeela.fr/~simon/software/containers/Containers_advanced[doc]. In the module `Containers_advanced`: - `CCLinq`, high-level query language over collections From d4549786c564be5a2ffee4ce6c33aae5dbe5fa41 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 29 Feb 2016 21:58:58 +0100 Subject: [PATCH 04/71] add more details on containers.data in tutorial --- TUTORIAL.adoc | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/TUTORIAL.adoc b/TUTORIAL.adoc index eda949b1..72aa3f65 100644 --- a/TUTORIAL.adoc +++ b/TUTORIAL.adoc @@ -243,5 +243,33 @@ more specialized data-structures. The documentation contains the API for all the modules (see link:README.adoc[the readme]); they also provide interface to `sequence` and, as the rest of containers, minimize -dependencies over other modules. +dependencies over other modules. To use `containers.data` you need to link it, +either in your build system or by `#require containers.data;;` + +A quick example based on purely functional double-ended queues: + +[source,OCaml] +---- +# #require "containers.data";; +# #install_printer CCFQueue.print;; (* better printing of queues! *) + +# let q = CCFQueue.of_list [2;3;4] ;; +val q : int CCFQueue.t = queue {2; 3; 4} + +# let q2 = q |> CCFQueue.cons 1 |> CCFQueue.cons 0 ;; +val q2 : int CCFQueue.t = queue {0; 1; 2; 3; 4} + +(* remove first element *) +# CCFQueue.take_front q2;; +- : (int * int CCFQueue.t) option = Some (0, queue {1; 2; 3; 4}) + +(* q was not changed *) +# CCFQueue.take_front q;; +- : (int * int CCFQueue.t) option = Some (2, queue {3; 4}) + +(* take works on both ends of the queue *) +# CCFQueue.take_back_l 2 q2;; +- : int CCFQueue.t * int list = (queue {0; 1; 2}, [3; 4]) + +---- From 574b4ac62e0a2af92c9fea80c11d2992178d756d Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 1 Mar 2016 20:31:53 +0100 Subject: [PATCH 05/71] add `CCImmutArray` into containers.data --- README.adoc | 1 + _oasis | 3 +- doc/intro.txt | 1 + src/data/CCImmutArray.ml | 129 ++++++++++++++++++++++++++++++++++++++ src/data/CCImmutArray.mli | 85 +++++++++++++++++++++++++ 5 files changed, 218 insertions(+), 1 deletion(-) create mode 100644 src/data/CCImmutArray.ml create mode 100644 src/data/CCImmutArray.mli diff --git a/README.adoc b/README.adoc index e318973e..5e301353 100644 --- a/README.adoc +++ b/README.adoc @@ -165,6 +165,7 @@ Documentation http://cedeela.fr/~simon/software/containers[here]. - `CCWBTree`, a weight-balanced tree, implementing a map interface - `CCRAL`, a random-access list structure, with `O(1)` cons/hd/tl and `O(ln(n))` access to elements by their index. +- `CCImmutArray`, immutable interface to arrays === Containers.io diff --git a/_oasis b/_oasis index bc9f6985..4ce73dd4 100644 --- a/_oasis +++ b/_oasis @@ -77,7 +77,8 @@ Library "containers_data" CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl, CCMixmap, CCRingBuffer, CCIntMap, CCPersistentArray, CCMixset, CCHashconsedSet, CCGraph, CCHashSet, CCBitField, - CCHashTrie, CCBloom, CCWBTree, CCRAL, CCAllocCache + CCHashTrie, CCBloom, CCWBTree, CCRAL, CCAllocCache, + CCImmutArray BuildDepends: bytes # BuildDepends: bytes, bisect_ppx FindlibParent: containers diff --git a/doc/intro.txt b/doc/intro.txt index 1b331182..7d70eee8 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -75,6 +75,7 @@ CCFQueue CCFlatHashtbl CCHashSet CCHashTrie +CCImmutArray CCIntMap CCMixmap CCMixset diff --git a/src/data/CCImmutArray.ml b/src/data/CCImmutArray.ml new file mode 100644 index 00000000..a775a586 --- /dev/null +++ b/src/data/CCImmutArray.ml @@ -0,0 +1,129 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Immutable Arrays} *) + +(* TODO: tests *) +(* TODO: transient API? for batch modifications *) + +type 'a t = 'a array + +let empty = [| |] + +let length = Array.length + +let singleton x = [| x |] + +let doubleton x y = [| x; y |] + +let make n x = Array.make n x + +let init n f = Array.init n f + +let get = Array.get + +let set a n x = + let a' = Array.copy a in + a'.(n) <- x; + a' + +let map = Array.map + +let mapi = Array.mapi + +let append a b = + let na = length a in + Array.init (na + length b) + (fun i -> if i < na then a.(i) else b.(i-na)) + +let iter = Array.iter + +let iteri = Array.iteri + +let fold = Array.fold_left + +let foldi f acc a = + let n = ref 0 in + Array.fold_left + (fun acc x -> + let acc = f acc !n x in + incr n; + acc) + acc a + +exception ExitNow + +let for_all p a = + try + Array.iter (fun x -> if not (p x) then raise ExitNow) a; + true + with ExitNow -> false + +let exists p a = + try + Array.iter (fun x -> if p x then raise ExitNow) a; + false + with ExitNow -> true + +(** {2 Conversions} *) + +type 'a sequence = ('a -> unit) -> unit +type 'a gen = unit -> 'a option + +let of_list = Array.of_list + +let to_list = Array.to_list + +let of_array_unsafe a = a (* careful with that axe, Eugene *) + +let to_seq a k = iter k a + +let of_seq s = + let l = ref [] in + s (fun x -> l := x :: !l); + Array.of_list (List.rev !l) + +(*$Q + Q.(list int) (fun l -> \ + let g = Sequence.of_list l in \ + of_seq g |> to_seq |> Sequence.to_list = l) +*) + +let rec gen_to_list_ acc g = match g() with + | None -> List.rev acc + | Some x -> gen_to_list_ (x::acc) g + +let of_gen g = + let l = gen_to_list_ [] g in + Array.of_list l + +let to_gen a = + let i = ref 0 in + fun () -> + if !i < Array.length a then ( + let x = a.(!i) in + incr i; + Some x + ) else None + +(*$Q + Q.(list int) (fun l -> \ + let g = Gen.of_list l in \ + of_gen g |> to_gen |> Gen.to_list = l) +*) + +(** {2 IO} *) + +type 'a printer = Format.formatter -> 'a -> unit + +let print ?(start="[|") ?(stop="|]") ?(sep=";") pp_item out a = + Format.pp_print_string out start; + for k = 0 to Array.length a - 1 do + if k > 0 then ( + Format.pp_print_string out sep; + Format.pp_print_cut out () + ); + pp_item out a.(k) + done; + Format.pp_print_string out stop; + () diff --git a/src/data/CCImmutArray.mli b/src/data/CCImmutArray.mli new file mode 100644 index 00000000..5bb8d910 --- /dev/null +++ b/src/data/CCImmutArray.mli @@ -0,0 +1,85 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Immutable Arrays} + + Purely functional use of arrays. Update is costly, but reads are very fast. + Sadly, it is not possible to make this type covariant without using black + magic. + + @since NEXT_RELEASE *) + +type 'a t +(** Array of values of type 'a. The underlying type really is + an array, but it will never be modified. + + It should be covariant but OCaml will not accept it. *) + +val empty : 'a t + +val length : _ t -> int + +val singleton : 'a -> 'a t + +val doubleton : 'a -> 'a -> 'a t + +val make : int -> 'a -> 'a t +(** [make n x] makes an array of [n] times [x] *) + +val init : int -> (int -> 'a) -> 'a t +(** [init n f] makes the array [[| f 0; f 1; ... ; f (n-1) |]]. + @raise Invalid_argument if [n < 0] *) + +val get : 'a t -> int -> 'a +(** Access the element *) + +val set : 'a t -> int -> 'a -> 'a t +(** Copy the array and modify its copy *) + +val map : ('a -> 'b) -> 'a t -> 'b t + +val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t + +val append : 'a t -> 'a t -> 'a t + +val iter : ('a -> unit) -> 'a t -> unit + +val iteri : (int -> 'a -> unit) -> 'a t -> unit + +val foldi : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a + +val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a + +val for_all : ('a -> bool) -> 'a t -> bool + +val exists : ('a -> bool) -> 'a t -> bool + +(** {2 Conversions} *) + +type 'a sequence = ('a -> unit) -> unit +type 'a gen = unit -> 'a option + +val of_list : 'a list -> 'a t + +val to_list : 'a t -> 'a list + +val of_array_unsafe : 'a array -> 'a t +(** Take ownership of the given array. Careful, the array must {b NOT} + be modified afterwards! *) + +val to_seq : 'a t -> 'a sequence + +val of_seq : 'a sequence -> 'a t + +val of_gen : 'a gen -> 'a t + +val to_gen : 'a t -> 'a gen + +(** {2 IO} *) + +type 'a printer = Format.formatter -> 'a -> unit + +val print : + ?start:string -> ?stop:string -> ?sep:string -> + 'a printer -> 'a t printer + From 8c273108348c672705ca3c4bd5ee192568eca1ff Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 1 Mar 2016 20:32:02 +0100 Subject: [PATCH 06/71] enable `-j 0` for ocamlbuild --- _oasis | 2 ++ 1 file changed, 2 insertions(+) diff --git a/_oasis b/_oasis index 4ce73dd4..1e942b52 100644 --- a/_oasis +++ b/_oasis @@ -10,6 +10,8 @@ OCamlVersion: >= 4.00.1 BuildTools: ocamlbuild AlphaFeatures: compiled_setup_ml, ocamlbuild_more_args +XOCamlbuildExtraArgs: "-j 0" + Synopsis: A modular standard library focused on data structures. Description: Containers is a standard library (BSD license) focused on data structures, From 8094a3160421e7924cfbde06e67615520c46635a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 8 Mar 2016 11:28:59 +0100 Subject: [PATCH 07/71] missing modules in doc/intro.txt --- doc/intro.txt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/intro.txt b/doc/intro.txt index 7d70eee8..e72e0356 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -71,8 +71,10 @@ CCBitField CCBloom CCBV CCCache +CCDeque CCFQueue CCFlatHashtbl +CCGraph CCHashSet CCHashTrie CCImmutArray From d6487a02a086cfc6d5e385917ef5c04301504f53 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 8 Mar 2016 15:50:11 +0100 Subject: [PATCH 08/71] add `CCList.Assoc.remove` --- src/core/CCList.ml | 15 +++++++++++++++ src/core/CCList.mli | 4 ++++ 2 files changed, 19 insertions(+) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 76612fee..5d926df0 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -849,6 +849,21 @@ module Assoc = struct (Assoc.update [1,"1"; 2,"2"] 3 \ ~f:(function None -> Some "3" | _ -> assert false) |> lsort) *) + + let remove ?(eq=(=)) l x = + search_set eq [] l x + ~f:(fun _ opt_y rest -> match opt_y with + | None -> l (* keep as is *) + | Some _ -> rest) + + (*$= + [1,"1"] \ + (Assoc.remove [1,"1"; 2,"2"] 2 |> lsort) + [1,"1"; 3,"3"] \ + (Assoc.remove [1,"1"; 2,"2"; 3,"3"] 2 |> lsort) + [1,"1"; 2,"2"] \ + (Assoc.remove [1,"1"; 2,"2"] 3 |> lsort) + *) end (** {2 Zipper} *) diff --git a/src/core/CCList.mli b/src/core/CCList.mli index ee60436a..8a9afb25 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -294,6 +294,10 @@ module Assoc : sig and removing [k] if it returns [None], mapping [k] to [v'] if it returns [Some v'] @since 0.16 *) + + val remove : ?eq:('a->'a->bool) -> ('a,'b) t -> 'a -> ('a,'b) t + (** [remove l k] removes the first occurrence of [k] from [l]. + @since NEXT_RELEASE *) end (** {2 Zipper} *) From fecbd7683a63421a132c181332799c3a57d2bd4d Mon Sep 17 00:00:00 2001 From: jkloos Date: Wed, 9 Mar 2016 11:28:55 +0100 Subject: [PATCH 09/71] Make CCPersistentHashtbl.S.merge more general. This patch brings the merge function of CCPersistentHashtbl in line with the merge functions of other maps (Map, BatMap from batteries). In particular, its signature changes from the restrictive merge: (key -> 'a option -> 'a option -> 'a option) -> 'a t -> 'a t -> 'a t to a more general merge: (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t --- src/data/CCPersistentHashtbl.ml | 6 +++--- src/data/CCPersistentHashtbl.mli | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/data/CCPersistentHashtbl.ml b/src/data/CCPersistentHashtbl.ml index 798b04f1..1fd06f67 100644 --- a/src/data/CCPersistentHashtbl.ml +++ b/src/data/CCPersistentHashtbl.ml @@ -89,8 +89,8 @@ module type S = sig (** Fresh copy of the table; the underlying structure is not shared anymore, so using both tables alternatively will be efficient *) - val merge : (key -> 'a option -> 'a option -> 'a option) -> - 'a t -> 'a t -> 'a t + val merge : (key -> 'a option -> 'b option -> 'c option) -> + 'a t -> 'b t -> 'c t (** Merge two tables together into a new table. The function's argument correspond to values associated with the key (if present); if the function returns [None] the key will not appear in the result. *) @@ -576,7 +576,7 @@ module Make(H : HashedType) : S with type key = H.t = struct if mem t1 k then tbl else match f k None (Some v2) with | None -> tbl - | Some _ -> replace tbl k v2 + | Some v' -> replace tbl k v' ) tbl t2 (*$R diff --git a/src/data/CCPersistentHashtbl.mli b/src/data/CCPersistentHashtbl.mli index 908b9252..6fed4d96 100644 --- a/src/data/CCPersistentHashtbl.mli +++ b/src/data/CCPersistentHashtbl.mli @@ -96,8 +96,8 @@ module type S = sig (** Fresh copy of the table; the underlying structure is not shared anymore, so using both tables alternatively will be efficient *) - val merge : (key -> 'a option -> 'a option -> 'a option) -> - 'a t -> 'a t -> 'a t + val merge : (key -> 'a option -> 'b option -> 'c option) -> + 'a t -> 'b t -> 'c t (** Merge two tables together into a new table. The function's argument correspond to values associated with the key (if present); if the function returns [None] the key will not appear in the result. *) From 9c338f193e76aac9f69a04e1e97cea3f69a73051 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 9 Mar 2016 19:45:38 +0100 Subject: [PATCH 10/71] add `CCString.rev` --- src/core/CCString.cppo.ml | 4 ++++ src/core/CCString.mli | 15 +++++++++++++++ 2 files changed, 19 insertions(+) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 0574eab9..1cbd0e73 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -50,6 +50,10 @@ let init n f = let length = String.length +let rev s = + let n = length s in + init n (fun i -> s.[n-i-1]) + let rec _to_list s acc i len = if len=0 then List.rev acc else _to_list s (s.[i]::acc) (i+1) (len-1) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index c036700e..10194703 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -63,6 +63,21 @@ val init : int -> (int -> char) -> string init 0 (fun _ -> assert false) = "" *) +val rev : string -> string +(** [rev s] returns the reverse of [s] + @since NEXT_RELEASE *) + +(*$Q + Q.printable_string (fun s -> s = rev (rev s)) + Q.printable_string (fun s -> length s = length (rev s)) +*) + +(*$= + "abc" (rev "cba") + "" (rev "") + " " (rev " ") +*) + val of_gen : char gen -> string val of_seq : char sequence -> string val of_klist : char klist -> string From 5f188c4f7e2f6a02aaa2ef79f256defd37990961 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 9 Mar 2016 21:09:32 +0100 Subject: [PATCH 11/71] in CCString, use KMP for faster sub-string search; add `find_all{,_l}` --- src/core/CCString.cppo.ml | 151 ++++++++++++++++++++++++++++++++------ src/core/CCString.mli | 46 +++++++++--- 2 files changed, 165 insertions(+), 32 deletions(-) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 1cbd0e73..5bca58d8 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -70,32 +70,135 @@ let is_sub ~sub i s j ~len = if i+len > String.length sub then invalid_arg "CCString.is_sub"; _is_sub ~sub i s j ~len -(* note: inefficient *) -let find ?(start=0) ~sub s = - let n = String.length sub in - let i = ref start in - try - while !i + n <= String.length s do - if _is_sub ~sub 0 s !i ~len:n then raise Exit; - incr i +type _ direction = + | Direct : [`Direct] direction + | Reverse : [`Reverse] direction + +module KMP = struct + type 'a pattern = { + failure : int array; + str : string; + } + (* invariant: [length failure = length str]. + We use a phantom type to avoid mixing the directions. *) + + let pattern_length p = String.length p.str + + (* access the [i]-th element of [s] according to direction [dir] *) + let get_ + : type a. dir:a direction -> string -> int -> char + = fun ~dir -> match dir with + | Direct -> (fun s i -> s.[i]) + | Reverse -> (fun s i -> s.[String.length s - i - 1]) + + let compile_ + : type a. dir:a direction -> string -> a pattern + = fun ~dir str -> + let len = length str in + let get = get_ ~dir in (* how to read elements of the string *) + match len with + | 0 -> {failure=[| |]; str;} + | 1 -> {failure=[| -1 |]; str;} + | _ -> + (* at least 2 elements, the algorithm can work *) + let failure = Array.make len 0 in + (* i: current index in str *) + let i = ref 1 in + (* j: index of candidate substring *) + let j = ref 0 in + while !i < len-1 do + match !j with + | _ when get str !i = get str !j -> + (* substring starting at !j continues matching current char *) + i := !i+1; + j := !j+1; + failure.(!i) <- !j; + | 0 -> + (* back to the beginning *) + i := !i+1; + failure.(!i) <- 0; + | _ -> + (* fallback for the prefix string *) + assert (!j > 0); + j := failure.(!j) + done; + { failure; str; } + + let compile s = compile_ ~dir:Direct s + let rcompile s = compile_ ~dir:Reverse s + + (* proper search function. + [i] index in [s] + [j] index in [pattern] + [len] length of [s] *) + let find_ + : type a. dir:a direction -> pattern:a pattern -> string -> int -> int + = fun ~dir ~pattern s idx -> + let len = length s in + let get = get_ ~dir in + let i = ref idx in + let j = ref 0 in + let pat_len = pattern_length pattern in + while !i < len && !j < pat_len do + let c = get s !i in + let expected = get pattern.str !j in + if c = expected + then ( + (* char matches *) + i := !i + 1; j := !j + 1 + ) else ( + if !j=0 + then (* beginning of the pattern *) + i := !i + 1 + else (* follow the failure link *) + j := pattern.failure.(!j) + ) done; - -1 - with Exit -> - !i + if !j = pat_len + then !i - pat_len + else -1 + + let find ~pattern s i = find_ ~dir:Direct ~pattern s i + + let rfind ~pattern s i = + let i = String.length s - i - 1 in + let res = find_ ~dir:Reverse ~pattern s i in + (* adjust result: first, [res = string.length s - res -1] to convert + back to real indices; then, what we got is actually the position + of the end of the pattern, so we subtract the [length of the pattern -1] + to obtain the real result. *) + if res = ~-1 + then res + else (String.length s - res) - pattern_length pattern +end + +let find ?(start=0) ~sub s = + let pattern = KMP.compile sub in + KMP.find ~pattern s start + +let find_all ?(start=0) ~sub s = + let pattern = KMP.compile sub in + let i = ref start in + fun () -> + let res = KMP.find ~pattern s !i in + if res = ~-1 then None + else ( + i := res + KMP.pattern_length pattern; + Some res + ) + +let find_all_l ?start ~sub s = + let rec aux acc g = match g () with + | None -> List.rev acc + | Some i -> aux (i::acc) g + in + aux [] (find_all ?start ~sub s) let mem ?start ~sub s = find ?start ~sub s >= 0 let rfind ~sub s = - let n = String.length sub in - let i = ref (String.length s - n) in - try - while !i >= 0 do - if _is_sub ~sub 0 s !i ~len:n then raise Exit; - decr i - done; - ~-1 - with Exit -> - !i + let pattern = KMP.rcompile sub in + KMP.rfind ~pattern s (String.length s-1) (* Replace substring [s.[pos]....s.[pos+len-1]] by [by] in [s] *) let replace_at_ ~pos ~len ~by s = @@ -109,16 +212,18 @@ let replace ?(which=`All) ~sub ~by s = if sub="" then invalid_arg "CCString.replace"; match which with | `Left -> - let i = find ~sub s in + let i = find ~sub s ~start:0 in if i>=0 then replace_at_ ~pos:i ~len:(String.length sub) ~by s else s | `Right -> let i = rfind ~sub s in if i>=0 then replace_at_ ~pos:i ~len:(String.length sub) ~by s else s | `All -> + (* compile search pattern only once *) + let pattern = KMP.compile sub in let b = Buffer.create (String.length s) in let start = ref 0 in while !start < String.length s do - let i = find ~start:!start ~sub s in + let i = KMP.find ~pattern s !start in if i>=0 then ( (* between last and cur occurrences *) Buffer.add_substring b s !start (i- !start); diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 10194703..cfdfe959 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -96,10 +96,32 @@ val find : ?start:int -> sub:string -> string -> int Should only be used with very small [sub] *) (*$= & ~printer:string_of_int - (find ~sub:"bc" "abcd") 1 - (find ~sub:"bc" "abd") ~-1 - (find ~sub:"a" "_a_a_a_") 1 - (find ~sub:"a" ~start:5 "a1a234a") 6 + 1 (find ~sub:"bc" "abcd") + ~-1 (find ~sub:"bc" "abd") + 1 (find ~sub:"a" "_a_a_a_") + 6 (find ~sub:"a" ~start:5 "a1a234a") +*) + +(*$Q & ~count:300 + Q.(pair printable_string printable_string) (fun (s1,s2) -> \ + let i = find ~sub:s2 s1 in \ + i < 0 || String.sub s1 i (length s2) = s2) +*) + +val find_all : ?start:int -> sub:string -> string -> int gen +(** [find_all ~sub s] finds all occurrences of [sub] in [s] + @param start starting position in [s] + @since NEXT_RELEASE *) + +val find_all_l : ?start:int -> sub:string -> string -> int list +(** [find_all ~sub s] finds all occurrences of [sub] in [s] and returns + them in a list + @param start starting position in [s] + @since NEXT_RELEASE *) + +(*$= & ~printer:Q.Print.(list int) + [1; 6] (find_all_l ~sub:"bc" "abc aabc aab") + [] (find_all_l ~sub:"bc" "abd") *) val mem : ?start:int -> sub:string -> string -> bool @@ -117,11 +139,17 @@ val rfind : sub:string -> string -> int @since 0.12 *) (*$= & ~printer:string_of_int - (rfind ~sub:"bc" "abcd") 1 - (rfind ~sub:"bc" "abd") ~-1 - (rfind ~sub:"a" "_a_a_a_") 5 - (rfind ~sub:"bc" "abcdbcd") 4 - (rfind ~sub:"a" "a1a234a") 6 + 1 (rfind ~sub:"bc" "abcd") + ~-1 (rfind ~sub:"bc" "abd") + 5 (rfind ~sub:"a" "_a_a_a_") + 4 (rfind ~sub:"bc" "abcdbcd") + 6 (rfind ~sub:"a" "a1a234a") +*) + +(*$Q & ~count:300 + Q.(pair printable_string printable_string) (fun (s1,s2) -> \ + let i = rfind ~sub:s2 s1 in \ + i < 0 || String.sub s1 i (length s2) = s2) *) val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string -> string From b5f54e3424163162396ebe90beaf66a5ae3496f3 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 9 Mar 2016 21:10:06 +0100 Subject: [PATCH 12/71] new benchmarks for strings --- _oasis | 2 +- benchs/run_benchs.ml | 110 ++++++++++++++++++++++++++++++++++++++++++- src/string/CCKMP.ml | 24 +--------- src/string/CCKMP.mli | 24 +--------- 4 files changed, 112 insertions(+), 48 deletions(-) diff --git a/_oasis b/_oasis index 1e942b52..437da1e2 100644 --- a/_oasis +++ b/_oasis @@ -155,7 +155,7 @@ Executable run_benchs CompiledObject: best Build$: flag(bench) MainIs: run_benchs.ml - BuildDepends: containers, containers.advanced, + BuildDepends: containers, containers.advanced, QTest2Lib, containers.data, containers.string, containers.iter, containers.thread, sequence, gen, benchmark, hamt diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index a7c5c1d1..3daf52ae 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -1081,7 +1081,6 @@ module Thread = struct end module Graph = struct - (* divisors graph *) let div_children_ i = (* divisors of [i] that are [>= j] *) @@ -1155,6 +1154,115 @@ module Graph = struct ) end +module Str = struct + (* random string, but always returns the same for a given size *) + let rand_str_ n = + let module Q = Quickcheck in + let st = Random.State.make [| n |] in + let gen_c = Q.Gen.oneofl (CCString.to_list "abcdefghijkl") in + Q.Gen.string_size ~gen:gen_c (Q.Gen.return n) st + + (* note: inefficient *) + let find ?(start=0) ~sub s = + let n = String.length sub in + let i = ref start in + try + while !i + n <= String.length s do + if CCString.is_sub ~sub 0 s !i ~len:n then raise Exit; + incr i + done; + -1 + with Exit -> + !i + + (* note: inefficient *) + let rfind ~sub s = + let n = String.length sub in + let i = ref (String.length s - n) in + try + while !i >= 0 do + if CCString.is_sub ~sub 0 s !i ~len:n then raise Exit; + decr i + done; + ~-1 + with Exit -> + !i + + let find_all ?(start=0) ~sub s = + let i = ref start in + fun () -> + let res = find ~sub s ~start:!i in + if res = ~-1 then None + else ( + i := res + String.length sub; + Some res + ) + + let find_all_l ?start ~sub s = find_all ?start ~sub s |> Gen.to_list + + let pp_pb needle haystack = + Format.printf "search needle `%s` in `%s`...@." + needle (String.sub haystack 0 (min 300 (String.length haystack))) + + (* benchmark String.{,r}find *) + let bench_find_ ~dir ~size n = + let needle = rand_str_ size in + let haystack = rand_str_ n in + pp_pb needle haystack; + let mk_naive = match dir with + | `Direct -> fun () -> find ~sub:needle haystack + | `Reverse -> fun () -> rfind ~sub:needle haystack + and mk_current = match dir with + | `Direct -> fun () -> CCString.find ~sub:needle haystack + | `Reverse -> fun () -> CCString.rfind ~sub:needle haystack + in + assert (mk_naive () = mk_current ()); + B.throughputN 3 ~repeat + [ "naive", mk_naive, () + ; "current", mk_current, () + ] + + (* benchmark String.find_all *) + let bench_find_all ~size n = + let needle = rand_str_ size in + let haystack = rand_str_ n in + pp_pb needle haystack; + let mk_naive () = find_all_l ~sub:needle haystack + and mk_current () = CCString.find_all_l ~sub:needle haystack in + assert (mk_naive () = mk_current ()); + B.throughputN 3 ~repeat + [ "naive", mk_naive, () + ; "current", mk_current, () + ] + + let bench_find = bench_find_ ~dir:`Direct + let bench_rfind = bench_find_ ~dir:`Reverse + + let () = B.Tree.register ( + "string" @>>> + [ "find" @>>> + [ "1" @>> app_ints (bench_find ~size:1) [100; 100_000; 500_000] + ; "5" @>> app_ints (bench_find ~size:5) [100; 100_000; 500_000] + ; "15" @>> app_ints (bench_find ~size:15) [100; 100_000; 500_000] + ; "50" @>> app_ints (bench_find ~size:50) [100; 100_000; 500_000] + ; "500" @>> app_ints (bench_find ~size:500) [100_000; 500_000] + ]; + "find_all" @>>> + [ "1" @>> app_ints (bench_find_all ~size:1) [100; 100_000; 500_000] + ; "5" @>> app_ints (bench_find_all ~size:5) [100; 100_000; 500_000] + ; "15" @>> app_ints (bench_find_all ~size:15) [100; 100_000; 500_000] + ; "50" @>> app_ints (bench_find_all ~size:50) [100; 100_000; 500_000] + ; "500" @>> app_ints (bench_find_all ~size:500) [100_000; 500_000] + ]; + "rfind" @>>> + [ "15" @>> app_ints (bench_rfind ~size:15) [100; 100_000; 500_000] + ; "50" @>> app_ints (bench_rfind ~size:50) [100; 100_000; 500_000] + ; "500" @>> app_ints (bench_rfind ~size:500) [100_000; 500_000] + ]; + ]) + +end + module Alloc = struct module type ALLOC_ARR = sig type 'a t diff --git a/src/string/CCKMP.ml b/src/string/CCKMP.ml index 1b7073b5..5511fad1 100644 --- a/src/string/CCKMP.ml +++ b/src/string/CCKMP.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, simon cruanes -all rights reserved. -redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. redistributions in binary -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 file is free software, part of containers. See file "license" for more details. *) (** {1 Knuth-Morris-Pratt} *) diff --git a/src/string/CCKMP.mli b/src/string/CCKMP.mli index 7d8f8d56..13b059f5 100644 --- a/src/string/CCKMP.mli +++ b/src/string/CCKMP.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, simon cruanes -all rights reserved. -redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. redistributions in binary -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 file is free software, part of containers. See file "license" for more details. *) (** {1 Knuth-Morris-Pratt} *) From fb8661d1ba13b75f3a5525142630cf606930b003 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 9 Mar 2016 21:18:40 +0100 Subject: [PATCH 13/71] moar inlining --- _tags | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/_tags b/_tags index bcb2222e..0d8627c3 100644 --- a/_tags +++ b/_tags @@ -155,7 +155,7 @@ true: annot, bin_annot # OASIS_STOP : thread : thread -: inline(25) + or : inline(25) or or : inline(15) and not : warn_A, warn(-4), warn(-44) true: no_alias_deps, safe_string, short_paths From ab0b198f97b8190f23da8c6f4bf7d78b6ed4acdf Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 9 Mar 2016 22:24:57 +0100 Subject: [PATCH 14/71] more tests, bugfixes, and benchs for KMP in CCString --- benchs/run_benchs.ml | 25 ++++++++++++--- src/core/CCString.cppo.ml | 66 +++++++++++++++++++++------------------ src/core/CCString.mli | 2 ++ 3 files changed, 57 insertions(+), 36 deletions(-) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index 3daf52ae..593c8da7 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -1156,13 +1156,12 @@ end module Str = struct (* random string, but always returns the same for a given size *) - let rand_str_ n = + let rand_str_ ?(among="abcdefgh") n = let module Q = Quickcheck in let st = Random.State.make [| n |] in - let gen_c = Q.Gen.oneofl (CCString.to_list "abcdefghijkl") in + let gen_c = Q.Gen.oneofl (CCString.to_list among) in Q.Gen.string_size ~gen:gen_c (Q.Gen.return n) st - (* note: inefficient *) let find ?(start=0) ~sub s = let n = String.length sub in let i = ref start in @@ -1175,7 +1174,6 @@ module Str = struct with Exit -> !i - (* note: inefficient *) let rfind ~sub s = let n = String.length sub in let i = ref (String.length s - n) in @@ -1235,6 +1233,19 @@ module Str = struct ; "current", mk_current, () ] + (* benchmark String.find_all on constant strings *) + let bench_find_all_special ~size n = + let needle = CCString.repeat "a" (size-1) ^ "b" in + let haystack = rand_str_ ~among:"ab" n in + pp_pb needle haystack; + let mk_naive () = find_all_l ~sub:needle haystack + and mk_current () = CCString.find_all_l ~sub:needle haystack in + assert (mk_naive () = mk_current ()); + B.throughputN 3 ~repeat + [ "naive", mk_naive, () + ; "current", mk_current, () + ] + let bench_find = bench_find_ ~dir:`Direct let bench_rfind = bench_find_ ~dir:`Reverse @@ -1242,6 +1253,7 @@ module Str = struct "string" @>>> [ "find" @>>> [ "1" @>> app_ints (bench_find ~size:1) [100; 100_000; 500_000] + ; "3" @>> app_ints (bench_find ~size:3) [100; 100_000; 500_000] ; "5" @>> app_ints (bench_find ~size:5) [100; 100_000; 500_000] ; "15" @>> app_ints (bench_find ~size:15) [100; 100_000; 500_000] ; "50" @>> app_ints (bench_find ~size:50) [100; 100_000; 500_000] @@ -1249,13 +1261,16 @@ module Str = struct ]; "find_all" @>>> [ "1" @>> app_ints (bench_find_all ~size:1) [100; 100_000; 500_000] + ; "3" @>> app_ints (bench_find_all ~size:3) [100; 100_000; 500_000] ; "5" @>> app_ints (bench_find_all ~size:5) [100; 100_000; 500_000] ; "15" @>> app_ints (bench_find_all ~size:15) [100; 100_000; 500_000] ; "50" @>> app_ints (bench_find_all ~size:50) [100; 100_000; 500_000] ; "500" @>> app_ints (bench_find_all ~size:500) [100_000; 500_000] + ; "special" @>> app_ints (bench_find_all_special ~size:6) [100_000; 500_000] ]; "rfind" @>>> - [ "15" @>> app_ints (bench_rfind ~size:15) [100; 100_000; 500_000] + [ "3" @>> app_ints (bench_rfind ~size:3) [100; 100_000; 500_000] + ; "15" @>> app_ints (bench_rfind ~size:15) [100; 100_000; 500_000] ; "50" @>> app_ints (bench_rfind ~size:50) [100; 100_000; 500_000] ; "500" @>> app_ints (bench_rfind ~size:500) [100_000; 500_000] ]; diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 5bca58d8..ee2ab50b 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -74,6 +74,7 @@ type _ direction = | Direct : [`Direct] direction | Reverse : [`Reverse] direction +(* we follow https://en.wikipedia.org/wiki/Knuth–Morris–Pratt_algorithm *) module KMP = struct type 'a pattern = { failure : int array; @@ -88,7 +89,7 @@ module KMP = struct let get_ : type a. dir:a direction -> string -> int -> char = fun ~dir -> match dir with - | Direct -> (fun s i -> s.[i]) + | Direct -> String.get | Reverse -> (fun s i -> s.[String.length s - i - 1]) let compile_ @@ -102,26 +103,28 @@ module KMP = struct | _ -> (* at least 2 elements, the algorithm can work *) let failure = Array.make len 0 in + failure.(0) <- -1; (* i: current index in str *) - let i = ref 1 in + let i = ref 2 in (* j: index of candidate substring *) let j = ref 0 in - while !i < len-1 do + while !i < len do match !j with - | _ when get str !i = get str !j -> + | _ when get str (!i-1) = get str !j -> (* substring starting at !j continues matching current char *) - i := !i+1; - j := !j+1; + incr j; failure.(!i) <- !j; + incr i; | 0 -> (* back to the beginning *) - i := !i+1; failure.(!i) <- 0; + incr i; | _ -> (* fallback for the prefix string *) assert (!j > 0); j := failure.(!j) done; + (* Format.printf "{@[failure:%a, str:%s@]}@." CCFormat.(array int) failure str; *) { failure; str; } let compile s = compile_ ~dir:Direct s @@ -139,23 +142,30 @@ module KMP = struct let i = ref idx in let j = ref 0 in let pat_len = pattern_length pattern in - while !i < len && !j < pat_len do - let c = get s !i in + while !j < pat_len && !i + !j < len do + let c = get s (!i + !j) in let expected = get pattern.str !j in if c = expected then ( (* char matches *) - i := !i + 1; j := !j + 1 + incr j; ) else ( - if !j=0 - then (* beginning of the pattern *) - i := !i + 1 - else (* follow the failure link *) - j := pattern.failure.(!j) + let fail_offset = pattern.failure.(!j) in + if fail_offset >= 0 + then ( + assert (fail_offset < !j); + (* follow the failure link *) + i := !i + !j - fail_offset; + j := fail_offset + ) else ( + (* beginning of pattern *) + j := 0; + incr i + ) ) done; if !j = pat_len - then !i - pat_len + then !i else -1 let find ~pattern s i = find_ ~dir:Direct ~pattern s i @@ -242,29 +252,20 @@ module Split = struct | SplitStop | SplitAt of int (* previous *) - (* [by_j... prefix of s_i...] ? *) - let rec _is_prefix ~by s i j = - j = String.length by - || - ( i < String.length s && - s.[i] = by.[j] && - _is_prefix ~by s (i+1) (j+1) - ) - let rec _split ~by s state = match state with | SplitStop -> None - | SplitAt prev -> _split_search ~by s prev prev - and _split_search ~by s prev i = - if i >= String.length s + | SplitAt prev -> _split_search ~by s prev + and _split_search ~by s prev = + let j = KMP.find ~pattern:by s prev in + if j < 0 then Some (SplitStop, prev, String.length s - prev) - else if _is_prefix ~by s i 0 - then Some (SplitAt (i+String.length by), prev, i-prev) - else _split_search ~by s prev (i+1) + else Some (SplitAt (j+KMP.pattern_length by), prev, j-prev) let _tuple3 x y z = x,y,z let _mkgen ~by s k = let state = ref (SplitAt 0) in + let by = KMP.compile by in fun () -> match _split ~by s !state with | None -> None @@ -277,6 +278,7 @@ module Split = struct let gen_cpy ~by s = _mkgen ~by s String.sub let _mklist ~by s k = + let by = KMP.compile by in let rec build acc state = match _split ~by s state with | None -> List.rev acc | Some (state', i, len) -> @@ -289,6 +291,7 @@ module Split = struct let list_cpy ~by s = _mklist ~by s String.sub let _mkklist ~by s k = + let by = KMP.compile by in let rec make state () = match _split ~by s state with | None -> `Nil | Some (state', i, len) -> @@ -300,6 +303,7 @@ module Split = struct let klist_cpy ~by s = _mkklist ~by s String.sub let _mkseq ~by s f k = + let by = KMP.compile by in let rec aux state = match _split ~by s state with | None -> () | Some (state', i, len) -> k (f s i len); aux state' diff --git a/src/core/CCString.mli b/src/core/CCString.mli index cfdfe959..930eadc3 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -122,6 +122,8 @@ val find_all_l : ?start:int -> sub:string -> string -> int list (*$= & ~printer:Q.Print.(list int) [1; 6] (find_all_l ~sub:"bc" "abc aabc aab") [] (find_all_l ~sub:"bc" "abd") + [76] (find_all_l ~sub:"aaaaaa" \ + "aabbaabbaaaaabbbbabababababbbbabbbabbaaababbbaaabaabbaabbaaaabbababaaaabbaabaaaaaabbbaaaabababaabaaabbaabaaaabbababbaabbaaabaabbabababbbaabababaaabaaababbbaaaabbbaabaaababbabaababbaabbaaaaabababbabaababbbaaabbabbabababaaaabaaababaaaaabbabbaabbabbbbbbbbbbbbbbaabbabbbbbabbaaabbabbbbabaaaaabbababbbaaaa") *) val mem : ?start:int -> sub:string -> string -> bool From ce6d9819735eb07d03f53c8880dd084a3df6fac0 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 9 Mar 2016 23:34:38 +0100 Subject: [PATCH 15/71] add a special case for pattern of length 1 in CCString.find --- benchs/run_benchs.ml | 14 +++-- src/core/CCString.cppo.ml | 105 ++++++++++++++++++++++++-------------- 2 files changed, 77 insertions(+), 42 deletions(-) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index 593c8da7..bb7fd23e 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -1158,7 +1158,7 @@ module Str = struct (* random string, but always returns the same for a given size *) let rand_str_ ?(among="abcdefgh") n = let module Q = Quickcheck in - let st = Random.State.make [| n |] in + let st = Random.State.make [| n + 17 |] in let gen_c = Q.Gen.oneofl (CCString.to_list among) in Q.Gen.string_size ~gen:gen_c (Q.Gen.return n) st @@ -1213,11 +1213,15 @@ module Str = struct and mk_current = match dir with | `Direct -> fun () -> CCString.find ~sub:needle haystack | `Reverse -> fun () -> CCString.rfind ~sub:needle haystack + and mk_current_compiled = match dir with + | `Direct -> let f = CCString.find ~start:0 ~sub:needle in fun () -> f haystack + | `Reverse -> let f = CCString.rfind ~sub:needle in fun () -> f haystack in assert (mk_naive () = mk_current ()); B.throughputN 3 ~repeat [ "naive", mk_naive, () ; "current", mk_current, () + ; "current_compiled", mk_current_compiled, () ] (* benchmark String.find_all *) @@ -1226,11 +1230,14 @@ module Str = struct let haystack = rand_str_ n in pp_pb needle haystack; let mk_naive () = find_all_l ~sub:needle haystack - and mk_current () = CCString.find_all_l ~sub:needle haystack in + and mk_current () = CCString.find_all_l ~sub:needle haystack + and mk_current_compiled = + let f = CCString.find_all_l ~start:0 ~sub:needle in fun () -> f haystack in assert (mk_naive () = mk_current ()); B.throughputN 3 ~repeat [ "naive", mk_naive, () ; "current", mk_current, () + ; "current_compiled", mk_current_compiled, () ] (* benchmark String.find_all on constant strings *) @@ -1252,8 +1259,7 @@ module Str = struct let () = B.Tree.register ( "string" @>>> [ "find" @>>> - [ "1" @>> app_ints (bench_find ~size:1) [100; 100_000; 500_000] - ; "3" @>> app_ints (bench_find ~size:3) [100; 100_000; 500_000] + [ "3" @>> app_ints (bench_find ~size:3) [100; 100_000; 500_000] ; "5" @>> app_ints (bench_find ~size:5) [100; 100_000; 500_000] ; "15" @>> app_ints (bench_find ~size:15) [100; 100_000; 500_000] ; "50" @>> app_ints (bench_find ~size:50) [100; 100_000; 500_000] diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index ee2ab50b..5c14f724 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -75,15 +75,15 @@ type _ direction = | Reverse : [`Reverse] direction (* we follow https://en.wikipedia.org/wiki/Knuth–Morris–Pratt_algorithm *) -module KMP = struct - type 'a pattern = { +module Find = struct + type 'a kmp_pattern = { failure : int array; str : string; } (* invariant: [length failure = length str]. We use a phantom type to avoid mixing the directions. *) - let pattern_length p = String.length p.str + let kmp_pattern_length p = String.length p.str (* access the [i]-th element of [s] according to direction [dir] *) let get_ @@ -92,8 +92,8 @@ module KMP = struct | Direct -> String.get | Reverse -> (fun s i -> s.[String.length s - i - 1]) - let compile_ - : type a. dir:a direction -> string -> a pattern + let kmp_compile_ + : type a. dir:a direction -> string -> a kmp_pattern = fun ~dir str -> let len = length str in let get = get_ ~dir in (* how to read elements of the string *) @@ -127,21 +127,21 @@ module KMP = struct (* Format.printf "{@[failure:%a, str:%s@]}@." CCFormat.(array int) failure str; *) { failure; str; } - let compile s = compile_ ~dir:Direct s - let rcompile s = compile_ ~dir:Reverse s + let kmp_compile s = kmp_compile_ ~dir:Direct s + let kmp_rcompile s = kmp_compile_ ~dir:Reverse s (* proper search function. [i] index in [s] [j] index in [pattern] [len] length of [s] *) - let find_ - : type a. dir:a direction -> pattern:a pattern -> string -> int -> int + let kmp_find_ + : type a. dir:a direction -> pattern:a kmp_pattern -> string -> int -> int = fun ~dir ~pattern s idx -> let len = length s in let get = get_ ~dir in let i = ref idx in let j = ref 0 in - let pat_len = pattern_length pattern in + let pat_len = kmp_pattern_length pattern in while !j < pat_len && !i + !j < len do let c = get s (!i + !j) in let expected = get pattern.str !j in @@ -168,34 +168,63 @@ module KMP = struct then !i else -1 - let find ~pattern s i = find_ ~dir:Direct ~pattern s i + let kmp_find ~pattern s i = kmp_find_ ~dir:Direct ~pattern s i - let rfind ~pattern s i = + let kmp_rfind ~pattern s i = let i = String.length s - i - 1 in - let res = find_ ~dir:Reverse ~pattern s i in + let res = kmp_find_ ~dir:Reverse ~pattern s i in (* adjust result: first, [res = string.length s - res -1] to convert back to real indices; then, what we got is actually the position of the end of the pattern, so we subtract the [length of the pattern -1] to obtain the real result. *) if res = ~-1 then res - else (String.length s - res) - pattern_length pattern + else (String.length s - res) - kmp_pattern_length pattern + + type 'a pattern = + | P_char of char + | P_KMP of 'a kmp_pattern + + let pattern_length = function + | P_char _ -> 1 + | P_KMP p -> kmp_pattern_length p + + let compile ~sub : [`Direct] pattern = + if length sub=1 + then P_char sub.[0] + else P_KMP (kmp_compile sub) + + let rcompile ~sub : [`Reverse] pattern = + if length sub=1 + then P_char sub.[0] + else P_KMP (kmp_rcompile sub) + + let find ~pattern s start = match pattern with + | P_char c -> + (try String.index_from s start c with Not_found -> -1) + | P_KMP pattern -> kmp_find ~pattern s start + + let rfind ~pattern s start = match pattern with + | P_char c -> + (try String.rindex_from s start c with Not_found -> -1) + | P_KMP pattern -> kmp_rfind ~pattern s start end -let find ?(start=0) ~sub s = - let pattern = KMP.compile sub in - KMP.find ~pattern s start +let find ?(start=0) ~sub = + let pattern = Find.compile ~sub in + fun s -> Find.find ~pattern s start -let find_all ?(start=0) ~sub s = - let pattern = KMP.compile sub in - let i = ref start in - fun () -> - let res = KMP.find ~pattern s !i in - if res = ~-1 then None - else ( - i := res + KMP.pattern_length pattern; - Some res - ) +let find_all ?(start=0) ~sub = + let pattern = Find.compile ~sub in + fun s -> + let i = ref start in + fun () -> + let res = Find.find ~pattern s !i in + if res = ~-1 then None + else ( + i := res + Find.pattern_length pattern; + Some res + ) let find_all_l ?start ~sub s = let rec aux acc g = match g () with @@ -206,9 +235,9 @@ let find_all_l ?start ~sub s = let mem ?start ~sub s = find ?start ~sub s >= 0 -let rfind ~sub s = - let pattern = KMP.rcompile sub in - KMP.rfind ~pattern s (String.length s-1) +let rfind ~sub = + let pattern = Find.rcompile ~sub in + fun s -> Find.rfind ~pattern s (String.length s-1) (* Replace substring [s.[pos]....s.[pos+len-1]] by [by] in [s] *) let replace_at_ ~pos ~len ~by s = @@ -229,11 +258,11 @@ let replace ?(which=`All) ~sub ~by s = if i>=0 then replace_at_ ~pos:i ~len:(String.length sub) ~by s else s | `All -> (* compile search pattern only once *) - let pattern = KMP.compile sub in + let pattern = Find.compile ~sub in let b = Buffer.create (String.length s) in let start = ref 0 in while !start < String.length s do - let i = KMP.find ~pattern s !start in + let i = Find.find ~pattern s !start in if i>=0 then ( (* between last and cur occurrences *) Buffer.add_substring b s !start (i- !start); @@ -256,16 +285,16 @@ module Split = struct | SplitStop -> None | SplitAt prev -> _split_search ~by s prev and _split_search ~by s prev = - let j = KMP.find ~pattern:by s prev in + let j = Find.find ~pattern:by s prev in if j < 0 then Some (SplitStop, prev, String.length s - prev) - else Some (SplitAt (j+KMP.pattern_length by), prev, j-prev) + else Some (SplitAt (j+Find.pattern_length by), prev, j-prev) let _tuple3 x y z = x,y,z let _mkgen ~by s k = let state = ref (SplitAt 0) in - let by = KMP.compile by in + let by = Find.compile ~sub:by in fun () -> match _split ~by s !state with | None -> None @@ -278,7 +307,7 @@ module Split = struct let gen_cpy ~by s = _mkgen ~by s String.sub let _mklist ~by s k = - let by = KMP.compile by in + let by = Find.compile ~sub:by in let rec build acc state = match _split ~by s state with | None -> List.rev acc | Some (state', i, len) -> @@ -291,7 +320,7 @@ module Split = struct let list_cpy ~by s = _mklist ~by s String.sub let _mkklist ~by s k = - let by = KMP.compile by in + let by = Find.compile ~sub:by in let rec make state () = match _split ~by s state with | None -> `Nil | Some (state', i, len) -> @@ -303,7 +332,7 @@ module Split = struct let klist_cpy ~by s = _mkklist ~by s String.sub let _mkseq ~by s f k = - let by = KMP.compile by in + let by = Find.compile ~sub:by in let rec aux state = match _split ~by s state with | None -> () | Some (state', i, len) -> k (f s i len); aux state' From 852d9c41866f8e74f1527cac7f724418143bcd75 Mon Sep 17 00:00:00 2001 From: jkloos Date: Thu, 10 Mar 2016 13:25:48 +0100 Subject: [PATCH 16/71] Added myself to the AUTHORS file. As per maintainer request. --- AUTHORS.adoc | 1 + 1 file changed, 1 insertion(+) diff --git a/AUTHORS.adoc b/AUTHORS.adoc index b1ee4699..be70282a 100644 --- a/AUTHORS.adoc +++ b/AUTHORS.adoc @@ -13,3 +13,4 @@ - Guillaume Bury (guigui) - JP Rodi - octachron (Florian Angeletti) +- Johannes Kloos From 7c9633f06fc56d2fb8988dc4a62a678e453c82d9 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 10 Mar 2016 16:34:29 +0100 Subject: [PATCH 17/71] change the semantics of `CCString.find_all` (allow overlaps) --- src/core/CCString.cppo.ml | 2 +- src/core/CCString.mli | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 5c14f724..9c72ae0c 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -222,7 +222,7 @@ let find_all ?(start=0) ~sub = let res = Find.find ~pattern s !i in if res = ~-1 then None else ( - i := res + Find.pattern_length pattern; + i := res + 1; (* possible overlap *) Some res ) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 930eadc3..79bbbadf 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -109,7 +109,8 @@ val find : ?start:int -> sub:string -> string -> int *) val find_all : ?start:int -> sub:string -> string -> int gen -(** [find_all ~sub s] finds all occurrences of [sub] in [s] +(** [find_all ~sub s] finds all occurrences of [sub] in [s], even overlapping + instances. @param start starting position in [s] @since NEXT_RELEASE *) From f3f6df104eb25e51393554bd995608e7c4c8223c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 10 Mar 2016 16:34:42 +0100 Subject: [PATCH 18/71] more benchs --- .merlin | 1 + benchs/run_benchs.ml | 10 +++++++--- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/.merlin b/.merlin index 3b321723..776492dd 100644 --- a/.merlin +++ b/.merlin @@ -26,4 +26,5 @@ PKG bigarray PKG sequence PKG hamt PKG gen +PKG QTest2Lib FLG -w +a -w -4 -w -44 diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index bb7fd23e..aabc99f6 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -1192,7 +1192,7 @@ module Str = struct let res = find ~sub s ~start:!i in if res = ~-1 then None else ( - i := res + String.length sub; + i := res + 1; Some res ) @@ -1243,7 +1243,7 @@ module Str = struct (* benchmark String.find_all on constant strings *) let bench_find_all_special ~size n = let needle = CCString.repeat "a" (size-1) ^ "b" in - let haystack = rand_str_ ~among:"ab" n in + let haystack = CCString.repeat "a" n in pp_pb needle haystack; let mk_naive () = find_all_l ~sub:needle haystack and mk_current () = CCString.find_all_l ~sub:needle haystack in @@ -1272,7 +1272,11 @@ module Str = struct ; "15" @>> app_ints (bench_find_all ~size:15) [100; 100_000; 500_000] ; "50" @>> app_ints (bench_find_all ~size:50) [100; 100_000; 500_000] ; "500" @>> app_ints (bench_find_all ~size:500) [100_000; 500_000] - ; "special" @>> app_ints (bench_find_all_special ~size:6) [100_000; 500_000] + ; "special" @>>> + [ "6" @>> app_ints (bench_find_all_special ~size:6) [100_000; 500_000] + ; "30" @>> app_ints (bench_find_all_special ~size:30) [100_000; 500_000] + ; "100" @>> app_ints (bench_find_all_special ~size:100) [100_000; 500_000] + ] ]; "rfind" @>>> [ "3" @>> app_ints (bench_rfind ~size:3) [100; 100_000; 500_000] From 3a34cc9aa8cea54c1a9d9d2a4b5c9f82a5d6f1d1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 11 Mar 2016 16:11:16 +0100 Subject: [PATCH 19/71] add `CCHet`, heterogeneous containers (table/map) indexed by keys Difference with CCMix{tbl,map} is that there is no other key than the polymorphic injection. --- _oasis | 2 +- src/data/CCHet.ml | 133 +++++++++++++++++++++++++++++++++++++++++++++ src/data/CCHet.mli | 90 ++++++++++++++++++++++++++++++ 3 files changed, 224 insertions(+), 1 deletion(-) create mode 100644 src/data/CCHet.ml create mode 100644 src/data/CCHet.mli diff --git a/_oasis b/_oasis index 437da1e2..700291cd 100644 --- a/_oasis +++ b/_oasis @@ -80,7 +80,7 @@ Library "containers_data" CCMixmap, CCRingBuffer, CCIntMap, CCPersistentArray, CCMixset, CCHashconsedSet, CCGraph, CCHashSet, CCBitField, CCHashTrie, CCBloom, CCWBTree, CCRAL, CCAllocCache, - CCImmutArray + CCImmutArray, CCHet BuildDepends: bytes # BuildDepends: bytes, bisect_ppx FindlibParent: containers diff --git a/src/data/CCHet.ml b/src/data/CCHet.ml new file mode 100644 index 00000000..ed46f1d3 --- /dev/null +++ b/src/data/CCHet.ml @@ -0,0 +1,133 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Associative containers with Heterogenerous Values} *) + +type 'a sequence = ('a -> unit) -> unit +type 'a gen = unit -> 'a option + +module Key = struct + type 'a t = int + + let create = + let _n = ref 0 in + fun () -> + incr _n; + !_n + + let id a = a + + let equal + : type a b. a t -> b t -> bool + = fun a b -> + let ia = (a : a t :> int) in + let ib = (b : b t :> int) in + ia=ib + + (* XXX: the only ugly part *) + (* [cast_res k1 k2 v2] casts [v2] into a value of type [a] if [k1=k2] *) + let cast_res_ : type a b. a t -> b t -> b -> a + = fun k1 k2 v2 -> + if k1=k2 then Obj.magic v2 else raise Not_found +end + +type pair = + | Pair : 'a Key.t * 'a -> pair + +module Tbl = struct + module M = Hashtbl.Make(struct + type t = int + let equal (i:int) j = i=j + let hash (i:int) = Hashtbl.hash i + end) + + type t = pair M.t + + let create ?(size=16) () = M.create size + + let mem t k = M.mem t (Key.id k) + + let find_exn (type a) t (k : a Key.t) : a = + let Pair (k', v) = M.find t (Key.id k) in + Key.cast_res_ k k' v + + let find t k = + try Some (find_exn t k) + with Not_found -> None + + let add_pair_ t p = + let Pair (k,_) = p in + M.replace t (Key.id k) p + + let add t k v = add_pair_ t (Pair (k,v)) + + let length t = M.length t + + let iter f t = M.iter (fun _ pair -> f pair) t + + let to_seq t yield = iter yield t + + let to_list t = M.fold (fun _ p l -> p::l) t [] + + let add_list t l = List.iter (add_pair_ t) l + + let add_seq t seq = seq (add_pair_ t) + + let of_list l = + let t = create() in + add_list t l; + t + + let of_seq seq = + let t = create() in + add_seq t seq; + t +end + +module Map = struct + module M = Map.Make(struct + type t = int + let compare (i:int) j = Pervasives.compare i j + end) + + type t = pair M.t + + let empty = M.empty + + let mem k t = M.mem (Key.id k) t + + let find_exn (type a) (k : a Key.t) t : a = + let Pair (k', v) = M.find (Key.id k) t in + Key.cast_res_ k k' v + + let find k t = + try Some (find_exn k t) + with Not_found -> None + + let add_pair_ p t = + let Pair (k,_) = p in + M.add (Key.id k) p t + + let add k v t = add_pair_ (Pair (k,v)) t + + let cardinal t = M.cardinal t + + let length = cardinal + + let iter f t = M.iter (fun _ pair -> f pair) t + + let to_seq t yield = iter yield t + + let to_list t = M.fold (fun _ p l -> p::l) t [] + + let add_list t l = List.fold_right add_pair_ l t + + let add_seq t seq = + let t = ref t in + seq (fun pair -> t := add_pair_ pair !t); + !t + + let of_list l = add_list empty l + + let of_seq seq = add_seq empty seq +end diff --git a/src/data/CCHet.mli b/src/data/CCHet.mli new file mode 100644 index 00000000..1fd33be9 --- /dev/null +++ b/src/data/CCHet.mli @@ -0,0 +1,90 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Associative containers with Heterogenerous Values} + + This is similar to {!CCMixtbl}, but the injection is directly used as + a key. + + @since NEXT_RELEASE *) + +type 'a sequence = ('a -> unit) -> unit +type 'a gen = unit -> 'a option + +module Key : sig + type 'a t + + val create : unit -> 'a t + + val equal : 'a t -> 'a t -> bool + (** Compare two keys that have compatible types *) +end + +type pair = + | Pair : 'a Key.t * 'a -> pair + +(** {2 Imperative table indexed by {!Key}} *) +module Tbl : sig + type t + + val create : ?size:int -> unit -> t + + val mem : t -> _ Key.t -> bool + + val add : t -> 'a Key.t -> 'a -> unit + + val length : t -> int + + val find : t -> 'a Key.t -> 'a option + + val find_exn : t -> 'a Key.t -> 'a + (** @raise Not_found if the key is not in the table *) + + val iter : (pair -> unit) -> t -> unit + + val to_seq : t -> pair sequence + + val of_seq : pair sequence -> t + + val add_seq : t -> pair sequence -> unit + + val add_list : t -> pair list -> unit + + val of_list : pair list -> t + + val to_list : t -> pair list +end + +(** {2 Immutable map} *) +module Map : sig + type t + + val empty : t + + val mem : _ Key.t -> t -> bool + + val add : 'a Key.t -> 'a -> t -> t + + val length : t -> int + + val cardinal : t -> int + + val find : 'a Key.t -> t -> 'a option + + val find_exn : 'a Key.t -> t -> 'a + (** @raise Not_found if the key is not in the table *) + + val iter : (pair -> unit) -> t -> unit + + val to_seq : t -> pair sequence + + val of_seq : pair sequence -> t + + val add_seq : t -> pair sequence -> t + + val add_list : t -> pair list -> t + + val of_list : pair list -> t + + val to_list : t -> pair list +end From 0c04df58b011de710ee621466fb4043750770954 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 11 Mar 2016 21:16:34 +0100 Subject: [PATCH 20/71] update CCHet to not use Obj.magic; add test --- src/data/CCHet.ml | 124 ++++++++++++++++++++++++++++++++++------------ 1 file changed, 91 insertions(+), 33 deletions(-) diff --git a/src/data/CCHet.ml b/src/data/CCHet.ml index ed46f1d3..ff86f672 100644 --- a/src/data/CCHet.ml +++ b/src/data/CCHet.ml @@ -3,37 +3,80 @@ (** {1 Associative containers with Heterogenerous Values} *) +(*$R + let k1 : int Key.t = Key.create() in + let k2 : int Key.t = Key.create() in + let k3 : string Key.t = Key.create() in + let k4 : float Key.t = Key.create() in + + let tbl = Tbl.create () in + + Tbl.add tbl k1 1; + Tbl.add tbl k2 2; + Tbl.add tbl k3 "k3"; + + assert_equal (Some 1) (Tbl.find tbl k1); + assert_equal (Some 2) (Tbl.find tbl k2); + assert_equal (Some "k3") (Tbl.find tbl k3); + assert_equal None (Tbl.find tbl k4); + assert_equal 3 (Tbl.length tbl); + + Tbl.add tbl k1 10; + assert_equal (Some 10) (Tbl.find tbl k1); + assert_equal 3 (Tbl.length tbl); + assert_equal None (Tbl.find tbl k4); + + Tbl.add tbl k4 0.0; + assert_equal (Some 0.0) (Tbl.find tbl k4); + + () + + +*) + type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option +module type KEY_IMPL = sig + type t + exception Store of t + val id : int +end + module Key = struct - type 'a t = int + type 'a t = (module KEY_IMPL with type t = 'a) - let create = - let _n = ref 0 in - fun () -> - incr _n; - !_n + let _n = ref 0 - let id a = a + let create (type k) () = + incr _n; + let id = !_n in + let module K = struct + type t = k + let id = id + exception Store of k + end in + (module K : KEY_IMPL with type t = k) + + let id (type k) (module K : KEY_IMPL with type t = k) = K.id let equal : type a b. a t -> b t -> bool - = fun a b -> - let ia = (a : a t :> int) in - let ib = (b : b t :> int) in - ia=ib - - (* XXX: the only ugly part *) - (* [cast_res k1 k2 v2] casts [v2] into a value of type [a] if [k1=k2] *) - let cast_res_ : type a b. a t -> b t -> b -> a - = fun k1 k2 v2 -> - if k1=k2 then Obj.magic v2 else raise Not_found + = fun (module K1) (module K2) -> K1.id = K2.id end type pair = | Pair : 'a Key.t * 'a -> pair +type exn_pair = + | E_pair : 'a Key.t * exn -> exn_pair + +let pair_of_e_pair (E_pair (k,e)) = + let module K = (val k) in + match e with + | K.Store v -> Pair (k,v) + | _ -> assert false + module Tbl = struct module M = Hashtbl.Make(struct type t = int @@ -41,33 +84,38 @@ module Tbl = struct let hash (i:int) = Hashtbl.hash i end) - type t = pair M.t + type t = exn_pair M.t let create ?(size=16) () = M.create size let mem t k = M.mem t (Key.id k) let find_exn (type a) t (k : a Key.t) : a = - let Pair (k', v) = M.find t (Key.id k) in - Key.cast_res_ k k' v + let module K = (val k) in + let E_pair (_, v) = M.find t K.id in + match v with + | K.Store v -> v + | _ -> assert false let find t k = try Some (find_exn t k) with Not_found -> None let add_pair_ t p = - let Pair (k,_) = p in - M.replace t (Key.id k) p + let Pair (k,v) = p in + let module K = (val k) in + let p = E_pair (k, K.Store v) in + M.replace t K.id p let add t k v = add_pair_ t (Pair (k,v)) let length t = M.length t - let iter f t = M.iter (fun _ pair -> f pair) t + let iter f t = M.iter (fun _ pair -> f (pair_of_e_pair pair)) t let to_seq t yield = iter yield t - let to_list t = M.fold (fun _ p l -> p::l) t [] + let to_list t = M.fold (fun _ p l -> pair_of_e_pair p::l) t [] let add_list t l = List.iter (add_pair_ t) l @@ -90,35 +138,45 @@ module Map = struct let compare (i:int) j = Pervasives.compare i j end) - type t = pair M.t + type t = exn_pair M.t let empty = M.empty let mem k t = M.mem (Key.id k) t let find_exn (type a) (k : a Key.t) t : a = - let Pair (k', v) = M.find (Key.id k) t in - Key.cast_res_ k k' v + let module K = (val k) in + let E_pair (_, e) = M.find K.id t in + match e with + | K.Store v -> v + | _ -> assert false let find k t = try Some (find_exn k t) with Not_found -> None - let add_pair_ p t = - let Pair (k,_) = p in - M.add (Key.id k) p t + let add_e_pair_ p t = + let E_pair ((module K),_) = p in + M.add K.id p t - let add k v t = add_pair_ (Pair (k,v)) t + let add_pair_ p t = + let Pair ((module K) as k,v) = p in + let p = E_pair (k, K.Store v) in + M.add K.id p t + + let add (type a) (k : a Key.t) v t = + let module K = (val k) in + add_e_pair_ (E_pair (k, K.Store v)) t let cardinal t = M.cardinal t let length = cardinal - let iter f t = M.iter (fun _ pair -> f pair) t + let iter f t = M.iter (fun _ p -> f (pair_of_e_pair p)) t let to_seq t yield = iter yield t - let to_list t = M.fold (fun _ p l -> p::l) t [] + let to_list t = M.fold (fun _ p l -> pair_of_e_pair p::l) t [] let add_list t l = List.fold_right add_pair_ l t From c7766d195a925fda2f2ea098e082f5b05dee18bd Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 11 Mar 2016 23:08:27 +0100 Subject: [PATCH 21/71] small comment --- doc/build_deps.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/doc/build_deps.ml b/doc/build_deps.ml index 37633b20..7763f622 100755 --- a/doc/build_deps.ml +++ b/doc/build_deps.ml @@ -1,5 +1,8 @@ #!/usr/bin/env ocaml +(* note: this requires to generate documentation first, so that + .odoc files are generated *) + #use "topfind";; #require "containers";; #require "containers.io";; From 33dd681acd62c1c6b8d2622cc9675344d748fe34 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 14 Mar 2016 20:04:52 +0100 Subject: [PATCH 22/71] update headers --- src/data/CCPersistentHashtbl.ml | 24 +----------------------- src/data/CCPersistentHashtbl.mli | 24 +----------------------- 2 files changed, 2 insertions(+), 46 deletions(-) diff --git a/src/data/CCPersistentHashtbl.ml b/src/data/CCPersistentHashtbl.ml index 1fd06f67..09abe04f 100644 --- a/src/data/CCPersistentHashtbl.ml +++ b/src/data/CCPersistentHashtbl.ml @@ -1,27 +1,5 @@ -(* -Copyright (c) 2013, Simon Cruanes -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. Redistributions in binary -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 file is free software, part of containers. See file "license" for more details. *) (** {1 Persistent hash-table on top of OCaml's hashtables} *) diff --git a/src/data/CCPersistentHashtbl.mli b/src/data/CCPersistentHashtbl.mli index 6fed4d96..1fa02fee 100644 --- a/src/data/CCPersistentHashtbl.mli +++ b/src/data/CCPersistentHashtbl.mli @@ -1,27 +1,5 @@ -(* -Copyright (c) 2013, Simon Cruanes -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. Redistributions in binary -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 file is free software, part of containers. See file "license" for more details. *) (** {1 Persistent hash-table on top of OCaml's hashtables} From d694d20b26fb81a559ef771fba928657f2154d9b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 14 Mar 2016 20:13:20 +0100 Subject: [PATCH 23/71] modify `CCPersistentHashtbl.merge` and add `CCMap.merge_safe` --- src/core/CCMap.ml | 15 +++++++++++++++ src/core/CCMap.mli | 6 ++++++ src/data/CCPersistentHashtbl.ml | 14 +++++++++----- src/data/CCPersistentHashtbl.mli | 5 +++-- 4 files changed, 33 insertions(+), 7 deletions(-) diff --git a/src/core/CCMap.ml b/src/core/CCMap.ml index d8a69a32..d9114c41 100644 --- a/src/core/CCMap.ml +++ b/src/core/CCMap.ml @@ -24,6 +24,12 @@ module type S = sig [k] is removed from [m], and if the result is [Some v'] then [add k v' m] is returned. *) + val merge_safe : + f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) -> + 'a t -> 'b t -> 'c t + (** [merge_safe ~f a b] merges the maps [a] and [b] together. + @since NEXT_RELEASE *) + val of_seq : (key * 'a) sequence -> 'a t val add_seq : 'a t -> (key * 'a) sequence -> 'a t @@ -75,6 +81,15 @@ module Make(O : Map.OrderedType) = struct | None -> remove k m | Some v' -> add k v' m + let merge_safe ~f a b = + merge + (fun k v1 v2 -> match v1, v2 with + | None, None -> assert false + | Some v1, None -> f k (`Left v1) + | None, Some v2 -> f k (`Right v2) + | Some v1, Some v2 -> f k (`Both (v1,v2))) + a b + let add_seq m s = let m = ref m in s (fun (k,v) -> m := add k v !m); diff --git a/src/core/CCMap.mli b/src/core/CCMap.mli index f03b59ff..d97c973b 100644 --- a/src/core/CCMap.mli +++ b/src/core/CCMap.mli @@ -27,6 +27,12 @@ module type S = sig [k] is removed from [m], and if the result is [Some v'] then [add k v' m] is returned. *) + val merge_safe : + f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) -> + 'a t -> 'b t -> 'c t + (** [merge_safe ~f a b] merges the maps [a] and [b] together. + @since NEXT_RELEASE *) + val of_seq : (key * 'a) sequence -> 'a t val add_seq : 'a t -> (key * 'a) sequence -> 'a t diff --git a/src/data/CCPersistentHashtbl.ml b/src/data/CCPersistentHashtbl.ml index 09abe04f..d0d7ab8b 100644 --- a/src/data/CCPersistentHashtbl.ml +++ b/src/data/CCPersistentHashtbl.ml @@ -67,8 +67,9 @@ module type S = sig (** Fresh copy of the table; the underlying structure is not shared anymore, so using both tables alternatively will be efficient *) - val merge : (key -> 'a option -> 'b option -> 'c option) -> - 'a t -> 'b t -> 'c t + val merge : + (key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) -> + 'a t -> 'b t -> 'c t (** Merge two tables together into a new table. The function's argument correspond to values associated with the key (if present); if the function returns [None] the key will not appear in the result. *) @@ -543,8 +544,11 @@ module Make(H : HashedType) : S with type key = H.t = struct let tbl = create (max (length t1) (length t2)) in let tbl = fold (fun tbl k v1 -> - let v2 = try Some (find t2 k) with Not_found -> None in - match f k (Some v1) v2 with + let comb = + try `Both (v1, find t2 k) + with Not_found -> `Left v1 + in + match f k comb with | None -> tbl | Some v' -> replace tbl k v') tbl t1 @@ -552,7 +556,7 @@ module Make(H : HashedType) : S with type key = H.t = struct fold (fun tbl k v2 -> if mem t1 k then tbl - else match f k None (Some v2) with + else match f k (`Right v2) with | None -> tbl | Some v' -> replace tbl k v' ) tbl t2 diff --git a/src/data/CCPersistentHashtbl.mli b/src/data/CCPersistentHashtbl.mli index 1fa02fee..e2b12d9d 100644 --- a/src/data/CCPersistentHashtbl.mli +++ b/src/data/CCPersistentHashtbl.mli @@ -74,8 +74,9 @@ module type S = sig (** Fresh copy of the table; the underlying structure is not shared anymore, so using both tables alternatively will be efficient *) - val merge : (key -> 'a option -> 'b option -> 'c option) -> - 'a t -> 'b t -> 'c t + val merge : + f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) -> + 'a t -> 'b t -> 'c t (** Merge two tables together into a new table. The function's argument correspond to values associated with the key (if present); if the function returns [None] the key will not appear in the result. *) From 6e46687ee8c5cbc32d4f6ccfec25969fc1b8ba3e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 14 Mar 2016 20:38:59 +0100 Subject: [PATCH 24/71] fix compilation error --- src/data/CCPersistentHashtbl.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/data/CCPersistentHashtbl.ml b/src/data/CCPersistentHashtbl.ml index d0d7ab8b..99aa4672 100644 --- a/src/data/CCPersistentHashtbl.ml +++ b/src/data/CCPersistentHashtbl.ml @@ -68,7 +68,7 @@ module type S = sig anymore, so using both tables alternatively will be efficient *) val merge : - (key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) -> + f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) -> 'a t -> 'b t -> 'c t (** Merge two tables together into a new table. The function's argument correspond to values associated with the key (if present); if the @@ -540,7 +540,7 @@ module Make(H : HashedType) : S with type key = H.t = struct false with ExitPTbl -> true - let merge f t1 t2 = + let merge ~f t1 t2 = let tbl = create (max (length t1) (length t2)) in let tbl = fold (fun tbl k v1 -> @@ -565,10 +565,10 @@ module Make(H : HashedType) : S with type key = H.t = struct let t1 = H.of_list [1, "a"; 2, "b1"] in let t2 = H.of_list [2, "b2"; 3, "c"] in let t = H.merge - (fun _ v1 v2 -> match v1, v2 with - | None, _ -> v2 - | _ , None -> v1 - | Some s1, Some s2 -> if s1 < s2 then Some s1 else Some s2) + ~f:(fun _ -> function + | `Right v2 -> Some v2 + | `Left v1 -> Some v1 + | `Both (s1,s2) -> if s1 < s2 then Some s1 else Some s2) t1 t2 in OUnit.assert_equal ~printer:string_of_int 3 (H.length t); From 71794d8d457af9821d5258f32435213e4de0923d Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 20 Mar 2016 16:02:11 +0100 Subject: [PATCH 25/71] migrate to new qtest --- .merlin | 2 +- _oasis | 4 ++-- benchs/run_benchs.ml | 2 +- src/core/CCRandom.ml | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/.merlin b/.merlin index 776492dd..f9975114 100644 --- a/.merlin +++ b/.merlin @@ -26,5 +26,5 @@ PKG bigarray PKG sequence PKG hamt PKG gen -PKG QTest2Lib +PKG qcheck FLG -w +a -w -4 -w -44 diff --git a/_oasis b/_oasis index 700291cd..23277415 100644 --- a/_oasis +++ b/_oasis @@ -155,7 +155,7 @@ Executable run_benchs CompiledObject: best Build$: flag(bench) MainIs: run_benchs.ml - BuildDepends: containers, containers.advanced, QTest2Lib, + BuildDepends: containers, containers.advanced, qcheck, containers.data, containers.string, containers.iter, containers.thread, sequence, gen, benchmark, hamt @@ -179,7 +179,7 @@ Executable run_qtest containers.io, containers.advanced, containers.sexp, containers.bigarray, containers.unix, containers.thread, containers.data, - sequence, gen, unix, oUnit, QTest2Lib + sequence, gen, unix, oUnit, qcheck Test all Command: ./run_qtest.native diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index aabc99f6..e22b7ce5 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -1157,7 +1157,7 @@ end module Str = struct (* random string, but always returns the same for a given size *) let rand_str_ ?(among="abcdefgh") n = - let module Q = Quickcheck in + let module Q = QCheck in let st = Random.State.make [| n + 17 |] in let gen_c = Q.Gen.oneofl (CCString.to_list among) in Q.Gen.string_size ~gen:gen_c (Q.Gen.return n) st diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index 9e0ad1fe..ed8ed0a4 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -213,5 +213,5 @@ let uniformity_test ?(size_hint=10) k rng st = Hashtbl.fold predicate histogram true (*$T split_list - run ~st:(Runner.random_state()) ( uniformity_test 50_000 (split_list 10 ~len:3) ) + run ~st:(QCheck_runner.random_state()) ( uniformity_test 50_000 (split_list 10 ~len:3) ) *) From 5e30104954260af622d2c495cd8208203f92ddf3 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 20 Mar 2016 23:20:46 +0100 Subject: [PATCH 26/71] optimize KMP search in CCString.Find (hand-specialize code) --- src/core/CCString.cppo.ml | 51 ++++++++++++++++++++++++++++----------- 1 file changed, 37 insertions(+), 14 deletions(-) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 9c72ae0c..d7accf93 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -134,17 +134,14 @@ module Find = struct [i] index in [s] [j] index in [pattern] [len] length of [s] *) - let kmp_find_ - : type a. dir:a direction -> pattern:a kmp_pattern -> string -> int -> int - = fun ~dir ~pattern s idx -> + let kmp_find ~pattern s idx = let len = length s in - let get = get_ ~dir in let i = ref idx in let j = ref 0 in let pat_len = kmp_pattern_length pattern in while !j < pat_len && !i + !j < len do - let c = get s (!i + !j) in - let expected = get pattern.str !j in + let c = String.get s (!i + !j) in + let expected = String.get pattern.str !j in if c = expected then ( (* char matches *) @@ -168,18 +165,44 @@ module Find = struct then !i else -1 - let kmp_find ~pattern s i = kmp_find_ ~dir:Direct ~pattern s i - - let kmp_rfind ~pattern s i = - let i = String.length s - i - 1 in - let res = kmp_find_ ~dir:Reverse ~pattern s i in + (* proper search function, from the right. + [i] index in [s] + [j] index in [pattern] + [len] length of [s] *) + let kmp_rfind ~pattern s idx = + let len = length s in + let i = ref (len - idx - 1) in + let j = ref 0 in + let pat_len = kmp_pattern_length pattern in + while !j < pat_len && !i + !j < len do + let c = String.get s (len - !i - !j - 1) in + let expected = String.get pattern.str (String.length pattern.str - !j - 1) in + if c = expected + then ( + (* char matches *) + incr j; + ) else ( + let fail_offset = pattern.failure.(!j) in + if fail_offset >= 0 + then ( + assert (fail_offset < !j); + (* follow the failure link *) + i := !i + !j - fail_offset; + j := fail_offset + ) else ( + (* beginning of pattern *) + j := 0; + incr i + ) + ) + done; (* adjust result: first, [res = string.length s - res -1] to convert back to real indices; then, what we got is actually the position of the end of the pattern, so we subtract the [length of the pattern -1] to obtain the real result. *) - if res = ~-1 - then res - else (String.length s - res) - kmp_pattern_length pattern + if !j = pat_len + then len - !i - kmp_pattern_length pattern + else -1 type 'a pattern = | P_char of char From 6e905a839d3cd1c8d3ce9127131543bcf8f4f161 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 22 Mar 2016 11:14:11 +0100 Subject: [PATCH 27/71] more iterations for some tests --- src/core/CCString.mli | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 79bbbadf..f6cda140 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -102,7 +102,7 @@ val find : ?start:int -> sub:string -> string -> int 6 (find ~sub:"a" ~start:5 "a1a234a") *) -(*$Q & ~count:300 +(*$Q & ~count:10_000 Q.(pair printable_string printable_string) (fun (s1,s2) -> \ let i = find ~sub:s2 s1 in \ i < 0 || String.sub s1 i (length s2) = s2) @@ -149,7 +149,7 @@ val rfind : sub:string -> string -> int 6 (rfind ~sub:"a" "a1a234a") *) -(*$Q & ~count:300 +(*$Q & ~count:10_000 Q.(pair printable_string printable_string) (fun (s1,s2) -> \ let i = rfind ~sub:s2 s1 in \ i < 0 || String.sub s1 i (length s2) = s2) From a039add6e749b10bb260af93bacf51eb3870a04f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 22 Mar 2016 18:42:08 +0100 Subject: [PATCH 28/71] add `Containers.{Char,Result}` --- src/core/containers.ml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/core/containers.ml b/src/core/containers.ml index d38654de..21b95f65 100644 --- a/src/core/containers.ml +++ b/src/core/containers.ml @@ -80,3 +80,12 @@ module Vector = CCVector module Int64 = CCInt64 (** @since 0.13 *) + +module Char = struct + include Char + include (CCChar : module type of CCChar with type t := t) +end +(** @since NEXT_RELEASE *) + +module Result = CCResult +(** @since NEXT_RELEASE *) From ef4c86d8a1199537141630e31599fe49cbe3d0f6 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 24 Mar 2016 18:24:24 +0100 Subject: [PATCH 29/71] add `CCString.pad` for more webscale --- src/core/CCString.cppo.ml | 9 +++++++++ src/core/CCString.mli | 16 ++++++++++++++++ 2 files changed, 25 insertions(+) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index d7accf93..155892eb 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -433,6 +433,15 @@ let fold f acc s = else fold_rec f (f acc s.[i]) s (i+1) in fold_rec f acc s 0 +let pad ?(side=`Left) ?(c=' ') n s = + let len_s = String.length s in + if len_s >= n then s + else + let pad_len = n - len_s in + match side with + | `Left -> init n (fun i -> if i < pad_len then c else s.[i-pad_len]) + | `Right -> init n (fun i -> if i < len_s then s.[i] else c) + let _to_gen s i0 len = let i = ref i0 in fun () -> diff --git a/src/core/CCString.mli b/src/core/CCString.mli index f6cda140..6720bf1c 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -78,6 +78,22 @@ val rev : string -> string " " (rev " ") *) +val pad : ?side:[`Left|`Right] -> ?c:char -> int -> string -> string +(** [pad n str] ensures that [str] is at least [n] bytes long, + and pads it on the [side] with [c] if it's not the case. + @param side determines where padding occurs (default: [`Left]) + @param c the char used to pad (default: ' ') + @since NEXT_RELEASE *) + +(*$= & ~printer:Q.Print.string + " 42" (pad 4 "42") + "0042" (pad ~c:'0' 4 "42") + "4200" (pad ~side:`Right ~c:'0' 4 "42") + "hello" (pad 4 "hello") + "aaa" (pad ~c:'a' 3 "") + "aaa" (pad ~side:`Right ~c:'a' 3 "") +*) + val of_gen : char gen -> string val of_seq : char sequence -> string val of_klist : char klist -> string From 6ccad958c490506f19afa97583b5102782537b7a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 26 Mar 2016 11:53:58 +0100 Subject: [PATCH 30/71] make some tests a bit faster --- src/threads/CCPool.ml | 2 +- src/threads/CCTimer.ml | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/threads/CCPool.ml b/src/threads/CCPool.ml index 86ea2bf5..401863ca 100644 --- a/src/threads/CCPool.ml +++ b/src/threads/CCPool.ml @@ -264,7 +264,7 @@ module Make(P : PARAM) = struct let l = List.rev_map (fun i -> Fut.make (fun () -> - Thread.delay 0.1; + Thread.delay 0.05; 1 )) l in let l' = List.map Fut.get l in diff --git a/src/threads/CCTimer.ml b/src/threads/CCTimer.ml index cb4739dd..3fd93934 100644 --- a/src/threads/CCTimer.ml +++ b/src/threads/CCTimer.ml @@ -184,12 +184,12 @@ let stop timer = let timer = create () in let n = CCLock.create 1 in let res = CCLock.create 0 in - after timer 0.6 + after timer 0.3 ~f:(fun () -> CCLock.update n (fun x -> x+2)); ignore (Thread.create - (fun _ -> Thread.delay 0.8; CCLock.set res (CCLock.get n)) ()); - after timer 0.4 + (fun _ -> Thread.delay 0.4; CCLock.set res (CCLock.get n)) ()); + after timer 0.2 ~f:(fun () -> CCLock.update n (fun x -> x * 4)); - Thread.delay 1. ; + Thread.delay 0.6 ; OUnit.assert_equal 6 (CCLock.get res); *) From 8d41623ba50d20b64b7e1e0e8509cf0e0133fe27 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 26 Mar 2016 12:05:31 +0100 Subject: [PATCH 31/71] add `{CCArray,CCVector,CCList}.(--^)` for right-open ranges --- src/core/CCArray.ml | 22 ++++++++++++++++++++++ src/core/CCArray.mli | 4 ++++ src/core/CCList.ml | 8 ++++++++ src/core/CCList.mli | 7 +++++++ src/core/CCVector.ml | 16 ++++++++++++++++ src/core/CCVector.mli | 5 +++++ 6 files changed, 62 insertions(+) diff --git a/src/core/CCArray.ml b/src/core/CCArray.ml index de3b8b43..848952a6 100644 --- a/src/core/CCArray.ml +++ b/src/core/CCArray.ml @@ -443,6 +443,28 @@ let (--) i j = else Array.init (i-j+1) (fun k -> i-k) +(*$T + (1 -- 4) |> Array.to_list = [1;2;3;4] + (4 -- 1) |> Array.to_list = [4;3;2;1] + (0 -- 0) |> Array.to_list = [0] +*) + +(*$Q + Q.(pair small_int small_int) (fun (a,b) -> \ + (a -- b) |> Array.to_list = CCList.(a -- b)) +*) + +let (--^) i j = + if i=j then [| |] + else if i>j + then Array.init (i-j) (fun k -> i-k) + else Array.init (j-i) (fun k -> i+k) + +(*$Q + Q.(pair small_int small_int) (fun (a,b) -> \ + (a --^ b) |> Array.to_list = CCList.(a --^ b)) +*) + (** all the elements of a, but the i-th, into a list *) let except_idx a i = foldi diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index dd87dd40..71853a1e 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -166,6 +166,10 @@ val except_idx : 'a t -> int -> 'a list val (--) : int -> int -> int t (** Range array *) +val (--^) : int -> int -> int t +(** Range array, excluding right bound + @since NEXT_RELEASE *) + val random : 'a random_gen -> 'a t random_gen val random_non_empty : 'a random_gen -> 'a t random_gen val random_len : int -> 'a random_gen -> 'a t random_gen diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 5d926df0..09a7d067 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -763,11 +763,18 @@ let range' i j = let (--) = range +let (--^) = range' + (*$T append (range 0 100) (range 101 1000) = range 0 1000 append (range 1000 501) (range 500 0) = range 1000 0 *) +(*$Q + Q.(pair small_int small_int) (fun (a,b) -> \ + let l = (a--^b) in not (List.mem b l)) +*) + let replicate i x = let rec aux acc i = if i = 0 then acc @@ -1103,6 +1110,7 @@ module Infix = struct let (<$>) = (<$>) let (>>=) = (>>=) let (--) = (--) + let (--^) = (--^) end (** {2 IO} *) diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 8a9afb25..5da90920 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -263,6 +263,10 @@ val range' : int -> int -> int t val (--) : int -> int -> int t (** Infix alias for [range] *) +val (--^) : int -> int -> int t +(** Infix alias for [range'] + @since NEXT_RELEASE *) + val replicate : int -> 'a -> 'a t (** Replicate the given element [n] times *) @@ -482,6 +486,9 @@ module Infix : sig val (<$>) : ('a -> 'b) -> 'a t -> 'b t val (>>=) : 'a t -> ('a -> 'b t) -> 'b t val (--) : int -> int -> int t + + val (--^) : int -> int -> int t + (** @since NEXT_RELEASE *) end (** {2 IO} *) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 6eb571e0..0fce2699 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -631,12 +631,28 @@ let (--) i j = then init (i-j+1) (fun k -> i-k) else init (j-i+1) (fun k -> i+k) +(*$Q + Q.(pair small_int small_int) (fun (a,b) -> \ + (a -- b) |> to_list = CCList.(a -- b)) +*) + +let (--^) i j = + if i=j then create() + else if i>j + then init (i-j) (fun k -> i-k) + else init (j-i) (fun k -> i+k) + (*$T (1 -- 4) |> to_list = [1;2;3;4] (4 -- 1) |> to_list = [4;3;2;1] (0 -- 0) |> to_list = [0] *) +(*$Q + Q.(pair small_int small_int) (fun (a,b) -> \ + (a --^ b) |> to_list = CCList.(a --^ b)) +*) + let of_array a = if Array.length a = 0 then create () diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index ea9088d9..10b5c17d 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -237,6 +237,11 @@ val (--) : int -> int -> (int, 'mut) t therefore the result is never empty). Example: [1 -- 10] returns the vector [[1;2;3;4;5;6;7;8;9;10]] *) +val (--^) : int -> int -> (int, 'mut) t +(** Range of integers, either ascending or descending, but excluding right., + Example: [1 --^ 10] returns the vector [[1;2;3;4;5;6;7;8;9]] + @since NEXT_RELEASE *) + val of_array : 'a array -> ('a, 'mut) t val of_list : 'a list -> ('a, 'mut) t val to_array : ('a,_) t -> 'a array From cbe060fd036dbfc754cfd35cd3aaccfc927b2461 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 26 Mar 2016 12:08:07 +0100 Subject: [PATCH 32/71] headers --- src/unix/CCUnix.ml | 24 +----------------------- src/unix/CCUnix.mli | 24 +----------------------- 2 files changed, 2 insertions(+), 46 deletions(-) diff --git a/src/unix/CCUnix.ml b/src/unix/CCUnix.ml index 09ee3022..7a9e9e02 100644 --- a/src/unix/CCUnix.ml +++ b/src/unix/CCUnix.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2015, simon cruanes -all rights reserved. -redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. redistributions in binary -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 file is free software, part of containers. See file "license" for more details. *) (** {1 High-level Functions on top of Unix} *) diff --git a/src/unix/CCUnix.mli b/src/unix/CCUnix.mli index 82b29502..8bcf017c 100644 --- a/src/unix/CCUnix.mli +++ b/src/unix/CCUnix.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2015, simon cruanes -all rights reserved. -redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. redistributions in binary -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 file is free software, part of containers. See file "license" for more details. *) (** {1 High-level Functions on top of Unix} From 0d2fc07e523ecd5da2e57f12697865385ee5c35b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 26 Mar 2016 12:08:20 +0100 Subject: [PATCH 33/71] move tests --- src/core/CCVector.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 0fce2699..d1290cf5 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -631,6 +631,12 @@ let (--) i j = then init (i-j+1) (fun k -> i-k) else init (j-i+1) (fun k -> i+k) +(*$T + (1 -- 4) |> to_list = [1;2;3;4] + (4 -- 1) |> to_list = [4;3;2;1] + (0 -- 0) |> to_list = [0] +*) + (*$Q Q.(pair small_int small_int) (fun (a,b) -> \ (a -- b) |> to_list = CCList.(a -- b)) @@ -642,12 +648,6 @@ let (--^) i j = then init (i-j) (fun k -> i-k) else init (j-i) (fun k -> i+k) -(*$T - (1 -- 4) |> to_list = [1;2;3;4] - (4 -- 1) |> to_list = [4;3;2;1] - (0 -- 0) |> to_list = [0] -*) - (*$Q Q.(pair small_int small_int) (fun (a,b) -> \ (a --^ b) |> to_list = CCList.(a --^ b)) From 03350031a3d4c1cbeeab3d356aff9f463a9457c1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 26 Mar 2016 12:21:20 +0100 Subject: [PATCH 34/71] small cleanup --- src/core/CCIO.ml | 29 +++++++++++++---------------- 1 file changed, 13 insertions(+), 16 deletions(-) diff --git a/src/core/CCIO.ml b/src/core/CCIO.ml index 5de7ed60..b3c1231a 100644 --- a/src/core/CCIO.ml +++ b/src/core/CCIO.ml @@ -49,15 +49,18 @@ let gen_flat_map f next_elem = in next +let finally_ f x ~h = + try + let res = f x in + h x; + res + with e -> + h x; + raise e + let with_in ?(mode=0o644) ?(flags=[Open_text]) filename f = let ic = open_in_gen (Open_rdonly::flags) mode filename in - try - let x = f ic in - close_in ic; - x - with e -> - close_in ic; - raise e + finally_ f ic ~h:close_in let read_chunks ?(size=1024) ic = let buf = Bytes.create size in @@ -139,13 +142,7 @@ let read_all ?(size=1024) ic = read_all_ ~op:Ret_string ~size ic let with_out ?(mode=0o644) ?(flags=[Open_creat; Open_trunc; Open_text]) filename f = let oc = open_out_gen (Open_wronly::flags) mode filename in - try - let x = f oc in - close_out oc; - x - with e -> - close_out oc; - raise e + finally_ f oc ~h:close_out let with_out_a ?mode ?(flags=[]) filename f = with_out ?mode ~flags:(Open_wronly::Open_creat::Open_append::flags) filename f @@ -323,8 +320,8 @@ module File = struct gen_filter_map (function | `File, f -> Some f - | `Dir, _ -> None - ) (walk d) + | `Dir, _ -> None) + (walk d) else read_dir_base d let show_walk_item (i,f) = From 13dad5b6ac7197dbcdbb9daa86937e184dc11659 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 26 Mar 2016 12:22:25 +0100 Subject: [PATCH 35/71] add `CCIO.File.with_temp` for creating temporary files --- src/core/CCIO.ml | 4 ++++ src/core/CCIO.mli | 10 ++++++++++ 2 files changed, 14 insertions(+) diff --git a/src/core/CCIO.ml b/src/core/CCIO.ml index b3c1231a..b8c12cca 100644 --- a/src/core/CCIO.ml +++ b/src/core/CCIO.ml @@ -329,4 +329,8 @@ module File = struct | `File -> "file:" | `Dir -> "dir:" ) ^ f + + let with_temp ?temp_dir ~prefix ~suffix f = + let name = Filename.temp_file ?temp_dir prefix suffix in + finally_ f name ~h:remove_noerr end diff --git a/src/core/CCIO.mli b/src/core/CCIO.mli index 92e6a119..98134e4d 100644 --- a/src/core/CCIO.mli +++ b/src/core/CCIO.mli @@ -195,4 +195,14 @@ module File : sig symlinks, etc.) *) val show_walk_item : walk_item -> string + + val with_temp : + ?temp_dir:string -> prefix:string -> suffix:string -> + (string -> 'a) -> 'a + (** [with_temp ~prefix ~suffix f] will call [f] with the name of a new + temporary file (located in [temp_dir]). + After [f] returns, the file is deleted. Best to be used in + combination with {!with_out}. + See {!Filename.temp_file} + @since NEXT_RELEASE *) end From eea9d8139e5f10eab037dfeb9e4688d0c0f5c38d Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 26 Mar 2016 12:31:00 +0100 Subject: [PATCH 36/71] additional test for CCParse (using temp file) --- src/string/CCParse.ml | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/src/string/CCParse.ml b/src/string/CCParse.ml index ab1235a5..db34c1ec 100644 --- a/src/string/CCParse.ml +++ b/src/string/CCParse.ml @@ -121,6 +121,31 @@ exception ParseError of line_num * col_num * (unit -> string) *) +(* test with a temporary file *) +(*$R + let test n = + let p = CCParse.(U.list ~sep:"," U.int) in + + let l = CCList.(1 -- n) in + let l' = + CCIO.File.with_temp ~temp_dir:"/tmp/" + ~prefix:"containers_test" ~suffix:"" + (fun name -> + (* write test into file *) + CCIO.with_out name + (fun oc -> + let fmt = Format.formatter_of_out_channel oc in + Format.fprintf fmt "@[%a@]@." + (CCList.print ~sep:"," ~start:"[" ~stop:"]" CCInt.print) l); + (* parse it back *) + CCParse.parse_file_exn ~size:1024 ~file:name ~p) + in + assert_equal ~printer:Q.Print.(list int) l l' + in + test 100_000; + test 400_000; +*) + let const_ x () = x let input_of_string s = From 22b001c60090ec68a54d4af074dbc578a89bdc09 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 29 Mar 2016 11:52:16 +0200 Subject: [PATCH 37/71] add `CCList.fold_filter_map` --- src/core/CCList.ml | 15 +++++++++++++++ src/core/CCList.mli | 5 +++++ 2 files changed, 20 insertions(+) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 09a7d067..1416e5d0 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -174,6 +174,21 @@ let fold_map2 f acc l1 l2 = with Invalid_argument _ -> true) *) +let fold_filter_map f acc l = + let rec aux f acc map_acc l = match l with + | [] -> acc, List.rev map_acc + | x :: l' -> + let acc, y = f acc x in + aux f acc (cons_maybe y map_acc) l' + in + aux f acc [] l + +(*$= & ~printer:Q.Print.(pair int (list int)) + (List.fold_left (+) 0 (1--10), [2;4;6;8;10]) \ + (fold_filter_map (fun acc x -> acc+x, if x mod 2 = 0 then Some x else None) \ + 0 (1--10)) +*) + let fold_flat_map f acc l = let rec aux f acc map_acc l = match l with | [] -> acc, List.rev map_acc diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 5da90920..a3cacac1 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -53,6 +53,11 @@ val fold_map2 : ('acc -> 'a -> 'b -> 'acc * 'c) -> 'acc -> 'a list -> 'b list -> @raise Invalid_argument if the lists do not have the same length @since 0.16 *) +val fold_filter_map : ('acc -> 'a -> 'acc * 'b option) -> 'acc -> 'a list -> 'acc * 'b list +(** [fold_filter_map f acc l] is a [fold_left]-like function, but also + generates a list of output in a way similar to {!filter_map} + @since NEXT_RELEASE *) + val fold_flat_map : ('acc -> 'a -> 'acc * 'b list) -> 'acc -> 'a list -> 'acc * 'b list (** [fold_flat_map f acc l] is a [fold_left]-like function, but it also maps the list to a list of lists that is then [flatten]'d.. From 2e5a360bcd349614cc45b50a8aff537de2887342 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 3 Apr 2016 00:01:53 +0200 Subject: [PATCH 38/71] fix for qtest 2.2 --- benchs/run_benchs.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index e22b7ce5..beb35bde 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -1159,8 +1159,8 @@ module Str = struct let rand_str_ ?(among="abcdefgh") n = let module Q = QCheck in let st = Random.State.make [| n + 17 |] in - let gen_c = Q.Gen.oneofl (CCString.to_list among) in - Q.Gen.string_size ~gen:gen_c (Q.Gen.return n) st + let gen_c = QCheck.Gen.oneofl (CCString.to_list among) in + QCheck.Gen.string_size ~gen:gen_c (QCheck.Gen.return n) st let find ?(start=0) ~sub s = let n = String.length sub in From 4bb65a67df93e97de7561ce4973bbe929f09c7d7 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 5 Apr 2016 14:25:30 +0200 Subject: [PATCH 39/71] more benchs --- benchs/run_benchs.ml | 40 +++++++++++++++++++++++++++++++++++----- 1 file changed, 35 insertions(+), 5 deletions(-) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index beb35bde..0c7323bd 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -42,14 +42,24 @@ module L = struct else if x mod 5 = 1 then [x;x+1] else [x;x+1;x+2;x+3] + let f_ral_ x = + if x mod 10 = 0 then CCRAL.empty + else if x mod 5 = 1 then CCRAL.of_list [x;x+1] + else CCRAL.of_list [x;x+1;x+2;x+3] + let bench_flat_map ?(time=2) n = let l = CCList.(1 -- n) in - let flatten_map_ l = List.flatten (CCList.map f_ l) - and flatten_ccmap_ l = List.flatten (List.map f_ l) in + let ral = CCRAL.of_list l in + let flatten_map_ l () = ignore @@ List.flatten (CCList.map f_ l) + and flatmap l () = ignore @@ CCList.flat_map f_ l + and flatten_ccmap_ l () = ignore @@ List.flatten (List.map f_ l) + and flatmap_ral_ l () = ignore @@ CCRAL.flat_map f_ral_ l + in B.throughputN time ~repeat - [ "flat_map", CCList.flat_map f_, l - ; "flatten o CCList.map", flatten_ccmap_, l - ; "flatten o map", flatten_map_, l + [ "flat_map", flatmap l, () + ; "flatten o CCList.map", flatten_ccmap_ l, () + ; "flatten o map", flatten_map_ l, () + ; "ral_flatmap", flatmap_ral_ ral, () ] (* APPEND *) @@ -87,6 +97,21 @@ module L = struct ; "CCList.(fold_right append)", cc_fold_right_append_, l ] + (* RANDOM ACCESS *) + + let bench_nth ?(time=2) n = + let l = CCList.(1 -- n) in + let ral = CCRAL.of_list l in + let bench_list l () = + for i = 0 to n-1 do ignore (List.nth l i) done + and bench_ral l () = + for i = 0 to n-1 do ignore (CCRAL.get_exn l i) done + in + B.throughputN time ~repeat + [ "List.nth", bench_list l, () + ; "RAL.get", bench_ral ral, () + ] + (* MAIN *) let () = B.Tree.register ( @@ -112,6 +137,11 @@ module L = struct [ app_int (bench_append ~time:2) 100 ; app_int (bench_append ~time:2) 10_000 ; app_int (bench_append ~time:4) 100_000] + ; "nth" @>> + B.Tree.concat + [ app_int (bench_nth ~time:2) 100 + ; app_int (bench_nth ~time:2) 10_000 + ; app_int (bench_nth ~time:4) 100_000] ] ) end From f8bb365c94a94135a87a9525aba7a40cca28499e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 5 Apr 2016 14:38:49 +0200 Subject: [PATCH 40/71] implement `CCString.{drop,take,chop_prefix,chop_suffix,filter,filter_map}` --- src/core/CCString.cppo.ml | 37 ++++++++++++++++++++++++ src/core/CCString.mli | 59 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 96 insertions(+) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 155892eb..b476f92f 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -424,6 +424,27 @@ let suffix ~suf s = !i = String.length suf ) +let take n s = + if n < String.length s + then String.sub s 0 n + else s + +let drop n s = + if n < String.length s + then String.sub s n (String.length s - n) + else "" + +let take_drop n s = take n s, drop n s + +let chop_suffix ~suf s = + if suffix ~suf s + then Some (String.sub s 0 (String.length s-String.length suf)) + else None + +let chop_prefix ~pre s = + if prefix ~pre s + then Some (String.sub s (String.length pre) (String.length s-String.length pre)) + else None let blit = String.blit @@ -547,6 +568,22 @@ let mapi f s = init (length s) (fun i -> f i s.[i]) #endif +let filter_map f s = + let buf = Buffer.create (String.length s) in + iter + (fun c -> match f c with + | None -> () + | Some c' -> Buffer.add_char buf c') + s; + Buffer.contents buf + +let filter f s = + let buf = Buffer.create (String.length s) in + iter + (fun c -> if f c then Buffer.add_char buf c) + s; + Buffer.contents buf + let flat_map ?sep f s = let buf = Buffer.create (String.length s) in iteri diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 6720bf1c..9cf809ba 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -219,6 +219,46 @@ val suffix : suf:string -> string -> bool not (suffix ~suf:"abcd" "cd") *) +val chop_prefix : pre:string -> string -> string option +(** [chop_pref ~pre s] removes [pre] from [s] if [pre] really is a prefix + of [s], returns [None] otherwise + @since NEXT_RELEASE *) + +(*$= & ~printer:Q.Print.(option string) + (Some "cd") (chop_prefix ~pre:"aab" "aabcd") + None (chop_prefix ~pre:"ab" "aabcd") + None (chop_prefix ~pre:"abcd" "abc") +*) + +val chop_suffix : suf:string -> string -> string option +(** [chop_suffix ~suf s] removes [suf] from [s] if [suf] really is a suffix + of [s], returns [None] otherwise + @since NEXT_RELEASE *) + +(*$= & ~printer:Q.Print.(option string) + (Some "ab") (chop_suffix ~suf:"cd" "abcd") + None (chop_suffix ~suf:"cd" "abcde") + None (chop_suffix ~suf:"abcd" "cd") +*) + +val take : int -> string -> string +(** [take n s] keeps only the [n] first chars of [s] + @since NEXT_RELEASE *) + +val drop : int -> string -> string +(** [drop n s] removes the [n] first chars of [s] + @since NEXT_RELEASE *) + +val take_drop : int -> string -> string * string +(** [take_drop n s = take n s, drop n s] + @since NEXT_RELEASE *) + +(*$= + ("ab", "cd") (take_drop 2 "abcd") + ("abc", "") (take_drop 3 "abc") + ("abc", "") (take_drop 5 "abc") +*) + val lines : string -> string list (** [lines s] returns a list of the lines of [s] (splits along '\n') @since 0.10 *) @@ -272,6 +312,25 @@ val mapi : (int -> char -> char) -> string -> string (** Map chars with their index @since 0.12 *) +val filter_map : (char -> char option) -> string -> string +(** @since NEXT_RELEASE *) + +(*$= & ~printer:Q.Print.string + "bcef" (filter_map \ + (function 'c' -> None | c -> Some (Char.chr (Char.code c + 1))) "abcde") +*) + +val filter : (char -> bool) -> string -> string +(** @since NEXT_RELEASE *) + +(*$= & ~printer:Q.Print.string + "abde" (filter (function 'c' -> false | _ -> true) "abcdec") +*) + +(*$Q + Q.printable_string (fun s -> filter (fun _ -> true) s = s) +*) + val flat_map : ?sep:string -> (char -> string) -> string -> string (** Map each chars to a string, then concatenates them all @param sep optional separator between each generated string From de859a844d998744da229a5a843e12ac406fa6b3 Mon Sep 17 00:00:00 2001 From: jkloos Date: Tue, 5 Apr 2016 16:27:30 +0200 Subject: [PATCH 41/71] Added map/mapi to some of the map types. --- src/data/CCIntMap.ml | 12 ++++++++++++ src/data/CCIntMap.mli | 4 ++++ src/data/CCTrie.ml | 33 +++++++++++++++++++++++++++++++++ src/data/CCTrie.mli | 6 ++++++ src/data/CCWBTree.ml | 14 ++++++++++++++ src/data/CCWBTree.mli | 6 ++++++ 6 files changed, 75 insertions(+) diff --git a/src/data/CCIntMap.ml b/src/data/CCIntMap.ml index 63a16c3a..227ea9a4 100644 --- a/src/data/CCIntMap.ml +++ b/src/data/CCIntMap.ml @@ -287,6 +287,18 @@ let rec fold f t acc = match t with let cardinal t = fold (fun _ _ n -> n+1) t 0 +let rec mapi f t = match t with + | E -> E + | L (k, v) -> L (k, f k v) + | N (p, s, l, r) -> + N (p, s, mapi f l, mapi f r) + +let rec map f t = match t with + | E -> E + | L (k, v) -> L (k, f v) + | N (p, s, l, r) -> + N (p, s, map f l, map f r) + let rec choose_exn = function | E -> raise Not_found | L (k, v) -> k, v diff --git a/src/data/CCIntMap.mli b/src/data/CCIntMap.mli index d3622db9..c4a7901d 100644 --- a/src/data/CCIntMap.mli +++ b/src/data/CCIntMap.mli @@ -66,6 +66,10 @@ val iter : (int -> 'a -> unit) -> 'a t -> unit val fold : (int -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b +val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t + +val map : ('a -> 'b) -> 'a t -> 'b t + val choose : 'a t -> (int * 'a) option val choose_exn : 'a t -> int * 'a diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml index 36b0ddf3..c161c7d7 100644 --- a/src/data/CCTrie.ml +++ b/src/data/CCTrie.ml @@ -75,6 +75,12 @@ module type S = sig val fold : ('b -> key -> 'a -> 'b) -> 'b -> 'a t -> 'b (** Fold on key/value bindings. Will use {!WORD.of_list} to rebuild keys. *) + val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t + (** Map values in the try. Will use {!WORD.of_list} to rebuild keys. *) + + val map : ('a -> 'b) -> 'a t -> 'b t + (** Map values in the try, not giving keys to the mapping function. *) + val iter : (key -> 'a -> unit) -> 'a t -> unit (** Same as {!fold}, but for effectful functions *) @@ -356,6 +362,33 @@ module Make(W : WORD) = struct T.fold (fun acc k v -> (k,v) :: acc) [] t1 \ |> List.sort Pervasives.compare = List.sort Pervasives.compare l1 *) + let mapi f t = + let rec map_ prefix t = match t with + | Empty -> Empty + | Cons (c, t') -> Cons (c, map_ (_difflist_add prefix c) t') + | Node (v, map) -> + let v' = match v with + | None -> None + | Some v -> Some (f (W.of_list (prefix [])) v) + in let map' = + M.mapi (fun c t' -> + let prefix' = _difflist_add prefix c in + map_ prefix' t') + map + in Node (v', map') + in map_ _id t + + let map f t = + let rec map_ = function + | Empty -> Empty + | Cons (c, t') -> Cons (c, map_ t') + | Node (v, map) -> + let v' = match v with + | None -> None + | Some v -> Some (f v) + in let map' = M.map map_ map + in Node (v', map') + in map_ t let iter f t = _fold diff --git a/src/data/CCTrie.mli b/src/data/CCTrie.mli index cc0c7505..5c49c1a5 100644 --- a/src/data/CCTrie.mli +++ b/src/data/CCTrie.mli @@ -75,6 +75,12 @@ module type S = sig val fold : ('b -> key -> 'a -> 'b) -> 'b -> 'a t -> 'b (** Fold on key/value bindings. Will use {!WORD.of_list} to rebuild keys. *) + val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t + (** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys. *) + + val map : ('a -> 'b) -> 'a t -> 'b t + (** Map values, giving only the value. *) + val iter : (key -> 'a -> unit) -> 'a t -> unit (** Same as {!fold}, but for effectful functions *) diff --git a/src/data/CCWBTree.ml b/src/data/CCWBTree.ml index d7c0b895..bdff0d45 100644 --- a/src/data/CCWBTree.ml +++ b/src/data/CCWBTree.ml @@ -97,6 +97,10 @@ module type S = sig val fold : f:('b -> key -> 'a -> 'b) -> x:'b -> 'a t -> 'b + val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t + + val map : f:('a -> 'b) -> 'a t -> 'b t + val iter : f:(key -> 'a -> unit) -> 'a t -> unit val split : key -> 'a t -> 'a t * 'a option * 'a t @@ -368,6 +372,16 @@ module MakeFull(K : KEY) : S with type key = K.t = struct let acc = f acc k v in fold ~f ~x:acc r + let rec mapi ~f = function + | E -> E + | N (k, v, l, r, w) -> + N (k, f k v, mapi ~f l, mapi ~f r, w) + + let rec map ~f = function + | E -> E + | N (k, v, l, r, w) -> + N (k, f v, map ~f l, map ~f r, w) + let rec iter ~f m = match m with | E -> () | N (k, v, l, r, _) -> diff --git a/src/data/CCWBTree.mli b/src/data/CCWBTree.mli index f1f89065..a419de1b 100644 --- a/src/data/CCWBTree.mli +++ b/src/data/CCWBTree.mli @@ -62,6 +62,12 @@ module type S = sig val fold : f:('b -> key -> 'a -> 'b) -> x:'b -> 'a t -> 'b + val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t + (** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys. *) + + val map : f:('a -> 'b) -> 'a t -> 'b t + (** Map values, giving only the value. *) + val iter : f:(key -> 'a -> unit) -> 'a t -> unit val split : key -> 'a t -> 'a t * 'a option * 'a t From de2244641b04a2c40488a7d4a630780afcf11f7b Mon Sep 17 00:00:00 2001 From: jkloos Date: Tue, 5 Apr 2016 16:39:05 +0200 Subject: [PATCH 42/71] Added tests. --- src/data/CCTrie.ml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml index c161c7d7..6e9790bc 100644 --- a/src/data/CCTrie.ml +++ b/src/data/CCTrie.ml @@ -362,6 +362,7 @@ module Make(W : WORD) = struct T.fold (fun acc k v -> (k,v) :: acc) [] t1 \ |> List.sort Pervasives.compare = List.sort Pervasives.compare l1 *) + let mapi f t = let rec map_ prefix t = match t with | Empty -> Empty @@ -377,6 +378,11 @@ module Make(W : WORD) = struct map in Node (v', map') in map_ _id t + (*$T + T.mapi (fun k v -> v ^ "!") t1 \ + |> T.to_list |> List.sort Pervasives.compare =\ + List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Pervasives.compare + *) let map f t = let rec map_ = function @@ -389,6 +395,12 @@ module Make(W : WORD) = struct in let map' = M.map map_ map in Node (v', map') in map_ t + (*$T + T.map (fun v -> v ^ "!") t1 \ + |> T.to_list |> List.sort Pervasives.compare =\ + List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Pervasives.compare + *) + let iter f t = _fold From ec3c8819397e7357a577abedaf77cba509f829f9 Mon Sep 17 00:00:00 2001 From: jkloos Date: Tue, 5 Apr 2016 17:55:36 +0200 Subject: [PATCH 43/71] Added @since tags. --- src/data/CCIntMap.mli | 2 ++ src/data/CCTrie.mli | 8 ++++++-- src/data/CCWBTree.mli | 8 ++++++-- 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/src/data/CCIntMap.mli b/src/data/CCIntMap.mli index c4a7901d..b0f7938f 100644 --- a/src/data/CCIntMap.mli +++ b/src/data/CCIntMap.mli @@ -67,8 +67,10 @@ val iter : (int -> 'a -> unit) -> 'a t -> unit val fold : (int -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t +(** @since NEXT_RELEASE *) val map : ('a -> 'b) -> 'a t -> 'b t +(** @since NEXT_RELEASE *) val choose : 'a t -> (int * 'a) option diff --git a/src/data/CCTrie.mli b/src/data/CCTrie.mli index 5c49c1a5..5bbd8333 100644 --- a/src/data/CCTrie.mli +++ b/src/data/CCTrie.mli @@ -76,10 +76,14 @@ module type S = sig (** Fold on key/value bindings. Will use {!WORD.of_list} to rebuild keys. *) val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t - (** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys. *) + (** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys. + @since NEXT_RELEASE + *) val map : ('a -> 'b) -> 'a t -> 'b t - (** Map values, giving only the value. *) + (** Map values, giving only the value. + @since NEXT_RELEASE + *) val iter : (key -> 'a -> unit) -> 'a t -> unit (** Same as {!fold}, but for effectful functions *) diff --git a/src/data/CCWBTree.mli b/src/data/CCWBTree.mli index a419de1b..8e64e08b 100644 --- a/src/data/CCWBTree.mli +++ b/src/data/CCWBTree.mli @@ -63,10 +63,14 @@ module type S = sig val fold : f:('b -> key -> 'a -> 'b) -> x:'b -> 'a t -> 'b val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t - (** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys. *) + (** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys. + @since NEXT_RELEASE + *) val map : f:('a -> 'b) -> 'a t -> 'b t - (** Map values, giving only the value. *) + (** Map values, giving only the value. + @since NEXT_RELEASE + *) val iter : f:(key -> 'a -> unit) -> 'a t -> unit From 55c9d6c60b72fa710a1d759e1bef566d006ff0b3 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 5 Apr 2016 20:01:39 +0200 Subject: [PATCH 44/71] fix tests --- src/data/CCTrie.ml | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml index 6e9790bc..8105668c 100644 --- a/src/data/CCTrie.ml +++ b/src/data/CCTrie.ml @@ -378,10 +378,11 @@ module Make(W : WORD) = struct map in Node (v', map') in map_ _id t - (*$T - T.mapi (fun k v -> v ^ "!") t1 \ - |> T.to_list |> List.sort Pervasives.compare =\ - List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Pervasives.compare + + (*$= & ~printer:Q.Print.(list (pair (list int) string)) + (List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Pervasives.compare) \ + (T.mapi (fun k v -> v ^ "!") t1 \ + |> T.to_list |> List.sort Pervasives.compare) *) let map f t = @@ -395,10 +396,10 @@ module Make(W : WORD) = struct in let map' = M.map map_ map in Node (v', map') in map_ t - (*$T - T.map (fun v -> v ^ "!") t1 \ - |> T.to_list |> List.sort Pervasives.compare =\ - List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Pervasives.compare + (*$= & ~printer:Q.Print.(list (pair (list int) string)) + (List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Pervasives.compare) \ + (T.map (fun v -> v ^ "!") t1 \ + |> T.to_list |> List.sort Pervasives.compare) *) From a9b91943e854cd63b23f290634cb9b0771fb71df Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 6 Apr 2016 11:23:21 +0200 Subject: [PATCH 45/71] add `CCFormat.within` --- src/core/CCFormat.ml | 17 +++++++++++------ src/core/CCFormat.mli | 15 ++++++++++++--- 2 files changed, 23 insertions(+), 9 deletions(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 8fd37a8e..01a1fdcd 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -76,14 +76,19 @@ let opt pp fmt x = match x with | None -> Format.pp_print_string fmt "none" | Some x -> Format.fprintf fmt "some %a" pp x -let pair ppa ppb fmt (a, b) = - Format.fprintf fmt "(%a,@ %a)" ppa a ppb b +let pair ?(sep=", ") ppa ppb fmt (a, b) = + Format.fprintf fmt "(%a%s@,%a)" ppa a sep ppb b -let triple ppa ppb ppc fmt (a, b, c) = - Format.fprintf fmt "(%a,@ %a,@ %a)" ppa a ppb b ppc c +let triple ?(sep=", ") ppa ppb ppc fmt (a, b, c) = + Format.fprintf fmt "(%a%s@,%a%s@,%a)" ppa a sep ppb b sep ppc c -let quad ppa ppb ppc ppd fmt (a, b, c, d) = - Format.fprintf fmt "(%a,@ %a,@ %a,@ %a)" ppa a ppb b ppc c ppd d +let quad ?(sep=", ") ppa ppb ppc ppd fmt (a, b, c, d) = + Format.fprintf fmt "(%a%s@,%a%s@,%a%s@,%a)" ppa a sep ppb b sep ppc c sep ppd d + +let within a b p out x = + string out a; + p out x; + string out b let map f pp fmt x = pp fmt (f x); diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index e678a779..414fe4aa 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -38,9 +38,18 @@ val seq : ?start:string -> ?stop:string -> ?sep:string -> 'a printer -> 'a seque val opt : 'a printer -> 'a option printer -val pair : 'a printer -> 'b printer -> ('a * 'b) printer -val triple : 'a printer -> 'b printer -> 'c printer -> ('a * 'b * 'c) printer -val quad : 'a printer -> 'b printer -> 'c printer -> 'd printer -> ('a * 'b * 'c * 'd) printer +(** In the tuple printers, the [sep] argument is only available + @since NEXT_RELEASE *) + +val pair : ?sep:string -> 'a printer -> 'b printer -> ('a * 'b) printer +val triple : ?sep:string -> 'a printer -> 'b printer -> 'c printer -> ('a * 'b * 'c) printer +val quad : ?sep:string -> 'a printer -> 'b printer -> + 'c printer -> 'd printer -> ('a * 'b * 'c * 'd) printer + +val within : string -> string -> 'a printer -> 'a printer +(** [within a b p] wraps [p] inside the strings [a] and [b]. Convenient, + for instances, for brackets, parenthesis, quotes, etc. + @since NEXT_RELEASE *) val map : ('a -> 'b) -> 'b printer -> 'a printer From 85c46951386431356bf0a9c962ce625dd6967418 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 7 Apr 2016 11:46:56 +0200 Subject: [PATCH 46/71] add version constraint on sequence --- opam | 3 +++ 1 file changed, 3 insertions(+) diff --git a/opam b/opam index 51a80a86..d633f9ff 100644 --- a/opam +++ b/opam @@ -33,6 +33,9 @@ depends: [ "ocamlbuild" {build} ] depopts: [ "sequence" "base-bigarray" "base-unix" "base-threads" ] +conflicts: [ + "sequence" { < "0.5" } +] tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ] homepage: "https://github.com/c-cube/ocaml-containers/" doc: "http://cedeela.fr/~simon/software/containers/" From 55a4c7ef7a8604b91d184792adbdf99da5a80e89 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 11 Apr 2016 20:56:39 +0200 Subject: [PATCH 47/71] add `Result.{to,of}_err` --- src/core/CCResult.ml | 10 ++++++++++ src/core/CCResult.mli | 8 ++++++++ 2 files changed, 18 insertions(+) diff --git a/src/core/CCResult.ml b/src/core/CCResult.ml index 57e48752..da374da6 100644 --- a/src/core/CCResult.ml +++ b/src/core/CCResult.ml @@ -245,6 +245,16 @@ let to_seq e k = match e with | Ok x -> k x | Error _ -> () +type ('a, 'b) error = [`Ok of 'a | `Error of 'b] + +let of_err = function + | `Ok x -> Ok x + | `Error y -> Error y + +let to_err = function + | Ok x -> `Ok x + | Error y -> `Error y + (** {2 IO} *) let pp pp_x buf e = match e with diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index 1a72e3a3..7a4a2c28 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -181,6 +181,14 @@ val of_opt : 'a option -> ('a, string) t val to_seq : ('a, _) t -> 'a sequence +type ('a, 'b) error = [`Ok of 'a | `Error of 'b] + +val of_err : ('a, 'b) error -> ('a, 'b) t +(** @since NEXT_RELEASE *) + +val to_err : ('a, 'b) t -> ('a, 'b) error +(** @since NEXT_RELEASE *) + (** {2 IO} *) val pp : 'a printer -> ('a, string) t printer From e2bc0cf55a464f4a6bd84f2ffc0caa693916e702 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 15 Apr 2016 15:04:31 +0200 Subject: [PATCH 48/71] add `CCRef.{get_then_incr,incr_then_get}` functions --- src/core/CCRef.ml | 8 ++++++++ src/core/CCRef.mli | 8 ++++++++ 2 files changed, 16 insertions(+) diff --git a/src/core/CCRef.ml b/src/core/CCRef.ml index 047b0e92..050e17c4 100644 --- a/src/core/CCRef.ml +++ b/src/core/CCRef.ml @@ -21,6 +21,14 @@ let iter f r = f !r let update f r = r := (f !r) +let incr_then_get r = + incr r; !r + +let get_then_incr r = + let x = !r in + incr r; + x + let compare f r1 r2 = f !r1 !r2 let equal f r1 r2 = f !r1 !r2 diff --git a/src/core/CCRef.mli b/src/core/CCRef.mli index fed1091e..574cc6bf 100644 --- a/src/core/CCRef.mli +++ b/src/core/CCRef.mli @@ -24,6 +24,14 @@ val iter : ('a -> unit) -> 'a t -> unit val update : ('a -> 'a) -> 'a t -> unit (** Update the reference's content with the given function *) +val incr_then_get : int t -> int +(** [incr_then_get r] increments [r] and returns its new value, think [++ r] + @since NEXT_RELEASE *) + +val get_then_incr : int t -> int +(** [get_then_incr r] increments [r] and returns its old value, think [r++] + @since NEXT_RELEASE *) + val compare : 'a ord -> 'a t ord val equal : 'a eq -> 'a t eq From 037f169044d51b94dfcb344da5de8f32f8fac75f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 18 Apr 2016 11:20:24 +0200 Subject: [PATCH 49/71] `watch` target should build all --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 48d9c2fc..ed28398b 100644 --- a/Makefile +++ b/Makefile @@ -131,7 +131,7 @@ devel: watch: while find src/ benchs/ -print0 | xargs -0 inotifywait -e delete_self -e modify ; do \ echo "============ at `date` ==========" ; \ - make ; \ + make all; \ done .PHONY: examples push_doc tags qtest-gen qtest-clean devel update_next_tag From dba88f53025d25c479d2841eff31ef07ae71fb4c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 18 Apr 2016 13:19:26 +0200 Subject: [PATCH 50/71] add `CCOpt.{for_all, exists}` --- src/core/CCOpt.ml | 8 ++++++++ src/core/CCOpt.mli | 6 ++++++ 2 files changed, 14 insertions(+) diff --git a/src/core/CCOpt.ml b/src/core/CCOpt.ml index 4753315d..84fa5ffb 100644 --- a/src/core/CCOpt.ml +++ b/src/core/CCOpt.ml @@ -71,6 +71,14 @@ let filter p = function | Some x as o when p x -> o | o -> o +let exists p = function + | None -> false + | Some x -> p x + +let for_all p = function + | None -> true + | Some x -> p x + let iter f o = match o with | None -> () | Some x -> f x diff --git a/src/core/CCOpt.mli b/src/core/CCOpt.mli index 2bdbee8e..af6573d8 100644 --- a/src/core/CCOpt.mli +++ b/src/core/CCOpt.mli @@ -50,6 +50,12 @@ val filter : ('a -> bool) -> 'a t -> 'a t (** Filter on 0 or 1 element @since 0.5 *) +val exists : ('a -> bool) -> 'a t -> bool +(** @since NEXT_RELEASE *) + +val for_all : ('a -> bool) -> 'a t -> bool +(** @since NEXT_RELEASE *) + val get : 'a -> 'a t -> 'a (** [get default x] unwraps [x], but if [x = None] it returns [default] instead. @since 0.4.1 *) From 2f196ee9a2bc49ce8b5dcd48a881d0562df41777 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 18 Apr 2016 15:05:59 +0200 Subject: [PATCH 51/71] more doc and test for CCRandom --- src/core/CCRandom.ml | 7 +++++++ src/core/CCRandom.mli | 3 ++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index ed8ed0a4..ea269af2 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -118,6 +118,13 @@ let split_list i ~len st = else None +(*$Q + Q.(pair small_int small_int) (fun (i,j) -> \ + let len, n = min i j, max i j in \ + let l = QCheck.Gen.generate1 (split_list n ~len) in \ + match l with None -> true | Some l -> l<> [] && List.for_all (fun x->x>0) l) +*) + let retry ?(max=10) g st = let rec aux n = match g st with diff --git a/src/core/CCRandom.mli b/src/core/CCRandom.mli index ee6b4237..d5490e2f 100644 --- a/src/core/CCRandom.mli +++ b/src/core/CCRandom.mli @@ -102,7 +102,8 @@ val split : int -> (int * int) option t val split_list : int -> len:int -> int list option t (** Split a value [n] into a list of values whose sum is [n] - and whose length is [length]. + and whose length is [length]. The list is never empty and does not + contain [0]. @return [None] if the value is too small *) val retry : ?max:int -> 'a option t -> 'a option t From 203d8703579b926666c256deb67389fa8c9df1e8 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 18 Apr 2016 15:33:37 +0200 Subject: [PATCH 52/71] fix test and have `CCRandom.split_list` fail on `len=0` --- src/core/CCRandom.ml | 3 ++- src/core/CCRandom.mli | 1 + 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index ea269af2..788adab0 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -112,6 +112,7 @@ let _diff_list ~last l = If we define, y_k = x_{k+1} - x_{k} for k in 0..(len-1), then by construction ∑_k y_k = ∑_k (x_{k+1} - x_k ) = x_{len} - x_0 = i. *) let split_list i ~len st = + if len=0 then invalid_arg "Random.split_list"; if i >= len then let xs = sample_without_replacement (len-1) (int_range 1 (i-1)) st in _diff_list ( 0::xs ) ~last:i @@ -120,7 +121,7 @@ let split_list i ~len st = (*$Q Q.(pair small_int small_int) (fun (i,j) -> \ - let len, n = min i j, max i j in \ + let len, n = 1+min i j, max i j in \ let l = QCheck.Gen.generate1 (split_list n ~len) in \ match l with None -> true | Some l -> l<> [] && List.for_all (fun x->x>0) l) *) diff --git a/src/core/CCRandom.mli b/src/core/CCRandom.mli index d5490e2f..888c6154 100644 --- a/src/core/CCRandom.mli +++ b/src/core/CCRandom.mli @@ -104,6 +104,7 @@ val split_list : int -> len:int -> int list option t (** Split a value [n] into a list of values whose sum is [n] and whose length is [length]. The list is never empty and does not contain [0]. + @raise Invalid_argument if [len=0] @return [None] if the value is too small *) val retry : ?max:int -> 'a option t -> 'a option t From b1b8bc10963b635d1ee4ef27bb48f92cbac98a63 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 18 Apr 2016 15:39:55 +0200 Subject: [PATCH 53/71] also fail in `CCRandom.sample_without_replacement` if `n<=0` --- src/core/CCRandom.ml | 6 ++++-- src/core/CCRandom.mli | 3 ++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index 788adab0..9116c2cf 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -85,7 +85,9 @@ let sample_without_replacement (type elt) ?(compare=compare) k (rng:elt t) st= if S.mem x s then aux s k else - aux (S.add x s) (k-1) in + aux (S.add x s) (k-1) + in + if k<=0 then invalid_arg "sample_without_replacement"; aux S.empty k let list_seq l st = List.map (fun f -> f st) l @@ -112,7 +114,7 @@ let _diff_list ~last l = If we define, y_k = x_{k+1} - x_{k} for k in 0..(len-1), then by construction ∑_k y_k = ∑_k (x_{k+1} - x_k ) = x_{len} - x_0 = i. *) let split_list i ~len st = - if len=0 then invalid_arg "Random.split_list"; + if len <= 0 then invalid_arg "Random.split_list"; if i >= len then let xs = sample_without_replacement (len-1) (int_range 1 (i-1)) st in _diff_list ( 0::xs ) ~last:i diff --git a/src/core/CCRandom.mli b/src/core/CCRandom.mli index 888c6154..0f203249 100644 --- a/src/core/CCRandom.mli +++ b/src/core/CCRandom.mli @@ -58,6 +58,7 @@ val sample_without_replacement: (** [sample_without_replacement n g] makes a list of [n] elements which are all generated randomly using [g] with the added constraint that none of the generated random values are equal + @raise Invalid_argument if [n <= 0] @since 0.15 *) val list_seq : 'a t list -> 'a list t @@ -104,7 +105,7 @@ val split_list : int -> len:int -> int list option t (** Split a value [n] into a list of values whose sum is [n] and whose length is [length]. The list is never empty and does not contain [0]. - @raise Invalid_argument if [len=0] + @raise Invalid_argument if [len <= 0] @return [None] if the value is too small *) val retry : ?max:int -> 'a option t -> 'a option t From 6f8717ccd0ab5beffd3b819a8901b4a7cd4b24ba Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 18 Apr 2016 15:49:59 +0200 Subject: [PATCH 54/71] fix --- src/core/CCRandom.ml | 4 ++-- src/core/CCRandom.mli | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index 9116c2cf..c99c424c 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -114,7 +114,7 @@ let _diff_list ~last l = If we define, y_k = x_{k+1} - x_{k} for k in 0..(len-1), then by construction ∑_k y_k = ∑_k (x_{k+1} - x_k ) = x_{len} - x_0 = i. *) let split_list i ~len st = - if len <= 0 then invalid_arg "Random.split_list"; + if len <= 1 then invalid_arg "Random.split_list"; if i >= len then let xs = sample_without_replacement (len-1) (int_range 1 (i-1)) st in _diff_list ( 0::xs ) ~last:i @@ -123,7 +123,7 @@ let split_list i ~len st = (*$Q Q.(pair small_int small_int) (fun (i,j) -> \ - let len, n = 1+min i j, max i j in \ + let len, n = 2+min i j, max i j in \ let l = QCheck.Gen.generate1 (split_list n ~len) in \ match l with None -> true | Some l -> l<> [] && List.for_all (fun x->x>0) l) *) diff --git a/src/core/CCRandom.mli b/src/core/CCRandom.mli index 0f203249..1e9c9142 100644 --- a/src/core/CCRandom.mli +++ b/src/core/CCRandom.mli @@ -105,7 +105,7 @@ val split_list : int -> len:int -> int list option t (** Split a value [n] into a list of values whose sum is [n] and whose length is [length]. The list is never empty and does not contain [0]. - @raise Invalid_argument if [len <= 0] + @raise Invalid_argument if [len <= 1] @return [None] if the value is too small *) val retry : ?max:int -> 'a option t -> 'a option t From b9f7d2e18a4d95f2c455e46eb61c7088d1114180 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 19 Apr 2016 00:19:13 +0200 Subject: [PATCH 55/71] comments and doc for CCDeque --- src/data/CCDeque.ml | 29 +++++------------------------ src/data/CCDeque.mli | 43 ++++++++++++++----------------------------- 2 files changed, 19 insertions(+), 53 deletions(-) diff --git a/src/data/CCDeque.ml b/src/data/CCDeque.ml index b2ae66d3..8de3afcb 100644 --- a/src/data/CCDeque.ml +++ b/src/data/CCDeque.ml @@ -1,27 +1,5 @@ -(* -Copyright (c) 2013, Simon Cruanes -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. Redistributions in binary -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 file is free software, part of containers. See file "license" for more details. *) (** {1 Imperative deque} *) @@ -37,7 +15,10 @@ type 'a node = { mutable next : 'a node; mutable prev : 'a node; } -(** Linked list of cells *) +(** Linked list of cells. + + invariant: only the first and last cells are allowed to + be anything but [Three] (all the intermediate ones are [Three]) *) type 'a t = { mutable cur : 'a node; diff --git a/src/data/CCDeque.mli b/src/data/CCDeque.mli index e18e6eb7..c0bde886 100644 --- a/src/data/CCDeque.mli +++ b/src/data/CCDeque.mli @@ -1,29 +1,10 @@ -(* -Copyright (c) 2013, Simon Cruanes -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: +(* This file is free software, part of containers. See file "license" for more details. *) -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. Redistributions in binary -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. +(** {1 Imperative deque} -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. -*) - -(** {1 Imperative deque} *) + This structure provides fast access to its front and back elements, + with O(1) operations*) type 'a t (** Contains 'a elements, queue in both ways *) @@ -76,10 +57,12 @@ val take_front : 'a t -> 'a val append_front : into:'a t -> 'a t -> unit (** [append_front ~into q] adds all elements of [q] at the front of [into] + O(length q) in time @since 0.13 *) val append_back : into:'a t -> 'a t -> unit -(** [append_back ~into q] adds all elements of [q] at the back of [into] +(** [append_back ~into q] adds all elements of [q] at the back of [into]. + O(length q) in time @since 0.13 *) val iter : ('a -> unit) -> 'a t -> unit @@ -100,6 +83,7 @@ val of_seq : 'a sequence -> 'a t {!add_seq_back} instead *) val to_seq : 'a t -> 'a sequence +(** iterate on the elements *) val of_gen : 'a gen -> 'a t (** [of_gen g] makes a deque containing the elements of [g] @@ -111,24 +95,25 @@ val to_gen : 'a t -> 'a gen val add_seq_front : 'a t -> 'a sequence -> unit (** [add_seq_front q seq] adds elements of [seq] into the front of [q], - in reverse order + in reverse order. + O(n) in time, where [n] is the number of elements to add. @since 0.13 *) val add_seq_back : 'a t -> 'a sequence -> unit (** [add_seq_back q seq] adds elements of [seq] into the back of [q], - in order + in order. + O(n) in time, where [n] is the number of elements to add. @since 0.13 *) val copy : 'a t -> 'a t -(** Fresh copy *) +(** Fresh copy, O(n) in time *) val of_list : 'a list -> 'a t (** Conversion from list, in order @since 0.13 *) val to_list : 'a t -> 'a list -(** List of elements, in order - {b warning: not tailrec} +(** List of elements, in order. Less efficient than {!to_rev_list}. @since 0.13 *) val to_rev_list : 'a t -> 'a list From 777796d8a6e282f8293476f9dfe1f2916dd1f6a5 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 19 Apr 2016 10:31:48 +0200 Subject: [PATCH 56/71] some opam constraints --- opam | 2 ++ 1 file changed, 2 insertions(+) diff --git a/opam b/opam index d633f9ff..f51a13c0 100644 --- a/opam +++ b/opam @@ -35,6 +35,8 @@ depends: [ depopts: [ "sequence" "base-bigarray" "base-unix" "base-threads" ] conflicts: [ "sequence" { < "0.5" } + "qtest" { < "2.2" } + "qcheck" ] tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ] homepage: "https://github.com/c-cube/ocaml-containers/" From 07d11c4104f4bb956db3c0d13aa3cfb60bab77cf Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 19 Apr 2016 11:49:12 +0200 Subject: [PATCH 57/71] add `CCOpt.if_` --- src/core/CCOpt.ml | 2 ++ src/core/CCOpt.mli | 4 ++++ 2 files changed, 6 insertions(+) diff --git a/src/core/CCOpt.ml b/src/core/CCOpt.ml index 84fa5ffb..b15d93d2 100644 --- a/src/core/CCOpt.ml +++ b/src/core/CCOpt.ml @@ -71,6 +71,8 @@ let filter p = function | Some x as o when p x -> o | o -> o +let if_ p x = if p x then Some x else None + let exists p = function | None -> false | Some x -> p x diff --git a/src/core/CCOpt.mli b/src/core/CCOpt.mli index af6573d8..ffa7c11a 100644 --- a/src/core/CCOpt.mli +++ b/src/core/CCOpt.mli @@ -50,6 +50,10 @@ val filter : ('a -> bool) -> 'a t -> 'a t (** Filter on 0 or 1 element @since 0.5 *) +val if_ : ('a -> bool) -> 'a -> 'a option +(** [if_ f x] is [Some x] if [f x], [None] otherwise + @since NEXT_RELEASE *) + val exists : ('a -> bool) -> 'a t -> bool (** @since NEXT_RELEASE *) From 563927a592b904ddb3b2fbfe18712a4a826e4611 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 19 Apr 2016 18:59:53 +0200 Subject: [PATCH 58/71] readme --- README.adoc | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/README.adoc b/README.adoc index 5e301353..8787436d 100644 --- a/README.adoc +++ b/README.adoc @@ -4,7 +4,8 @@ image::media/logo.png[logo] -What is _containers_? (take a look at the link:TUTORIAL.adoc[tutorial]!) +What is _containers_? (take a look at the link:TUTORIAL.adoc[tutorial]! +or the http://cedeela.fr/~simon/software/containers[documentation]) - A usable, reasonably well-designed library that extends OCaml's standard library (in 'src/core/', packaged under `containers` in ocamlfind. Modules From ae06357487ae3908b7c8c46350318af97e50f402 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 19 Apr 2016 22:33:42 +0200 Subject: [PATCH 59/71] formatting in CCTrie --- src/data/CCTrie.ml | 312 ++++++++++++++++++++------------------------ src/data/CCTrie.mli | 35 +---- 2 files changed, 151 insertions(+), 196 deletions(-) diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml index 8105668c..003283c5 100644 --- a/src/data/CCTrie.ml +++ b/src/data/CCTrie.ml @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, simon cruanes -all rights reserved. -redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. redistributions in binary -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 file is free software, part of containers. See file "license" for more details. *) (** {1 Prefix Tree} *) @@ -32,7 +10,7 @@ type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list] (** {6 A Composite Word} -Words are made of characters, who belong to a total order *) + Words are made of characters, who belong to a total order *) module type WORD = sig type t @@ -131,7 +109,7 @@ end let t1 = T.of_list l1 let small_l l = List.fold_left (fun acc (k,v) -> List.length k+acc) 0 l - *) +*) (*$T String.of_list ["a", 1; "b", 2] |> String.size = 2 @@ -152,9 +130,9 @@ module Make(W : WORD) = struct type key = W.t module M = Map.Make(struct - type t = char_ - let compare = W.compare - end) + type t = char_ + let compare = W.compare + end) type 'a t = | Empty @@ -162,9 +140,9 @@ module Make(W : WORD) = struct | Node of 'a option * 'a t M.t (* invariants: - - for Path(l,t) l is never empty - - for Node (None,map) map always has at least 2 elements - - for Node (Some _,map) map can be anything *) + - for Path(l,t) l is never empty + - for Node (None,map) map always has at least 2 elements + - for Node (Some _,map) map can be anything *) let empty = Empty @@ -177,7 +155,7 @@ module Make(W : WORD) = struct | Cons (_, t) -> check_invariants t | Node (None, map) when M.is_empty map -> false | Node (_, map) -> - M.for_all (fun _ v -> check_invariants v) map + M.for_all (fun _ v -> check_invariants v) map let is_empty = function | Empty -> true @@ -210,12 +188,12 @@ module Make(W : WORD) = struct | [], _ | _, [] -> [], l1, l2 | c1::l1', c2::l2' -> - if W.compare c1 c2 = 0 - then - let pre, rest1, rest2 = _merge_lists l1' l2' in - c1::pre, rest1, rest2 - else - [], l1, l2 + if W.compare c1 c2 = 0 + then + let pre, rest1, rest2 = _merge_lists l1' l2' in + c1::pre, rest1, rest2 + else + [], l1, l2 (* sub-tree t prefixed with c *) @@ -226,11 +204,11 @@ module Make(W : WORD) = struct | None -> if M.is_empty map then Empty else - if M.cardinal map = 1 - then - let c, sub = M.min_binding map in - _cons c sub - else Node (value,map) + if M.cardinal map = 1 + then + let c, sub = M.min_binding map in + _cons c sub + else Node (value,map) (* remove key [c] from [t] *) let _remove c t = match t with @@ -240,35 +218,35 @@ module Make(W : WORD) = struct then Empty else t | Node (value, map) -> - if M.mem c map - then - let map' = M.remove c map in - _mk_node value map' - else t + if M.mem c map + then + let map' = M.remove c map in + _mk_node value map' + else t let update key f t = (* first arg: current subtree and rebuild function; [c]: current char *) let goto (t, rebuild) c = match t with - | Empty -> empty, fun t -> rebuild (_cons c t) - | Cons (c', t') -> - if W.compare c c' = 0 - then t', (fun t -> rebuild (_cons c t)) - else - let rebuild' new_child = - rebuild ( - if is_empty new_child then t - else - let map = M.singleton c new_child in - let map = M.add c' t' map in - _mk_node None map - ) in - empty, rebuild' - | Node (value, map) -> + | Empty -> empty, fun t -> rebuild (_cons c t) + | Cons (c', t') -> + if W.compare c c' = 0 + then t', (fun t -> rebuild (_cons c t)) + else + let rebuild' new_child = + rebuild ( + if is_empty new_child then t + else + let map = M.singleton c new_child in + let map = M.add c' t' map in + _mk_node None map + ) in + empty, rebuild' + | Node (value, map) -> try let t' = M.find c map in (* rebuild: we modify [t], so we put the new version in [map] - if it's not empty, and make the node again *) + if it's not empty, and make the node again *) let rebuild' new_child = rebuild ( if is_empty new_child @@ -292,12 +270,12 @@ module Make(W : WORD) = struct | Cons (c, t') -> rebuild (match f None with - | None -> t - | Some _ as v -> _mk_node v (M.singleton c t') + | None -> t + | Some _ as v -> _mk_node v (M.singleton c t') ) | Node (value, map) -> - let value' = f value in - rebuild (_mk_node value' map) + let value' = f value in + rebuild (_mk_node value' map) in let word = W.to_seq key in _fold_seq_and_then goto ~finish (t, _id) word @@ -319,9 +297,9 @@ module Make(W : WORD) = struct let goto t c = match t with | Empty -> raise Not_found | Cons (c', t') -> - if W.compare c c' = 0 - then t' - else raise Not_found + if W.compare c c' = 0 + then t' + else raise Not_found | Node (_, map) -> M.find c map and finish t = match t with | Node (Some v, _) -> v @@ -343,19 +321,19 @@ module Make(W : WORD) = struct | Empty -> acc | Cons (c, t') -> _fold f (_difflist_add path c) t' acc | Node (v, map) -> - let acc = match v with - | None -> acc - | Some v -> f acc path v - in - M.fold - (fun c t' acc -> _fold f (_difflist_add path c) t' acc) - map acc + let acc = match v with + | None -> acc + | Some v -> f acc path v + in + M.fold + (fun c t' acc -> _fold f (_difflist_add path c) t' acc) + map acc let fold f acc t = _fold (fun acc path v -> - let key = W.of_list (path []) in - f acc key v + let key = W.of_list (path []) in + f acc key v ) _id t acc (*$T @@ -368,15 +346,15 @@ module Make(W : WORD) = struct | Empty -> Empty | Cons (c, t') -> Cons (c, map_ (_difflist_add prefix c) t') | Node (v, map) -> - let v' = match v with - | None -> None - | Some v -> Some (f (W.of_list (prefix [])) v) - in let map' = - M.mapi (fun c t' -> - let prefix' = _difflist_add prefix c in - map_ prefix' t') - map - in Node (v', map') + let v' = match v with + | None -> None + | Some v -> Some (f (W.of_list (prefix [])) v) + in let map' = + M.mapi (fun c t' -> + let prefix' = _difflist_add prefix c in + map_ prefix' t') + map + in Node (v', map') in map_ _id t (*$= & ~printer:Q.Print.(list (pair (list int) string)) @@ -390,11 +368,11 @@ module Make(W : WORD) = struct | Empty -> Empty | Cons (c, t') -> Cons (c, map_ t') | Node (v, map) -> - let v' = match v with - | None -> None - | Some v -> Some (f v) - in let map' = M.map map_ map - in Node (v', map') + let v' = match v with + | None -> None + | Some v -> Some (f v) + in let map' = M.map map_ map + in Node (v', map') in map_ t (*$= & ~printer:Q.Print.(list (pair (list int) string)) (List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Pervasives.compare) \ @@ -411,21 +389,21 @@ module Make(W : WORD) = struct let _iter_prefix ~prefix f t = _fold (fun () path y -> - let key = W.of_list (prefix (path [])) in - f key y) + let key = W.of_list (prefix (path [])) in + f key y) _id t () let rec fold_values f acc t = match t with | Empty -> acc | Cons (_, t') -> fold_values f acc t' | Node (v, map) -> - let acc = match v with - | None -> acc - | Some v -> f acc v - in - M.fold - (fun _c t' acc -> fold_values f acc t') - map acc + let acc = match v with + | None -> acc + | Some v -> f acc v + in + M.fold + (fun _c t' acc -> fold_values f acc t') + map acc let iter_values f t = fold_values (fun () x -> f x) () t @@ -441,7 +419,7 @@ module Make(W : WORD) = struct _mk_node None map | Cons (c1, t1'), Node (value, map) -> - begin try + begin try (* collision *) let t2' = M.find c1 map in let new_t = merge f t1' t2' in @@ -454,25 +432,25 @@ module Make(W : WORD) = struct (* no collision *) assert (not(is_empty t1')); Node (value, M.add c1 t1' map) - end + end | Node _, Cons _ -> merge f t2 t1 (* previous case *) | Node(v1, map1), Node (v2, map2) -> - let v = match v1, v2 with - | None, _ -> v2 - | _, None -> v1 - | Some v1, Some v2 -> f v1 v2 - in - let map' = M.merge + let v = match v1, v2 with + | None, _ -> v2 + | _, None -> v1 + | Some v1, Some v2 -> f v1 v2 + in + let map' = M.merge (fun _c t1 t2 -> match t1, t2 with - | None, None -> assert false - | Some t, None - | None, Some t -> Some t - | Some t1, Some t2 -> - let new_t = merge f t1 t2 in - if is_empty new_t then None else Some new_t + | None, None -> assert false + | Some t, None + | None, Some t -> Some t + | Some t1, Some t2 -> + let new_t = merge f t1 t2 in + if is_empty new_t then None else Some new_t ) map1 map2 - in - _mk_node v map' + in + _mk_node v map' (*$QR & ~count:30 Q.(let p = list_of_size Gen.(0--100) (pair printable_string small_int) in pair p p) @@ -489,10 +467,10 @@ module Make(W : WORD) = struct | Empty -> 0 | Cons (_, t') -> size t' | Node (v, map) -> - let s = if v=None then 0 else 1 in - M.fold - (fun _ t' acc -> size t' + acc) - map s + let s = if v=None then 0 else 1 in + M.fold + (fun _ t' acc -> size t' + acc) + map s (*$T T.size t1 = List.length l1 @@ -513,9 +491,9 @@ module Make(W : WORD) = struct let rec to_tree t () = let _tree_node x l () = `Node (x,l) in match t with - | Empty -> `Nil - | Cons (c, t') -> `Node (`Char c, [to_tree t']) - | Node (v, map) -> + | Empty -> `Nil + | Cons (c, t') -> `Node (`Char c, [to_tree t']) + | Node (v, map) -> let x = match v with | None -> `Switch | Some v -> `Val v @@ -526,20 +504,20 @@ module Make(W : WORD) = struct (** {6 Ranges} *) (* range above (if [above = true]) or below a threshold . - [p c c'] must return [true] if [c'], in the tree, meets some criterion - w.r.t [c] which is a part of the key. *) + [p c c'] must return [true] if [c'], in the tree, meets some criterion + w.r.t [c] which is a part of the key. *) let _half_range ~above ~p key t k = (* at subtree [cur = Some (t,trail)] or [None], alternatives above [alternatives], and char [c] in [key]. *) let on_char (cur, alternatives) c = match cur with - | None -> (None, alternatives) - | Some (Empty,_) -> (None, alternatives) - | Some (Cons (c', t'), trail) -> + | None -> (None, alternatives) + | Some (Empty,_) -> (None, alternatives) + | Some (Cons (c', t'), trail) -> if W.compare c c' = 0 - then Some (t', _difflist_add trail c), alternatives - else None, alternatives - | Some (Node (o, map), trail) -> + then Some (t', _difflist_add trail c), alternatives + else None, alternatives + | Some (Node (o, map), trail) -> (* if [not above], [o]'s key is below [key] so add it *) begin match o with | Some v when not above -> k (W.of_list (trail []), v) @@ -548,32 +526,32 @@ module Make(W : WORD) = struct let alternatives = let seq = _seq_map map in let seq = _filter_map_seq - (fun (c', t') -> if p c c' - then Some (t', _difflist_add trail c') - else None - ) seq + (fun (c', t') -> if p c c' + then Some (t', _difflist_add trail c') + else None + ) seq in _seq_append_list alternatives seq in begin try - let t' = M.find c map in - Some (t', _difflist_add trail c), alternatives - with Not_found -> - None, alternatives + let t' = M.find c map in + Some (t', _difflist_add trail c), alternatives + with Not_found -> + None, alternatives end (* run through the current path (if any) and alternatives *) and finish (cur,alternatives) = begin match cur with - | Some (t, prefix) when above -> + | Some (t, prefix) when above -> (* subtree prefixed by input key, therefore above key *) _iter_prefix ~prefix (fun key' v -> k (key', v)) t - | Some (Node (Some v, _), prefix) when not above -> + | Some (Node (Some v, _), prefix) when not above -> (* yield the value for key *) assert (W.of_list (prefix []) = key); k (key, v) - | Some _ - | None -> () + | Some _ + | None -> () end; List.iter (fun (t,prefix) -> _iter_prefix ~prefix (fun key' v -> k (key', v)) t) @@ -625,28 +603,28 @@ module type ORDERED = sig end module MakeArray(X : ORDERED) = Make(struct - type t = X.t array - type char_ = X.t - let compare = X.compare - let to_seq a k = Array.iter k a - let of_list = Array.of_list -end) + type t = X.t array + type char_ = X.t + let compare = X.compare + let to_seq a k = Array.iter k a + let of_list = Array.of_list + end) module MakeList(X : ORDERED) = Make(struct - type t = X.t list - type char_ = X.t - let compare = X.compare - let to_seq a k = List.iter k a - let of_list l = l -end) + type t = X.t list + type char_ = X.t + let compare = X.compare + let to_seq a k = List.iter k a + let of_list l = l + end) module String = Make(struct - type t = string - type char_ = char - let compare = Char.compare - let to_seq s k = String.iter k s - let of_list l = - let buf = Buffer.create (List.length l) in - List.iter (fun c -> Buffer.add_char buf c) l; - Buffer.contents buf -end) + type t = string + type char_ = char + let compare = Char.compare + let to_seq s k = String.iter k s + let of_list l = + let buf = Buffer.create (List.length l) in + List.iter (fun c -> Buffer.add_char buf c) l; + Buffer.contents buf + end) diff --git a/src/data/CCTrie.mli b/src/data/CCTrie.mli index 5bbd8333..28c0cc4f 100644 --- a/src/data/CCTrie.mli +++ b/src/data/CCTrie.mli @@ -1,27 +1,5 @@ -(* -copyright (c) 2013-2014, simon cruanes -all rights reserved. -redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. redistributions in binary -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 file is free software, part of containers. See file "license" for more details. *) (** {1 Prefix Tree} *) @@ -32,7 +10,7 @@ type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list] (** {6 A Composite Word} -Words are made of characters, who belong to a total order *) + Words are made of characters, who belong to a total order *) module type WORD = sig type t @@ -77,13 +55,11 @@ module type S = sig val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t (** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys. - @since NEXT_RELEASE - *) + @since NEXT_RELEASE *) val map : ('a -> 'b) -> 'a t -> 'b t (** Map values, giving only the value. - @since NEXT_RELEASE - *) + @since NEXT_RELEASE *) val iter : (key -> 'a -> unit) -> 'a t -> unit (** Same as {!fold}, but for effectful functions *) @@ -117,7 +93,8 @@ module type S = sig (** {6 Ranges} *) val above : key -> 'a t -> (key * 'a) sequence - (** All bindings whose key is bigger or equal to the given key *) + (** All bindings whose key is bigger or equal to the given key, in + ascending order *) val below : key -> 'a t -> (key * 'a) sequence (** All bindings whose key is smaller or equal to the given key *) From 3c9548ebf29a0d49082a0475b04c3acc58835878 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 19 Apr 2016 23:32:16 +0200 Subject: [PATCH 60/71] provide additional ordering properties in `CCTrie.{above,below}` - also add tests for those --- src/data/CCTrie.ml | 152 ++++++++++++++++++++++++++++++++------------ src/data/CCTrie.mli | 3 +- 2 files changed, 112 insertions(+), 43 deletions(-) diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml index 003283c5..0ff580c9 100644 --- a/src/data/CCTrie.ml +++ b/src/data/CCTrie.ml @@ -54,10 +54,12 @@ module type S = sig (** Fold on key/value bindings. Will use {!WORD.of_list} to rebuild keys. *) val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t - (** Map values in the try. Will use {!WORD.of_list} to rebuild keys. *) + (** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys. + @since NEXT_RELEASE *) val map : ('a -> 'b) -> 'a t -> 'b t - (** Map values in the try, not giving keys to the mapping function. *) + (** Map values, giving only the value. + @since NEXT_RELEASE *) val iter : (key -> 'a -> unit) -> 'a t -> unit (** Same as {!fold}, but for effectful functions *) @@ -91,10 +93,12 @@ module type S = sig (** {6 Ranges} *) val above : key -> 'a t -> (key * 'a) sequence - (** All bindings whose key is bigger or equal to the given key *) + (** All bindings whose key is bigger or equal to the given key, in + ascending order *) val below : key -> 'a t -> (key * 'a) sequence - (** All bindings whose key is smaller or equal to the given key *) + (** All bindings whose key is smaller or equal to the given key, + in decreasing order *) (**/**) val check_invariants: _ t -> bool @@ -175,12 +179,17 @@ module Make(W : WORD) = struct | None -> () | Some y -> k y) - let _seq_append_list l seq = + let _seq_map f seq k = seq (fun x -> k (f x)) + + let _seq_append_list_rev l seq = let l = ref l in seq (fun x -> l := x :: !l); !l - let _seq_map map k = + let _seq_append_list l seq = + List.rev_append (_seq_append_list_rev [] seq) l + + let seq_of_map map k = M.iter (fun key v -> k (key,v)) map (* return common prefix, and disjoint suffixes *) @@ -312,7 +321,11 @@ module Make(W : WORD) = struct try Some (find_exn k t) with Not_found -> None - let _difflist_add f x = fun l' -> f (x :: l') + type 'a difflist = 'a list -> 'a list + + let _difflist_add + : 'a difflist -> 'a -> 'a difflist + = fun f x -> fun l' -> f (x :: l') (* fold that also keeps the path from the root, so as to provide the list of chars that lead to a value. The path is a difference list, ie @@ -333,8 +346,8 @@ module Make(W : WORD) = struct _fold (fun acc path v -> let key = W.of_list (path []) in - f acc key v - ) _id t acc + f acc key v) + _id t acc (*$T T.fold (fun acc k v -> (k,v) :: acc) [] t1 \ @@ -503,10 +516,42 @@ module Make(W : WORD) = struct (** {6 Ranges} *) + (* stack of actions for [above] and [below] *) + type 'a alternative = + | Yield of 'a * char_ difflist + | Explore of 'a t * char_ difflist + + type direction = + | Above + | Below + + let rec explore ~dir k alt = match alt with + | Yield (v,prefix) -> k (W.of_list (prefix[]), v) + | Explore (Empty, _) -> () + | Explore (Cons (c,t), prefix) -> + explore ~dir k (Explore (t, _difflist_add prefix c)) + | Explore (Node (o,map), prefix) -> + (* if above, yield value now *) + begin match o, dir with + | Some v, Above -> k (W.of_list (prefix[]), v) + | _ -> () + end; + let seq = + seq_of_map map + |> _seq_map (fun (c,t') -> Explore (t', _difflist_add prefix c)) + in + let l' = match o, dir with + | _, Above -> _seq_append_list [] seq + | None, Below -> _seq_append_list_rev [] seq + | Some v, Below -> + _seq_append_list_rev [Yield (v, prefix)] seq + in + List.iter (explore ~dir k) l' + (* range above (if [above = true]) or below a threshold . [p c c'] must return [true] if [c'], in the tree, meets some criterion w.r.t [c] which is a part of the key. *) - let _half_range ~above ~p key t k = + let _half_range ~dir ~p key t k = (* at subtree [cur = Some (t,trail)] or [None], alternatives above [alternatives], and char [c] in [key]. *) let on_char (cur, alternatives) c = @@ -518,22 +563,30 @@ module Make(W : WORD) = struct then Some (t', _difflist_add trail c), alternatives else None, alternatives | Some (Node (o, map), trail) -> - (* if [not above], [o]'s key is below [key] so add it *) - begin match o with - | Some v when not above -> k (W.of_list (trail []), v) - | _ -> () - end; - let alternatives = - let seq = _seq_map map in - let seq = _filter_map_seq - (fun (c', t') -> if p c c' - then Some (t', _difflist_add trail c') - else None - ) seq - in - _seq_append_list alternatives seq + (* if [dir=Below], [o]'s key is below [key] and the other + alternatives in [map] *) + let alternatives = match o, dir with + | Some v, Below -> Yield (v, trail) :: alternatives + | _ -> alternatives in - begin try + let alternatives = + let seq = seq_of_map map in + let seq = _filter_map_seq + (fun (c', t') -> + if p ~cur:c ~other:c' + then Some (Explore (t', _difflist_add trail c')) + else None) + seq + in + (* ordering: + - Above: explore alternatives in increasing order + - Below: explore alternatives in decreasing order *) + match dir with + | Above -> _seq_append_list alternatives seq + | Below -> _seq_append_list_rev alternatives seq + in + begin + try let t' = M.find c map in Some (t', _difflist_add trail c), alternatives with Not_found -> @@ -542,39 +595,37 @@ module Make(W : WORD) = struct (* run through the current path (if any) and alternatives *) and finish (cur,alternatives) = - begin match cur with - | Some (t, prefix) when above -> + begin match cur, dir with + | Some (t, prefix), Above -> (* subtree prefixed by input key, therefore above key *) _iter_prefix ~prefix (fun key' v -> k (key', v)) t - | Some (Node (Some v, _), prefix) when not above -> + | Some (Node (Some v, _), prefix), Below -> (* yield the value for key *) assert (W.of_list (prefix []) = key); k (key, v) - | Some _ - | None -> () + | Some _, _ + | None, _ -> () end; - List.iter - (fun (t,prefix) -> _iter_prefix ~prefix (fun key' v -> k (key', v)) t) - alternatives + List.iter (explore ~dir k) alternatives in let word = W.to_seq key in _fold_seq_and_then on_char ~finish (Some(t,_id), []) word let above key t = - _half_range ~above:true ~p:(fun c c' -> W.compare c c' < 0) key t + _half_range ~dir:Above ~p:(fun ~cur ~other -> W.compare cur other < 0) key t let below key t = - _half_range ~above:false ~p:(fun c c' -> W.compare c c' > 0) key t + _half_range ~dir:Below ~p:(fun ~cur ~other -> W.compare cur other > 0) key t (*$= & ~printer:CCPrint.(to_string (list (pair (list int) string))) [ [1], "1"; [1;2], "12"; [1;2;3], "123"; [2;1], "21" ] \ - (T.above [1] t1 |> Sequence.sort |> Sequence.to_list) + (T.above [1] t1 |> Sequence.to_list) [ [1;2], "12"; [1;2;3], "123"; [2;1], "21" ] \ - (T.above [1;1] t1 |> Sequence.sort |> Sequence.to_list) - [ [], "[]"; [1], "1"; [1;2], "12" ] \ - (T.below [1;2] t1 |> Sequence.sort |> Sequence.to_list) - [ [], "[]"; [1], "1" ] \ - (T.below [1;1] t1 |> Sequence.sort |> Sequence.to_list) + (T.above [1;1] t1 |> Sequence.to_list) + [ [1;2], "12"; [1], "1"; [], "[]" ] \ + (T.below [1;2] t1 |> Sequence.to_list) + [ [1], "1"; [], "[]" ] \ + (T.below [1;1] t1 |> Sequence.to_list) *) (*$Q & ~count:30 @@ -583,7 +634,14 @@ module Make(W : WORD) = struct S.check_invariants t) *) - (*$Q & ~count:20 + (*$inject + let rec sorted ~rev = function + | [] | [_] -> true + | x :: ((y ::_) as tl) -> + (if rev then x >= y else x <= y) && sorted ~rev tl + *) + + (*$Q & ~count:200 Q.(list_of_size Gen.(1 -- 20) (pair printable_string small_int)) \ (fun l -> let t = String.of_list l in \ List.for_all (fun (k,_) -> \ @@ -594,6 +652,16 @@ module Make(W : WORD) = struct List.for_all (fun (k,_) -> \ String.below k t |> Sequence.for_all (fun (k',v) -> k' <= k)) \ l) + Q.(list_of_size Gen.(1 -- 20) (pair printable_string small_int)) \ + (fun l -> let t = String.of_list l in \ + List.for_all (fun (k,_) -> \ + String.above k t |> Sequence.to_list |> sorted ~rev:false) \ + l) + Q.(list_of_size Gen.(1 -- 20) (pair printable_string small_int)) \ + (fun l -> let t = String.of_list l in \ + List.for_all (fun (k,_) -> \ + String.below k t |> Sequence.to_list |> sorted ~rev:true) \ + l) *) end diff --git a/src/data/CCTrie.mli b/src/data/CCTrie.mli index 28c0cc4f..dc8567aa 100644 --- a/src/data/CCTrie.mli +++ b/src/data/CCTrie.mli @@ -97,7 +97,8 @@ module type S = sig ascending order *) val below : key -> 'a t -> (key * 'a) sequence - (** All bindings whose key is smaller or equal to the given key *) + (** All bindings whose key is smaller or equal to the given key, + in decreasing order *) (**/**) val check_invariants: _ t -> bool From 308ea3a650c5e35cb929c0832d64773628ef03e2 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 19 Apr 2016 23:44:24 +0200 Subject: [PATCH 61/71] add `CCTrie.longest_prefix` --- src/data/CCTrie.ml | 57 +++++++++++++++++++++++++++++++++++++++++---- src/data/CCTrie.mli | 10 ++++++++ 2 files changed, 62 insertions(+), 5 deletions(-) diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml index 0ff580c9..635dc26f 100644 --- a/src/data/CCTrie.ml +++ b/src/data/CCTrie.ml @@ -44,6 +44,16 @@ module type S = sig (** Same as {!find} but can fail. @raise Not_found if the key is not present *) + val longest_prefix : key -> 'a t -> key + (** [longest_prefix k m] finds the longest prefix of [k] that leads to + at least one path in [m] (it does not mean that the prefix is bound to + a value. + + Example: if [m] has keys "abc0" and "abcd", then [longest_prefix "abc2" m] + will return "abc" + + @since NEXT_RELEASE *) + val update : key -> ('a option -> 'a option) -> 'a t -> 'a t (** Update the binding for the given key. The function is given [None] if the key is absent, or [Some v] if [key] is bound to [v]; @@ -113,6 +123,8 @@ end let t1 = T.of_list l1 let small_l l = List.fold_left (fun acc (k,v) -> List.length k+acc) 0 l + + let s1 = String.of_list ["cat", 1; "catogan", 2; "foo", 3] *) (*$T @@ -122,14 +134,16 @@ end String.of_list ["a", 1; "b", 2] |> String.find_exn "b" = 2 String.of_list ["a", 1; "b", 2] |> String.find "c" = None - String.of_list ["cat", 1; "catogan", 2; "foo", 3] |> String.find_exn "cat" = 1 - String.of_list ["cat", 1; "catogan", 2; "foo", 3] |> String.find_exn "catogan" = 2 - String.of_list ["cat", 1; "catogan", 2; "foo", 3] |> String.find_exn "foo" = 3 - String.of_list ["cat", 1; "catogan", 2; "foo", 3] |> String.find "cato" = None + s1 |> String.find_exn "cat" = 1 + s1 |> String.find_exn "catogan" = 2 + s1 |> String.find_exn "foo" = 3 + s1 |> String.find "cato" = None *) -module Make(W : WORD) = struct +module Make(W : WORD) + : S with type char_ = W.char_ and type key = W.t += struct type char_ = W.char_ type key = W.t @@ -327,6 +341,39 @@ module Make(W : WORD) = struct : 'a difflist -> 'a -> 'a difflist = fun f x -> fun l' -> f (x :: l') + let longest_prefix k t = + (* at subtree [t], and character [c] *) + let goto (t,prefix) c = match t with + | Empty -> Empty, prefix + | Cons (c', t') -> + if W.compare c c' = 0 + then t', _difflist_add prefix c + else Empty, prefix + | Node (_, map) -> + try + let t' = M.find c map in + t', _difflist_add prefix c + with Not_found -> Empty, prefix + and finish (_,prefix) = + W.of_list (prefix []) + in + let word = W.to_seq k in + _fold_seq_and_then goto ~finish (t,_id) word + + (*$= & ~printer:CCFun.id + "ca" (String.longest_prefix "carte" s1) + "" (String.longest_prefix "yolo" s1) + "cat" (String.longest_prefix "cat" s1) + "catogan" (String.longest_prefix "catogan" s1) + *) + + (*$Q + Q.(pair (list (pair printable_string int)) printable_string) (fun (l,s) -> \ + let m = String.of_list l in \ + let s' = String.longest_prefix s m in \ + CCString.prefix ~pre:s' s) + *) + (* fold that also keeps the path from the root, so as to provide the list of chars that lead to a value. The path is a difference list, ie a function that prepends a list to some suffix *) diff --git a/src/data/CCTrie.mli b/src/data/CCTrie.mli index dc8567aa..0292b94b 100644 --- a/src/data/CCTrie.mli +++ b/src/data/CCTrie.mli @@ -44,6 +44,16 @@ module type S = sig (** Same as {!find} but can fail. @raise Not_found if the key is not present *) + val longest_prefix : key -> 'a t -> key + (** [longest_prefix k m] finds the longest prefix of [k] that leads to + at least one path in [m] (it does not mean that the prefix is bound to + a value. + + Example: if [m] has keys "abc0" and "abcd", then [longest_prefix "abc2" m] + will return "abc" + + @since NEXT_RELEASE *) + val update : key -> ('a option -> 'a option) -> 'a t -> 'a t (** Update the binding for the given key. The function is given [None] if the key is absent, or [Some v] if [key] is bound to [v]; From c14191f1bd5cc6f2104ead22a724d303932f48c4 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 20 Apr 2016 10:05:04 +0200 Subject: [PATCH 62/71] small fix for 4.0 compat --- src/data/CCTrie.ml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml index 635dc26f..5aa49a8e 100644 --- a/src/data/CCTrie.ml +++ b/src/data/CCTrie.ml @@ -583,10 +583,8 @@ module Make(W : WORD) | Some v, Above -> k (W.of_list (prefix[]), v) | _ -> () end; - let seq = - seq_of_map map - |> _seq_map (fun (c,t') -> Explore (t', _difflist_add prefix c)) - in + let seq = seq_of_map map in + let seq = _seq_map (fun (c,t') -> Explore (t', _difflist_add prefix c)) seq in let l' = match o, dir with | _, Above -> _seq_append_list [] seq | None, Below -> _seq_append_list_rev [] seq From a3d763bfd9b0f0006d83fab6592251f6756b931b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 21 Apr 2016 15:20:18 +0200 Subject: [PATCH 63/71] add `CCLazy_list` in containers.iter (with a few functions) --- _oasis | 2 +- doc/intro.txt | 5 +- src/iter/CCLazy_list.ml | 109 +++++++++++++++++++++++++++++++++++++++ src/iter/CCLazy_list.mli | 57 ++++++++++++++++++++ 4 files changed, 171 insertions(+), 2 deletions(-) create mode 100644 src/iter/CCLazy_list.ml create mode 100644 src/iter/CCLazy_list.mli diff --git a/_oasis b/_oasis index 23277415..41eebafd 100644 --- a/_oasis +++ b/_oasis @@ -88,7 +88,7 @@ Library "containers_data" Library "containers_iter" Path: src/iter - Modules: CCKTree, CCKList + Modules: CCKTree, CCKList, CCLazy_list FindlibParent: containers FindlibName: iter diff --git a/doc/intro.txt b/doc/intro.txt index e72e0356..6e69309d 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -116,7 +116,10 @@ CCSexpM Iterators: -{!modules: CCKList CCKTree} +{!modules: +CCKList +CCKTree +CCLazy_list} {4 String} diff --git a/src/iter/CCLazy_list.ml b/src/iter/CCLazy_list.ml new file mode 100644 index 00000000..8ffcdd6a --- /dev/null +++ b/src/iter/CCLazy_list.ml @@ -0,0 +1,109 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Lazy List} *) + +type +'a t = 'a node lazy_t +and +'a node = + | Nil + | Cons of 'a * 'a t + +let empty = Lazy.from_val Nil + +let return x = Lazy.from_val (Cons (x, empty)) + +let is_empty = function + | lazy Nil -> true + | lazy (Cons _) -> false + +let cons x tl = Lazy.from_val (Cons (x,tl)) + +let head = function + | lazy Nil -> None + | lazy (Cons (x, tl)) -> Some (x,tl) + +let length l = + let rec aux acc l = match l with + | lazy Nil -> acc + | lazy (Cons (_, tl)) -> aux (acc+1) tl + in + aux 0 l + +(*$Q + Q.(list int) (fun l -> length (of_list l) = List.length l) +*) + +let rec map ~f l = + lazy ( + match l with + | lazy Nil -> Nil + | lazy (Cons (x,tl)) -> Cons (f x, map ~f tl) + ) + +let rec append a b = + lazy ( + match a with + | lazy Nil -> Lazy.force b + | lazy (Cons (x,tl)) -> Cons (x, append tl b) + ) + +(*$Q + Q.(pair (list int) (list int)) (fun (l1,l2) ->\ + length (append (of_list l1) (of_list l2)) = List.length l1 + List.length l2) +*) + +let rec flat_map ~f l = + lazy ( + match l with + | lazy Nil -> Nil + | lazy (Cons (x,tl)) -> + let res = append (f x) (flat_map ~f tl) in + Lazy.force res + ) + +module Infix = struct + let (>|=) x f = map ~f x + let (>>=) x f = flat_map ~f x +end + +include Infix + +type 'a gen = unit -> 'a option + +let rec of_gen g = + lazy ( + match g() with + | None -> Nil + | Some x -> Cons (x, of_gen g) + ) + +(*$Q + Q.(list int) (fun l -> l = (Gen.of_list l |> of_gen |> to_list)) +*) + +let rec of_list = function + | [] -> empty + | x :: tl -> cons x (of_list tl) + +let to_list_rev l = + let rec aux acc = function + | lazy Nil -> acc + | lazy (Cons (x,tl)) -> aux (x::acc) tl + in + aux [] l + +let to_list l = to_list_rev l |> List.rev + +(*$Q + Q.(list int) (fun l -> l = to_list (of_list l)) +*) + +let to_gen l = + let l = ref l in + fun () -> match !l with + | lazy Nil -> None + | lazy (Cons (x,tl)) -> l := tl; Some x + +(*$Q + Q.(list int) (fun l -> l = (of_list l |> to_gen |> Gen.to_list)) +*) diff --git a/src/iter/CCLazy_list.mli b/src/iter/CCLazy_list.mli new file mode 100644 index 00000000..42f1b19b --- /dev/null +++ b/src/iter/CCLazy_list.mli @@ -0,0 +1,57 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Lazy List} + + @since NEXT_RELEASE *) + +type +'a t = 'a node lazy_t +and +'a node = + | Nil + | Cons of 'a * 'a t + +val empty : 'a t +(** Empty list *) + +val return : 'a -> 'a t +(** Return a computed value *) + +val is_empty : _ t -> bool +(** Evaluates the head *) + +val length : _ t -> int +(** [length l] returns the number of elements in [l], eagerly (linear time). + Caution, will not terminate if [l] is infinite *) + +val cons : 'a -> 'a t -> 'a t + +val head : 'a t -> ('a * 'a t) option +(** Evaluate head, return it, or [None] if the list is empty *) + +val map : f:('a -> 'b) -> 'a t -> 'b t +(** Lazy map *) + +val append : 'a t -> 'a t -> 'a t +(** Lazy concatenation *) + +val flat_map : f:('a -> 'b t) -> 'a t -> 'b t +(** Monadic flatten + map *) + +module Infix : sig + val (>|=) : 'a t -> ('a -> 'b) -> 'b t + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t +end + +include module type of Infix + +type 'a gen = unit -> 'a option + +val of_gen : 'a gen -> 'a t + +val of_list : 'a list -> 'a t + +val to_list : 'a t -> 'a list + +val to_list_rev : 'a t -> 'a list + +val to_gen : 'a t -> 'a gen From d587e8aaf4048fa773d3079fa1164f6af9d40301 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 21 Apr 2016 15:54:33 +0200 Subject: [PATCH 64/71] compat --- src/iter/CCLazy_list.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/iter/CCLazy_list.ml b/src/iter/CCLazy_list.ml index 8ffcdd6a..f1627227 100644 --- a/src/iter/CCLazy_list.ml +++ b/src/iter/CCLazy_list.ml @@ -92,7 +92,7 @@ let to_list_rev l = in aux [] l -let to_list l = to_list_rev l |> List.rev +let to_list l = List.rev (to_list_rev l) (*$Q Q.(list int) (fun l -> l = to_list (of_list l)) @@ -105,5 +105,5 @@ let to_gen l = | lazy (Cons (x,tl)) -> l := tl; Some x (*$Q - Q.(list int) (fun l -> l = (of_list l |> to_gen |> Gen.to_list)) + Q.(list int) (fun l -> l = (of_list l |> to_gen |> Gen.to_list))) *) From 871fe7cfb7fa8b8b7be78abbc8281b9d2c90144a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 21 Apr 2016 16:15:19 +0200 Subject: [PATCH 65/71] fix --- src/iter/CCLazy_list.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/iter/CCLazy_list.ml b/src/iter/CCLazy_list.ml index f1627227..ffaf76ce 100644 --- a/src/iter/CCLazy_list.ml +++ b/src/iter/CCLazy_list.ml @@ -105,5 +105,5 @@ let to_gen l = | lazy (Cons (x,tl)) -> l := tl; Some x (*$Q - Q.(list int) (fun l -> l = (of_list l |> to_gen |> Gen.to_list))) + Q.(list int) (fun l -> l = (of_list l |> to_gen |> Gen.to_list)) *) From 9d9f7096008b2d6998644d7930ca7a642c3167c1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 22 Apr 2016 14:22:15 +0200 Subject: [PATCH 66/71] bugfix in `CCFormat.to_file` (fd was closed too early) --- src/core/CCFormat.ml | 18 ++++-------------- 1 file changed, 4 insertions(+), 14 deletions(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 01a1fdcd..c7b82288 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -130,22 +130,12 @@ let fprintf = Format.fprintf let stdout = Format.std_formatter let stderr = Format.err_formatter -let _with_file_out filename f = +let to_file filename format = let oc = open_out filename in let fmt = Format.formatter_of_out_channel oc in - begin try - let x = f fmt in - Format.pp_print_flush fmt (); - close_out oc; - x - with e -> - Format.pp_print_flush fmt (); - close_out_noerr oc; - raise e - end - -let to_file filename format = - _with_file_out filename (fun fmt -> Format.fprintf fmt format) + Format.kfprintf + (fun fmt -> Format.pp_print_flush fmt (); close_out_noerr oc) + fmt format type color = [ `Black From d3b6f6020f83921755fcf3df8a07c651c7c5ebf4 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 22 Apr 2016 15:19:22 +0200 Subject: [PATCH 67/71] add `CCList.{sorted_insert,is_sorted}` --- src/core/CCList.ml | 41 +++++++++++++++++++++++++++++++++++++++++ src/core/CCList.mli | 18 ++++++++++++++++++ 2 files changed, 59 insertions(+) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 1416e5d0..857512ce 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -366,6 +366,47 @@ let sort_uniq (type elt) ?(cmp=Pervasives.compare) l = sort_uniq [10;10;10;10;1;10] = [1;10] *) +let is_sorted ?(cmp=Pervasives.compare) l = + let rec aux cmp = function + | [] | [_] -> true + | x :: ((y :: _) as tail) -> cmp x y <= 0 && aux cmp tail + in + aux cmp l + +(*$Q + Q.(list small_int) (fun l -> \ + is_sorted (List.sort Pervasives.compare l)) +*) + +let sorted_insert ?(cmp=Pervasives.compare) ?(uniq=false) x l = + let rec aux cmp uniq x left l = match l with + | [] -> List.rev_append left [x] + | y :: tail -> + match cmp x y with + | 0 -> + let l' = if uniq then l else x :: l in + List.rev_append left l' + | n when n<0 -> List.rev_append left (x :: l) + | _ -> aux cmp uniq x (y::left) tail + in + aux cmp uniq x [] l + +(*$Q + Q.(pair small_int (list small_int)) (fun (x,l) -> \ + let l = List.sort Pervasives.compare l in \ + is_sorted (sorted_insert ~uniq:true x l)) + Q.(pair small_int (list small_int)) (fun (x,l) -> \ + let l = List.sort Pervasives.compare l in \ + is_sorted (sorted_insert ~uniq:false x l)) + Q.(pair small_int (list small_int)) (fun (x,l) -> \ + let l = List.sort Pervasives.compare l in \ + let l' = sorted_insert ~uniq:false x l in \ + List.length l' = List.length l + 1) + Q.(pair small_int (list small_int)) (fun (x,l) -> \ + let l = List.sort Pervasives.compare l in \ + List.mem x (sorted_insert x l)) +*) + let uniq_succ ?(eq=(=)) l = let rec f acc l = match l with | [] -> List.rev acc diff --git a/src/core/CCList.mli b/src/core/CCList.mli index a3cacac1..68d593d0 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -184,6 +184,24 @@ val sorted_merge_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list removes duplicates @since 0.10 *) +val is_sorted : ?cmp:('a -> 'a -> int) -> 'a list -> bool +(** [is_sorted l] returns [true] iff [l] is sorted (according to given order) + @param cmp the comparison function (default [Pervasives.compare]) + @since NEXT_RELEASE *) + +val sorted_insert : ?cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list +(** [sorted_insert x l] inserts [x] into [l] such that, if [l] was sorted, + then [sorted_insert x l] is sorted too. + @param uniq if true and [x] is already in sorted position in [l], then + [x] is not duplicated. Default [false] ([x] will be inserted in any case). + @since NEXT_RELEASE *) + +(*$Q + Q.(pair small_int (list small_int)) (fun (x,l) -> \ + let l = List.sort Pervasives.compare l in \ + is_sorted (sorted_insert x l)) +*) + val uniq_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list (** [uniq_succ l] removes duplicate elements that occur one next to the other. Examples: From b17f55b1d103dd53483d76f669eeee222088622e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 22 Apr 2016 22:07:06 +0200 Subject: [PATCH 68/71] add monomorphic signatures in `CCInt` and `CCFloat` --- src/core/CCFloat.ml | 10 ++++++++++ src/core/CCFloat.mli | 25 +++++++++++++++++++++++++ src/core/CCInt.ml | 12 ++++++++++++ src/core/CCInt.mli | 31 +++++++++++++++++++++++++++++++ 4 files changed, 78 insertions(+) diff --git a/src/core/CCFloat.ml b/src/core/CCFloat.ml index 6e4a5b56..2fbbe071 100644 --- a/src/core/CCFloat.ml +++ b/src/core/CCFloat.ml @@ -74,3 +74,13 @@ let random_range i j st = i +. random (j-.i) st let equal_precision ~epsilon a b = abs_float (a-.b) < epsilon let classify = Pervasives.classify_float + +module Infix = struct + let (=) = Pervasives.(=) + let (<>) = Pervasives.(<>) + let (<) = Pervasives.(<) + let (>) = Pervasives.(>) + let (<=) = Pervasives.(<=) + let (>=) = Pervasives.(>=) +end +include Infix diff --git a/src/core/CCFloat.mli b/src/core/CCFloat.mli index 4fa7f9ab..f206aec7 100644 --- a/src/core/CCFloat.mli +++ b/src/core/CCFloat.mli @@ -76,3 +76,28 @@ val equal_precision : epsilon:t -> t -> t -> bool (** Equality with allowed error up to a non negative epsilon value *) val classify : float -> fpclass + +(** {2 Infix Operators} + + @since NEXT_RELEASE *) +module Infix : sig + val (=) : t -> t -> bool + (** @since NEXT_RELEASE *) + + val (<>) : t -> t -> bool + (** @since NEXT_RELEASE *) + + val (<) : t -> t -> bool + (** @since NEXT_RELEASE *) + + val (>) : t -> t -> bool + (** @since NEXT_RELEASE *) + + val (<=) : t -> t -> bool + (** @since NEXT_RELEASE *) + + val (>=) : t -> t -> bool + (** @since NEXT_RELEASE *) +end + +include module type of Infix diff --git a/src/core/CCInt.ml b/src/core/CCInt.ml index 506ab79f..ba1d82a2 100644 --- a/src/core/CCInt.ml +++ b/src/core/CCInt.ml @@ -53,3 +53,15 @@ let to_string = string_of_int let of_string s = try Some (int_of_string s) with _ -> None + +module Infix = struct + let (=) = Pervasives.(=) + let (<>) = Pervasives.(<>) + let (<) = Pervasives.(<) + let (>) = Pervasives.(>) + let (<=) = Pervasives.(<=) + let (>=) = Pervasives.(>=) +end +include Infix +let min = min +let max = max diff --git a/src/core/CCInt.mli b/src/core/CCInt.mli index a07240c6..d5e68952 100644 --- a/src/core/CCInt.mli +++ b/src/core/CCInt.mli @@ -39,3 +39,34 @@ val to_string : t -> string val of_string : string -> t option (** @since 0.13 *) + +val min : t -> t -> t +(** @since NEXT_RELEASE *) + +val max : t -> t -> t +(** @since NEXT_RELEASE *) + +(** {2 Infix Operators} + + @since NEXT_RELEASE *) +module Infix : sig + val (=) : t -> t -> bool + (** @since NEXT_RELEASE *) + + val (<>) : t -> t -> bool + (** @since NEXT_RELEASE *) + + val (<) : t -> t -> bool + (** @since NEXT_RELEASE *) + + val (>) : t -> t -> bool + (** @since NEXT_RELEASE *) + + val (<=) : t -> t -> bool + (** @since NEXT_RELEASE *) + + val (>=) : t -> t -> bool + (** @since NEXT_RELEASE *) +end + +include module type of Infix From 0485bc5cd915bb79e483286baf2fc9a71ddcb76e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 22 Apr 2016 22:08:40 +0200 Subject: [PATCH 69/71] formattign, headers --- src/data/CCFQueue.ml | 172 ++++++++++++++++++------------------------ src/data/CCFQueue.mli | 32 ++------ src/iter/CCKList.ml | 160 +++++++++++++++++---------------------- src/iter/CCKList.mli | 24 +----- 4 files changed, 150 insertions(+), 238 deletions(-) diff --git a/src/data/CCFQueue.ml b/src/data/CCFQueue.ml index a6b4d771..4e4e141c 100644 --- a/src/data/CCFQueue.ml +++ b/src/data/CCFQueue.ml @@ -1,27 +1,5 @@ -(* -Copyright (c) 2013, Simon Cruanes -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. Redistributions in binary -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 file is free software, part of containers. See file "license" for more details. *) (** {1 Functional queues (fifo)} *) @@ -73,39 +51,39 @@ let _empty = Lazy.from_val empty let rec cons : 'a. 'a -> 'a t -> 'a t = fun x q -> match q with - | Shallow Zero -> _single x - | Shallow (One y) -> Shallow (Two (x,y)) - | Shallow (Two (y,z)) -> Shallow (Three (x,y,z)) - | Shallow (Three (y,z,z')) -> + | Shallow Zero -> _single x + | Shallow (One y) -> Shallow (Two (x,y)) + | Shallow (Two (y,z)) -> Shallow (Three (x,y,z)) + | Shallow (Three (y,z,z')) -> _deep 4 (Two (x,y)) _empty (Two (z,z')) - | Deep (_, Zero, _middle, _tl) -> assert false - | Deep (n,One y, middle, tl) -> _deep (n+1) (Two (x,y)) middle tl - | Deep (n,Two (y,z), middle, tl) -> _deep (n+1)(Three (x,y,z)) middle tl - | Deep (n,Three (y,z,z'), lazy q', tail) -> + | Deep (_, Zero, _middle, _tl) -> assert false + | Deep (n,One y, middle, tl) -> _deep (n+1) (Two (x,y)) middle tl + | Deep (n,Two (y,z), middle, tl) -> _deep (n+1)(Three (x,y,z)) middle tl + | Deep (n,Three (y,z,z'), lazy q', tail) -> _deep (n+1) (Two (x,y)) (lazy (cons (z,z') q')) tail (*$Q (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \ cons x (of_list l) |> to_list = x::l) - *) +*) let rec snoc : 'a. 'a t -> 'a -> 'a t = fun q x -> match q with - | Shallow Zero -> _single x - | Shallow (One y) -> Shallow (Two (y,x)) - | Shallow (Two (y,z)) -> Shallow (Three (y,z,x)) - | Shallow (Three (y,z,z')) -> + | Shallow Zero -> _single x + | Shallow (One y) -> Shallow (Two (y,x)) + | Shallow (Two (y,z)) -> Shallow (Three (y,z,x)) + | Shallow (Three (y,z,z')) -> _deep 4 (Two (y,z)) _empty (Two (z',x)) - | Deep (_,_hd, _middle, Zero) -> assert false - | Deep (n,hd, middle, One y) -> _deep (n+1) hd middle (Two(y,x)) - | Deep (n,hd, middle, Two (y,z)) -> _deep (n+1) hd middle (Three(y,z,x)) - | Deep (n,hd, lazy q', Three (y,z,z')) -> + | Deep (_,_hd, _middle, Zero) -> assert false + | Deep (n,hd, middle, One y) -> _deep (n+1) hd middle (Two(y,x)) + | Deep (n,hd, middle, Two (y,z)) -> _deep (n+1) hd middle (Three(y,z,x)) + | Deep (n,hd, lazy q', Three (y,z,z')) -> _deep (n+1) hd (lazy (snoc q' (y,z))) (Two(z',x)) (*$Q (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \ snoc (of_list l) x |> to_list = l @ [x]) - *) +*) (*$R let q = List.fold_left snoc empty [1;2;3;4;5] in @@ -117,27 +95,27 @@ let rec snoc : 'a. 'a t -> 'a -> 'a t let rec take_front_exn : 'a. 'a t -> ('a *'a t) = fun q -> match q with - | Shallow Zero -> raise Empty - | Shallow (One x) -> x, empty - | Shallow (Two (x,y)) -> x, Shallow (One y) - | Shallow (Three (x,y,z)) -> x, Shallow (Two (y,z)) - | Deep (_,Zero, _, _) -> assert false - | Deep (n,One x, lazy q', tail) -> + | Shallow Zero -> raise Empty + | Shallow (One x) -> x, empty + | Shallow (Two (x,y)) -> x, Shallow (One y) + | Shallow (Three (x,y,z)) -> x, Shallow (Two (y,z)) + | Deep (_,Zero, _, _) -> assert false + | Deep (n,One x, lazy q', tail) -> if is_empty q' - then x, Shallow tail - else - let (y,z), q' = take_front_exn q' in - x, _deep (n-1)(Two (y,z)) (Lazy.from_val q') tail - | Deep (n,Two (x,y), middle, tail) -> + then x, Shallow tail + else + let (y,z), q' = take_front_exn q' in + x, _deep (n-1)(Two (y,z)) (Lazy.from_val q') tail + | Deep (n,Two (x,y), middle, tail) -> x, _deep (n-1) (One y) middle tail - | Deep (n,Three (x,y,z), middle, tail) -> + | Deep (n,Three (x,y,z), middle, tail) -> x, _deep (n-1) (Two(y,z)) middle tail (*$Q (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \ let x', q = cons x (of_list l) |> take_front_exn in \ x'=x && to_list q = l) - *) +*) (*$R let q = of_list [1;2;3;4] in @@ -180,25 +158,25 @@ let take_front_while p q = let rec take_back_exn : 'a. 'a t -> 'a t * 'a = fun q -> match q with - | Shallow Zero -> invalid_arg "FQueue.take_back_exn" - | Shallow (One x) -> empty, x - | Shallow (Two (x,y)) -> _single x, y - | Shallow (Three (x,y,z)) -> Shallow (Two(x,y)), z - | Deep (_, _hd, _middle, Zero) -> assert false - | Deep (n, hd, lazy q', One x) -> + | Shallow Zero -> invalid_arg "FQueue.take_back_exn" + | Shallow (One x) -> empty, x + | Shallow (Two (x,y)) -> _single x, y + | Shallow (Three (x,y,z)) -> Shallow (Two(x,y)), z + | Deep (_, _hd, _middle, Zero) -> assert false + | Deep (n, hd, lazy q', One x) -> if is_empty q' - then Shallow hd, x - else - let q'', (y,z) = take_back_exn q' in - _deep (n-1) hd (Lazy.from_val q'') (Two (y,z)), x - | Deep (n, hd, middle, Two(x,y)) -> _deep (n-1) hd middle (One x), y - | Deep (n, hd, middle, Three(x,y,z)) -> _deep (n-1) hd middle (Two (x,y)), z + then Shallow hd, x + else + let q'', (y,z) = take_back_exn q' in + _deep (n-1) hd (Lazy.from_val q'') (Two (y,z)), x + | Deep (n, hd, middle, Two(x,y)) -> _deep (n-1) hd middle (One x), y + | Deep (n, hd, middle, Three(x,y,z)) -> _deep (n-1) hd middle (Two (x,y)), z (*$Q (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \ let q,x' = snoc (of_list l) x |> take_back_exn in \ x'=x && to_list q = l) - *) +*) let take_back q = try Some (take_back_exn q) @@ -242,8 +220,8 @@ let _size_digit = function let size : 'a. 'a t -> int = function - | Shallow d -> _size_digit d - | Deep (n, _, _, _) -> n + | Shallow d -> _size_digit d + | Deep (n, _, _, _) -> n (*$Q (Q.list Q.int) (fun l -> \ @@ -262,15 +240,15 @@ let _nth_digit i d = match i, d with let rec nth_exn : 'a. int -> 'a t -> 'a = fun i q -> match i, q with - | _, Shallow Zero -> raise Not_found - | 0, Shallow (One x) -> x - | 0, Shallow (Two (x,_)) -> x - | 1, Shallow (Two (_,x)) -> x - | 0, Shallow (Three (x,_,_)) -> x - | 1, Shallow (Three (_,x,_)) -> x - | 2, Shallow (Three (_,_,x)) -> x - | _, Shallow _ -> raise Not_found - | _, Deep (_, l, q, r) -> + | _, Shallow Zero -> raise Not_found + | 0, Shallow (One x) -> x + | 0, Shallow (Two (x,_)) -> x + | 1, Shallow (Two (_,x)) -> x + | 0, Shallow (Three (x,_,_)) -> x + | 1, Shallow (Three (_,x,_)) -> x + | 2, Shallow (Three (_,_,x)) -> x + | _, Shallow _ -> raise Not_found + | _, Deep (_, l, q, r) -> if i<_size_digit l then _nth_digit i l else @@ -326,7 +304,7 @@ let add_seq_front seq q = (*$Q Q.(pair (list int) (list int)) (fun (l1, l2) -> \ add_seq_front (Sequence.of_list l1) (of_list l2) |> to_list = l1 @ l2) - *) +*) let add_seq_back q seq = let q = ref q in @@ -341,8 +319,8 @@ let _digit_to_seq d k = match d with let rec to_seq : 'a. 'a t -> 'a sequence = fun q k -> match q with - | Shallow d -> _digit_to_seq d k - | Deep (_, hd, lazy q', tail) -> + | Shallow d -> _digit_to_seq d k + | Deep (_, hd, lazy q', tail) -> _digit_to_seq hd k; to_seq q' (fun (x,y) -> k x; k y); _digit_to_seq tail k @@ -354,9 +332,9 @@ let rec to_seq : 'a. 'a t -> 'a sequence let append q1 q2 = match q1, q2 with - | Shallow Zero, _ -> q2 - | _, Shallow Zero -> q1 - | _ -> add_seq_back q1 (to_seq q2) + | Shallow Zero, _ -> q2 + | _, Shallow Zero -> q1 + | _ -> add_seq_back q1 (to_seq q2) (*$Q (Q.pair (Q.list Q.int)(Q.list Q.int)) (fun (l1,l2) -> \ @@ -379,8 +357,8 @@ let _map_digit f d = match d with let rec map : 'a 'b. ('a -> 'b) -> 'a t -> 'b t = fun f q -> match q with - | Shallow d -> Shallow (_map_digit f d) - | Deep (size, hd, lazy q', tl) -> + | Shallow d -> Shallow (_map_digit f d) + | Deep (size, hd, lazy q', tl) -> let q'' = map (fun (x,y) -> f x, f y) q' in _deep size (_map_digit f hd) (Lazy.from_val q'') (_map_digit f tl) @@ -399,8 +377,8 @@ let _fold_digit f acc d = match d with let rec fold : 'a 'b. ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b = fun f acc q -> match q with - | Shallow d -> _fold_digit f acc d - | Deep (_, hd, lazy q', tl) -> + | Shallow d -> _fold_digit f acc d + | Deep (_, hd, lazy q', tl) -> let acc = _fold_digit f acc hd in let acc = fold (fun acc (x,y) -> f (f acc x) y) acc q' in _fold_digit f acc tl @@ -455,18 +433,18 @@ let _digit_to_klist d cont = match d with let rec _flat_klist : 'a. ('a * 'a) klist -> 'a klist -> 'a klist = fun l cont () -> match l () with - | `Nil -> cont () - | `Cons ((x,y),l') -> _double x y (_flat_klist l' cont) () + | `Nil -> cont () + | `Cons ((x,y),l') -> _double x y (_flat_klist l' cont) () let to_klist q = let rec aux : 'a. 'a t -> 'a klist -> 'a klist = fun q cont () -> match q with - | Shallow d -> _digit_to_klist d cont () - | Deep (_, hd, lazy q', tl) -> + | Shallow d -> _digit_to_klist d cont () + | Deep (_, hd, lazy q', tl) -> _digit_to_klist hd (_flat_klist - (aux q' _nil) - (_digit_to_klist tl cont)) + (aux q' _nil) + (_digit_to_klist tl cont)) () in aux q _nil @@ -483,7 +461,7 @@ let rec _equal_klist eq l1 l2 = match l1(), l2() with | `Nil, _ | _, `Nil -> false | `Cons(x1,l1'), `Cons(x2,l2') -> - eq x1 x2 && _equal_klist eq l1' l2' + eq x1 x2 && _equal_klist eq l1' l2' let equal eq q1 q2 = _equal_klist eq (to_klist q1) (to_klist q2) @@ -512,7 +490,7 @@ let print pp_x out d = Format.fprintf out "@[queue {"; iter (fun x -> - if !first then first:= false else Format.fprintf out ";@ "; - pp_x out x + if !first then first:= false else Format.fprintf out ";@ "; + pp_x out x ) d; Format.fprintf out "}@]" diff --git a/src/data/CCFQueue.mli b/src/data/CCFQueue.mli index 5f76d5b6..29c0b58d 100644 --- a/src/data/CCFQueue.mli +++ b/src/data/CCFQueue.mli @@ -1,27 +1,5 @@ -(* -Copyright (c) 2013, Simon Cruanes -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. Redistributions in binary -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 file is free software, part of containers. See file "license" for more details. *) (** {1 Functional queues} *) @@ -33,7 +11,7 @@ type 'a printer = Format.formatter -> 'a -> unit (** {2 Basics} *) type +'a t - (** Queue containing elements of type 'a *) +(** Queue containing elements of type 'a *) val empty : 'a t @@ -107,9 +85,9 @@ val init : 'a t -> 'a t (** {2 Global Operations} *) val append : 'a t -> 'a t -> 'a t - (** Append two queues. Elements from the second one come - after elements of the first one. - Linear in the size of the second queue. *) +(** Append two queues. Elements from the second one come + after elements of the first one. + Linear in the size of the second queue. *) val rev : 'a t -> 'a t (** Reverse the queue, O(n) complexity diff --git a/src/iter/CCKList.ml b/src/iter/CCKList.ml index b09d4dde..e4d88428 100644 --- a/src/iter/CCKList.ml +++ b/src/iter/CCKList.ml @@ -1,27 +1,5 @@ -(* -Copyright (c) 2013, Simon Cruanes -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. Redistributions in binary -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 file is free software, part of containers. See file "license" for more details. *) (** {1 Continuation List} *) @@ -72,15 +50,15 @@ let rec equal eq l1 l2 = match l1(), l2() with | `Nil, _ | _, `Nil -> false | `Cons (x1,l1'), `Cons (x2,l2') -> - eq x1 x2 && equal eq l1' l2' + eq x1 x2 && equal eq l1' l2' let rec compare cmp l1 l2 = match l1(), l2() with | `Nil, `Nil -> 0 | `Nil, _ -> -1 | _, `Nil -> 1 | `Cons (x1,l1'), `Cons (x2,l2') -> - let c = cmp x1 x2 in - if c = 0 then compare cmp l1' l2' else c + let c = cmp x1 x2 in + if c = 0 then compare cmp l1' l2' else c let rec fold f acc res = match res () with | `Nil -> acc @@ -94,8 +72,8 @@ let iteri f l = let rec aux f l i = match l() with | `Nil -> () | `Cons (x, l') -> - f i x; - aux f l' (i+1) + f i x; + aux f l' (i+1) in aux f l 0 @@ -110,7 +88,7 @@ let rec take n (l:'a t) () = let rec take_while p l () = match l () with | `Nil -> `Nil | `Cons (x,l') -> - if p x then `Cons (x, take_while p l') else `Nil + if p x then `Cons (x, take_while p l') else `Nil (*$T of_list [1;2;3;4] |> take_while (fun x->x < 4) |> to_list = [1;2;3] @@ -144,7 +122,7 @@ let mapi f l = let rec aux f l i () = match l() with | `Nil -> `Nil | `Cons (x, tl) -> - `Cons (f i x, aux f tl (i+1)) + `Cons (f i x, aux f tl (i+1)) in aux f l 0 @@ -155,10 +133,10 @@ let mapi f l = let rec fmap f (l:'a t) () = match l() with | `Nil -> `Nil | `Cons (x, l') -> - begin match f x with + begin match f x with | None -> fmap f l' () | Some y -> `Cons (y, fmap f l') - end + end (*$T fmap (fun x -> if x mod 2=0 then Some (x*3) else None) (1--10) |> to_list \ @@ -168,9 +146,9 @@ let rec fmap f (l:'a t) () = match l() with let rec filter p l () = match l () with | `Nil -> `Nil | `Cons (x, l') -> - if p x - then `Cons (x, filter p l') - else filter p l' () + if p x + then `Cons (x, filter p l') + else filter p l' () let rec append l1 l2 () = match l1 () with | `Nil -> l2 () @@ -195,25 +173,25 @@ let rec unfold f acc () = match f acc with let rec flat_map f l () = match l () with | `Nil -> `Nil | `Cons (x, l') -> - _flat_map_app f (f x) l' () + _flat_map_app f (f x) l' () and _flat_map_app f l l' () = match l () with | `Nil -> flat_map f l' () | `Cons (x, tl) -> - `Cons (x, _flat_map_app f tl l') + `Cons (x, _flat_map_app f tl l') let product_with f l1 l2 = let rec _next_left h1 tl1 h2 tl2 () = match tl1() with - | `Nil -> _next_right ~die:true h1 tl1 h2 tl2 () - | `Cons (x, tl1') -> + | `Nil -> _next_right ~die:true h1 tl1 h2 tl2 () + | `Cons (x, tl1') -> _map_list_left x h2 (_next_right ~die:false (x::h1) tl1' h2 tl2) () and _next_right ~die h1 tl1 h2 tl2 () = match tl2() with - | `Nil when die -> `Nil - | `Nil -> _next_left h1 tl1 h2 tl2 () - | `Cons (y, tl2') -> + | `Nil when die -> `Nil + | `Nil -> _next_left h1 tl1 h2 tl2 () + | `Cons (y, tl2') -> _map_list_right h1 y (_next_left h1 tl1 (y::h2) tl2') () @@ -232,7 +210,7 @@ let product l1 l2 = let rec group eq l () = match l() with | `Nil -> `Nil | `Cons (x, l') -> - `Cons (cons x (take_while (eq x) l'), group eq (drop_while (eq x) l')) + `Cons (cons x (take_while (eq x) l'), group eq (drop_while (eq x) l')) (*$T of_list [1;1;1;2;2;3;3;1] |> group (=) |> map to_list |> to_list = \ @@ -242,21 +220,21 @@ let rec group eq l () = match l() with let rec _uniq eq prev l () = match prev, l() with | _, `Nil -> `Nil | None, `Cons (x, l') -> - `Cons (x, _uniq eq (Some x) l') + `Cons (x, _uniq eq (Some x) l') | Some y, `Cons (x, l') -> - if eq x y - then _uniq eq prev l' () - else `Cons (x, _uniq eq (Some x) l') + if eq x y + then _uniq eq prev l' () + else `Cons (x, _uniq eq (Some x) l') let uniq eq l = _uniq eq None l let rec filter_map f l () = match l() with | `Nil -> `Nil | `Cons (x, l') -> - begin match f x with + begin match f x with | None -> filter_map f l' () | Some y -> `Cons (y, filter_map f l') - end + end let flatten l = flat_map (fun x->x) l @@ -279,39 +257,39 @@ let rec fold2 f acc l1 l2 = match l1(), l2() with | `Nil, _ | _, `Nil -> acc | `Cons(x1,l1'), `Cons(x2,l2') -> - fold2 f (f acc x1 x2) l1' l2' + fold2 f (f acc x1 x2) l1' l2' let rec map2 f l1 l2 () = match l1(), l2() with | `Nil, _ | _, `Nil -> `Nil | `Cons(x1,l1'), `Cons(x2,l2') -> - `Cons (f x1 x2, map2 f l1' l2') + `Cons (f x1 x2, map2 f l1' l2') let rec iter2 f l1 l2 = match l1(), l2() with | `Nil, _ | _, `Nil -> () | `Cons(x1,l1'), `Cons(x2,l2') -> - f x1 x2; iter2 f l1' l2' + f x1 x2; iter2 f l1' l2' let rec for_all2 f l1 l2 = match l1(), l2() with | `Nil, _ | _, `Nil -> true | `Cons(x1,l1'), `Cons(x2,l2') -> - f x1 x2 && for_all2 f l1' l2' + f x1 x2 && for_all2 f l1' l2' let rec exists2 f l1 l2 = match l1(), l2() with | `Nil, _ | _, `Nil -> false | `Cons(x1,l1'), `Cons(x2,l2') -> - f x1 x2 || exists2 f l1' l2' + f x1 x2 || exists2 f l1' l2' let rec merge cmp l1 l2 () = match l1(), l2() with | `Nil, tl2 -> tl2 | tl1, `Nil -> tl1 | `Cons(x1,l1'), `Cons(x2,l2') -> - if cmp x1 x2 < 0 - then `Cons (x1, merge cmp l1' l2) - else `Cons (x2, merge cmp l1 l2') + if cmp x1 x2 < 0 + then `Cons (x1, merge cmp l1' l2) + else `Cons (x2, merge cmp l1 l2') let rec zip a b () = match a(), b() with | `Nil, _ @@ -373,14 +351,14 @@ let of_array a = let to_array l = match l() with - | `Nil -> [| |] - | `Cons (x, _) -> - let n = length l in - let a = Array.make n x in (* need first elem to create [a] *) - iteri - (fun i x -> a.(i) <- x) - l; - a + | `Nil -> [| |] + | `Cons (x, _) -> + let n = length l in + let a = Array.make n x in (* need first elem to create [a] *) + iteri + (fun i x -> a.(i) <- x) + l; + a (*$Q Q.(array int) (fun a -> of_array a |> to_array = a) @@ -399,8 +377,8 @@ let to_gen l = let l = ref l in fun () -> match !l () with - | `Nil -> None - | `Cons (x,l') -> + | `Nil -> None + | `Cons (x,l') -> l := l'; Some x @@ -412,16 +390,16 @@ let of_gen g = let rec consume r () = match !r with | Of_gen_saved cons -> cons | Of_gen_thunk g -> - begin match g() with + begin match g() with | None -> - r := Of_gen_saved `Nil; - `Nil + r := Of_gen_saved `Nil; + `Nil | Some x -> - let tl = consume (ref (Of_gen_thunk g)) in - let l = `Cons (x, tl) in - r := Of_gen_saved l; - l - end + let tl = consume (ref (Of_gen_thunk g)) in + let l = `Cons (x, tl) in + r := Of_gen_saved l; + l + end in consume (ref (Of_gen_thunk g)) @@ -450,12 +428,12 @@ let rec memoize f = fun () -> match !r with | MemoSave l -> l | MemoThunk -> - let l = match f() with - | `Nil -> `Nil - | `Cons (x, tail) -> `Cons (x, memoize tail) - in - r := MemoSave l; - l + let l = match f() with + | `Nil -> `Nil + | `Cons (x, tail) -> `Cons (x, memoize tail) + in + r := MemoSave l; + l (*$R let printer = Q.Print.(list int) in @@ -480,13 +458,13 @@ let rec interleave a b () = match a() with let rec fair_flat_map f a () = match a() with | `Nil -> `Nil | `Cons (x, tail) -> - let y = f x in - interleave y (fair_flat_map f tail) () + let y = f x in + interleave y (fair_flat_map f tail) () let rec fair_app f a () = match f() with | `Nil -> `Nil | `Cons (f1, fs) -> - interleave (map f1 a) (fair_app fs a) () + interleave (map f1 a) (fair_app fs a) () let (>>-) a f = fair_flat_map f a let (<.>) f a = fair_app f a @@ -511,8 +489,8 @@ module Traverse(M : MONAD) = struct let rec aux acc l = match l () with | `Nil -> return (of_list (List.rev acc)) | `Cons (x,l') -> - f x >>= fun x' -> - aux (x' :: acc) l' + f x >>= fun x' -> + aux (x' :: acc) l' in aux [] l @@ -521,7 +499,7 @@ module Traverse(M : MONAD) = struct let rec fold_m f acc l = match l() with | `Nil -> return acc | `Cons (x,l') -> - f acc x >>= fun acc' -> fold_m f acc' l' + f acc x >>= fun acc' -> fold_m f acc' l' end (** {2 IO} *) @@ -539,10 +517,10 @@ let print ?(sep=",") pp_item fmt l = let rec pp fmt l = match l() with | `Nil -> () | `Cons (x,l') -> - Format.pp_print_string fmt sep; - Format.pp_print_cut fmt (); - pp_item fmt x; - pp fmt l' + Format.pp_print_string fmt sep; + Format.pp_print_cut fmt (); + pp_item fmt x; + pp fmt l' in match l() with | `Nil -> () diff --git a/src/iter/CCKList.mli b/src/iter/CCKList.mli index 2620181e..7fb1c879 100644 --- a/src/iter/CCKList.mli +++ b/src/iter/CCKList.mli @@ -1,27 +1,5 @@ -(* -Copyright (c) 2013, Simon Cruanes -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. Redistributions in binary -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 file is free software, part of containers. See file "license" for more details. *) (** {1 Continuation List} *) From bb74a3338596032fb4f8abda8dd3867f7673fb90 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 22 Apr 2016 22:50:37 +0200 Subject: [PATCH 70/71] add `(--^)` to CCRAl, CCFQueue, CCKlist (closes #56); add `CCKList.Infix` --- src/data/CCFQueue.ml | 12 ++++++++++++ src/data/CCFQueue.mli | 4 ++++ src/data/CCRAL.ml | 13 +++++++++++++ src/data/CCRAL.mli | 4 ++++ src/iter/CCKList.ml | 24 ++++++++++++++++++++++++ src/iter/CCKList.mli | 20 ++++++++++++++++++++ 6 files changed, 77 insertions(+) diff --git a/src/data/CCFQueue.ml b/src/data/CCFQueue.ml index 4e4e141c..0f01245d 100644 --- a/src/data/CCFQueue.ml +++ b/src/data/CCFQueue.ml @@ -485,6 +485,18 @@ let (--) a b = 0 -- 0 |> to_list = [0] *) +let (--^) a b = + if a=b then empty + else if a to_list = [1;2;3;4] + 5 --^ 1 |> to_list = [5;4;3;2] + 1 --^ 2 |> to_list = [1] + 0 --^ 0 |> to_list = [] +*) + let print pp_x out d = let first = ref true in Format.fprintf out "@[queue {"; diff --git a/src/data/CCFQueue.mli b/src/data/CCFQueue.mli index 29c0b58d..7f81e42c 100644 --- a/src/data/CCFQueue.mli +++ b/src/data/CCFQueue.mli @@ -127,5 +127,9 @@ val (--) : int -> int -> int t (** [a -- b] is the integer range from [a] to [b], both included. @since 0.10 *) +val (--^) : int -> int -> int t +(** [a -- b] is the integer range from [a] to [b], where [b] is excluded. + @since NEXT_RELEASE *) + val print : 'a printer -> 'a t printer (** @since 0.13 *) diff --git a/src/data/CCRAL.ml b/src/data/CCRAL.ml index 697e2bb5..d2a39474 100644 --- a/src/data/CCRAL.ml +++ b/src/data/CCRAL.ml @@ -426,6 +426,18 @@ let range i j = range i j |> to_list = CCList.(i -- j) ) *) +let range_r_open_ i j = + if i=j then empty + else if i to_list) + [5;4;3;2] (5 --^ 1 |> to_list) + [1] (1 --^ 2 |> to_list) + [] (0 --^ 0 |> to_list) +*) + (** {2 Conversions} *) type 'a sequence = ('a -> unit) -> unit @@ -554,6 +566,7 @@ module Infix = struct let (>|=) l f = map ~f l let (<*>) = app let (--) = range + let (--^) = range_r_open_ end include Infix diff --git a/src/data/CCRAL.mli b/src/data/CCRAL.mli index 081645ce..f716b294 100644 --- a/src/data/CCRAL.mli +++ b/src/data/CCRAL.mli @@ -175,6 +175,10 @@ module Infix : sig val (--) : int -> int -> int t (** Alias to {!range} *) + + val (--^) : int -> int -> int t + (** [a -- b] is the integer range from [a] to [b], where [b] is excluded. + @since NEXT_RELEASE *) end include module type of Infix diff --git a/src/iter/CCKList.ml b/src/iter/CCKList.ml index e4d88428..d161df8c 100644 --- a/src/iter/CCKList.ml +++ b/src/iter/CCKList.ml @@ -253,6 +253,18 @@ let range i j = let (--) = range +let (--^) i j = + if i=j then empty + else if i to_list = [1;2;3;4] + 5 --^ 1 |> to_list = [5;4;3;2] + 1 --^ 2 |> to_list = [1] + 0 --^ 0 |> to_list = [] +*) + let rec fold2 f acc l1 l2 = match l1(), l2() with | `Nil, _ | _, `Nil -> acc @@ -475,6 +487,18 @@ let (<.>) f a = fair_app f a |> to_list |> List.sort Pervasives.compare = [2; 3; 11; 30] *) +(** {2 Infix} *) + +module Infix = struct + let (>>=) = (>>=) + let (>|=) = (>|=) + let (<*>) = (<*>) + let (>>-) = (>>-) + let (<.>) = (<.>) + let (--) = (--) + let (--^) = (--^) +end + (** {2 Monadic Operations} *) module type MONAD = sig type 'a t diff --git a/src/iter/CCKList.mli b/src/iter/CCKList.mli index 7fb1c879..ab96ff38 100644 --- a/src/iter/CCKList.mli +++ b/src/iter/CCKList.mli @@ -130,6 +130,12 @@ val flatten : 'a t t -> 'a t val range : int -> int -> int t val (--) : int -> int -> int t +(** [a -- b] is the range of integers containing + [a] and [b] (therefore, never empty) *) + +val (--^) : int -> int -> int t +(** [a -- b] is the integer range from [a] to [b], where [b] is excluded. + @since NEXT_RELEASE *) (** {2 Operations on two Collections} *) @@ -204,6 +210,20 @@ val (<.>) : ('a -> 'b) t -> 'a t -> 'b t (** Infix version of {!fair_app} @since 0.13 *) +(** {2 Infix operators} + + @since NEXT_RELEASE *) + +module Infix : sig + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t + val (>|=) : 'a t -> ('a -> 'b) -> 'b t + val (<*>) : ('a -> 'b) t -> 'a t -> 'b t + val (>>-) : 'a t -> ('a -> 'b t) -> 'b t + val (<.>) : ('a -> 'b) t -> 'a t -> 'b t + val (--) : int -> int -> int t + val (--^) : int -> int -> int t +end + (** {2 Monadic Operations} *) module type MONAD = sig type 'a t From 73eecfb10d7282924340477d57ab3c647bdcf75a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 22 Apr 2016 23:01:37 +0200 Subject: [PATCH 71/71] prepare for 0.17 --- CHANGELOG.adoc | 53 +++++++++++++++++++++++++++++++++++++++ _oasis | 2 +- src/core/CCArray.mli | 2 +- src/core/CCFloat.mli | 14 +++++------ src/core/CCFormat.mli | 4 +-- src/core/CCIO.mli | 2 +- src/core/CCInt.mli | 18 ++++++------- src/core/CCList.mli | 12 ++++----- src/core/CCMap.ml | 2 +- src/core/CCMap.mli | 2 +- src/core/CCOpt.mli | 6 ++--- src/core/CCRef.mli | 4 +-- src/core/CCResult.mli | 4 +-- src/core/CCString.mli | 22 ++++++++-------- src/core/CCVector.mli | 2 +- src/core/containers.ml | 4 +-- src/data/CCFQueue.mli | 2 +- src/data/CCHet.mli | 2 +- src/data/CCImmutArray.mli | 2 +- src/data/CCIntMap.mli | 4 +-- src/data/CCRAL.mli | 2 +- src/data/CCTrie.ml | 6 ++--- src/data/CCTrie.mli | 6 ++--- src/data/CCWBTree.mli | 4 +-- src/iter/CCKList.mli | 4 +-- src/iter/CCLazy_list.mli | 2 +- 26 files changed, 120 insertions(+), 67 deletions(-) diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc index ba78c33c..0afdf806 100644 --- a/CHANGELOG.adoc +++ b/CHANGELOG.adoc @@ -1,5 +1,58 @@ = Changelog +== 0.17 + +=== potentially breaking + +- change the semantics of `CCString.find_all` (allow overlaps) + +=== Additions + +- add `CCString.pad` for more webscale +- add `(--^)` to CCRAl, CCFQueue, CCKlist (closes #56); add `CCKList.Infix` +- add monomorphic signatures in `CCInt` and `CCFloat` +- add `CCList.{sorted_insert,is_sorted}` +- add `CCLazy_list` in containers.iter (with a few functions) +- add `CCTrie.longest_prefix` +- provide additional ordering properties in `CCTrie.{above,below}` +- add `CCOpt.if_` +- have + * `CCRandom.split_list` fail on `len=0` + * `CCRandom.sample_without_replacement` fail if `n<=0` +- add `CCOpt.{for_all, exists}` +- add `CCRef.{get_then_incr,incr_then_get}` +- add `Result.{to,of}_err` +- add `CCFormat.within` +- add `map/mapi` to some of the map types. +- add `CCString.{drop,take,chop_prefix,chop_suffix,filter,filter_map}` +- add `CCList.fold_filter_map` +- add `CCIO.File.with_temp` for creating temporary files +- add `{CCArray,CCVector,CCList}.(--^)` for right-open ranges +- add `Containers.{Char,Result}` +- modify `CCPersistentHashtbl.merge` and add `CCMap.merge_safe` +- add `CCHet`, heterogeneous containers (table/map) indexed by keys +- add `CCString.rev` +- add `CCImmutArray` into containers.data +- add `CCList.Assoc.remove` + +=== Fixes, misc + +- Make `CCPersistentHashtbl.S.merge` more general. +- optimize KMP search in `CCString.Find` (hand-specialize code) +- bugfix in `CCFormat.to_file` (fd was closed too early) + +- add a special case for pattern of length 1 in `CCString.find` +- more tests, bugfixes, and benchs for KMP in CCString +- in CCString, use KMP for faster sub-string search; add `find_all{,_l}` + +others: + +- `watch` target should build all +- add version constraint on sequence +- migrate to new qtest +- add an `IO` section to the tutorial +- enable `-j 0` for ocamlbuild + == 0.16 === breaking diff --git a/_oasis b/_oasis index 41eebafd..39957f0a 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.4 Name: containers -Version: 0.16 +Version: 0.17 Homepage: https://github.com/c-cube/ocaml-containers Authors: Simon Cruanes License: BSD-2-clause diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index 71853a1e..29157eb7 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -168,7 +168,7 @@ val (--) : int -> int -> int t val (--^) : int -> int -> int t (** Range array, excluding right bound - @since NEXT_RELEASE *) + @since 0.17 *) val random : 'a random_gen -> 'a t random_gen val random_non_empty : 'a random_gen -> 'a t random_gen diff --git a/src/core/CCFloat.mli b/src/core/CCFloat.mli index f206aec7..5b47483b 100644 --- a/src/core/CCFloat.mli +++ b/src/core/CCFloat.mli @@ -79,25 +79,25 @@ val classify : float -> fpclass (** {2 Infix Operators} - @since NEXT_RELEASE *) + @since 0.17 *) module Infix : sig val (=) : t -> t -> bool - (** @since NEXT_RELEASE *) + (** @since 0.17 *) val (<>) : t -> t -> bool - (** @since NEXT_RELEASE *) + (** @since 0.17 *) val (<) : t -> t -> bool - (** @since NEXT_RELEASE *) + (** @since 0.17 *) val (>) : t -> t -> bool - (** @since NEXT_RELEASE *) + (** @since 0.17 *) val (<=) : t -> t -> bool - (** @since NEXT_RELEASE *) + (** @since 0.17 *) val (>=) : t -> t -> bool - (** @since NEXT_RELEASE *) + (** @since 0.17 *) end include module type of Infix diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 414fe4aa..45d4aafb 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -39,7 +39,7 @@ val seq : ?start:string -> ?stop:string -> ?sep:string -> 'a printer -> 'a seque val opt : 'a printer -> 'a option printer (** In the tuple printers, the [sep] argument is only available - @since NEXT_RELEASE *) + @since 0.17 *) val pair : ?sep:string -> 'a printer -> 'b printer -> ('a * 'b) printer val triple : ?sep:string -> 'a printer -> 'b printer -> 'c printer -> ('a * 'b * 'c) printer @@ -49,7 +49,7 @@ val quad : ?sep:string -> 'a printer -> 'b printer -> val within : string -> string -> 'a printer -> 'a printer (** [within a b p] wraps [p] inside the strings [a] and [b]. Convenient, for instances, for brackets, parenthesis, quotes, etc. - @since NEXT_RELEASE *) + @since 0.17 *) val map : ('a -> 'b) -> 'b printer -> 'a printer diff --git a/src/core/CCIO.mli b/src/core/CCIO.mli index 98134e4d..eee9682d 100644 --- a/src/core/CCIO.mli +++ b/src/core/CCIO.mli @@ -204,5 +204,5 @@ module File : sig After [f] returns, the file is deleted. Best to be used in combination with {!with_out}. See {!Filename.temp_file} - @since NEXT_RELEASE *) + @since 0.17 *) end diff --git a/src/core/CCInt.mli b/src/core/CCInt.mli index d5e68952..adc77339 100644 --- a/src/core/CCInt.mli +++ b/src/core/CCInt.mli @@ -41,32 +41,32 @@ val of_string : string -> t option (** @since 0.13 *) val min : t -> t -> t -(** @since NEXT_RELEASE *) +(** @since 0.17 *) val max : t -> t -> t -(** @since NEXT_RELEASE *) +(** @since 0.17 *) (** {2 Infix Operators} - @since NEXT_RELEASE *) + @since 0.17 *) module Infix : sig val (=) : t -> t -> bool - (** @since NEXT_RELEASE *) + (** @since 0.17 *) val (<>) : t -> t -> bool - (** @since NEXT_RELEASE *) + (** @since 0.17 *) val (<) : t -> t -> bool - (** @since NEXT_RELEASE *) + (** @since 0.17 *) val (>) : t -> t -> bool - (** @since NEXT_RELEASE *) + (** @since 0.17 *) val (<=) : t -> t -> bool - (** @since NEXT_RELEASE *) + (** @since 0.17 *) val (>=) : t -> t -> bool - (** @since NEXT_RELEASE *) + (** @since 0.17 *) end include module type of Infix diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 68d593d0..41f4e5d0 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -56,7 +56,7 @@ val fold_map2 : ('acc -> 'a -> 'b -> 'acc * 'c) -> 'acc -> 'a list -> 'b list -> val fold_filter_map : ('acc -> 'a -> 'acc * 'b option) -> 'acc -> 'a list -> 'acc * 'b list (** [fold_filter_map f acc l] is a [fold_left]-like function, but also generates a list of output in a way similar to {!filter_map} - @since NEXT_RELEASE *) + @since 0.17 *) val fold_flat_map : ('acc -> 'a -> 'acc * 'b list) -> 'acc -> 'a list -> 'acc * 'b list (** [fold_flat_map f acc l] is a [fold_left]-like function, but it also maps the @@ -187,14 +187,14 @@ val sorted_merge_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list val is_sorted : ?cmp:('a -> 'a -> int) -> 'a list -> bool (** [is_sorted l] returns [true] iff [l] is sorted (according to given order) @param cmp the comparison function (default [Pervasives.compare]) - @since NEXT_RELEASE *) + @since 0.17 *) val sorted_insert : ?cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list (** [sorted_insert x l] inserts [x] into [l] such that, if [l] was sorted, then [sorted_insert x l] is sorted too. @param uniq if true and [x] is already in sorted position in [l], then [x] is not duplicated. Default [false] ([x] will be inserted in any case). - @since NEXT_RELEASE *) + @since 0.17 *) (*$Q Q.(pair small_int (list small_int)) (fun (x,l) -> \ @@ -288,7 +288,7 @@ val (--) : int -> int -> int t val (--^) : int -> int -> int t (** Infix alias for [range'] - @since NEXT_RELEASE *) + @since 0.17 *) val replicate : int -> 'a -> 'a t (** Replicate the given element [n] times *) @@ -324,7 +324,7 @@ module Assoc : sig val remove : ?eq:('a->'a->bool) -> ('a,'b) t -> 'a -> ('a,'b) t (** [remove l k] removes the first occurrence of [k] from [l]. - @since NEXT_RELEASE *) + @since 0.17 *) end (** {2 Zipper} *) @@ -511,7 +511,7 @@ module Infix : sig val (--) : int -> int -> int t val (--^) : int -> int -> int t - (** @since NEXT_RELEASE *) + (** @since 0.17 *) end (** {2 IO} *) diff --git a/src/core/CCMap.ml b/src/core/CCMap.ml index d9114c41..6dad0ad1 100644 --- a/src/core/CCMap.ml +++ b/src/core/CCMap.ml @@ -28,7 +28,7 @@ module type S = sig f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) -> 'a t -> 'b t -> 'c t (** [merge_safe ~f a b] merges the maps [a] and [b] together. - @since NEXT_RELEASE *) + @since 0.17 *) val of_seq : (key * 'a) sequence -> 'a t diff --git a/src/core/CCMap.mli b/src/core/CCMap.mli index d97c973b..c1ad52d6 100644 --- a/src/core/CCMap.mli +++ b/src/core/CCMap.mli @@ -31,7 +31,7 @@ module type S = sig f:(key -> [`Left of 'a | `Right of 'b | `Both of 'a * 'b] -> 'c option) -> 'a t -> 'b t -> 'c t (** [merge_safe ~f a b] merges the maps [a] and [b] together. - @since NEXT_RELEASE *) + @since 0.17 *) val of_seq : (key * 'a) sequence -> 'a t diff --git a/src/core/CCOpt.mli b/src/core/CCOpt.mli index ffa7c11a..feca2f3b 100644 --- a/src/core/CCOpt.mli +++ b/src/core/CCOpt.mli @@ -52,13 +52,13 @@ val filter : ('a -> bool) -> 'a t -> 'a t val if_ : ('a -> bool) -> 'a -> 'a option (** [if_ f x] is [Some x] if [f x], [None] otherwise - @since NEXT_RELEASE *) + @since 0.17 *) val exists : ('a -> bool) -> 'a t -> bool -(** @since NEXT_RELEASE *) +(** @since 0.17 *) val for_all : ('a -> bool) -> 'a t -> bool -(** @since NEXT_RELEASE *) +(** @since 0.17 *) val get : 'a -> 'a t -> 'a (** [get default x] unwraps [x], but if [x = None] it returns [default] instead. diff --git a/src/core/CCRef.mli b/src/core/CCRef.mli index 574cc6bf..076ef98b 100644 --- a/src/core/CCRef.mli +++ b/src/core/CCRef.mli @@ -26,11 +26,11 @@ val update : ('a -> 'a) -> 'a t -> unit val incr_then_get : int t -> int (** [incr_then_get r] increments [r] and returns its new value, think [++ r] - @since NEXT_RELEASE *) + @since 0.17 *) val get_then_incr : int t -> int (** [get_then_incr r] increments [r] and returns its old value, think [r++] - @since NEXT_RELEASE *) + @since 0.17 *) val compare : 'a ord -> 'a t ord diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index 7a4a2c28..78f15010 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -184,10 +184,10 @@ val to_seq : ('a, _) t -> 'a sequence type ('a, 'b) error = [`Ok of 'a | `Error of 'b] val of_err : ('a, 'b) error -> ('a, 'b) t -(** @since NEXT_RELEASE *) +(** @since 0.17 *) val to_err : ('a, 'b) t -> ('a, 'b) error -(** @since NEXT_RELEASE *) +(** @since 0.17 *) (** {2 IO} *) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 9cf809ba..a61d52fd 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -65,7 +65,7 @@ val init : int -> (int -> char) -> string val rev : string -> string (** [rev s] returns the reverse of [s] - @since NEXT_RELEASE *) + @since 0.17 *) (*$Q Q.printable_string (fun s -> s = rev (rev s)) @@ -83,7 +83,7 @@ val pad : ?side:[`Left|`Right] -> ?c:char -> int -> string -> string and pads it on the [side] with [c] if it's not the case. @param side determines where padding occurs (default: [`Left]) @param c the char used to pad (default: ' ') - @since NEXT_RELEASE *) + @since 0.17 *) (*$= & ~printer:Q.Print.string " 42" (pad 4 "42") @@ -128,13 +128,13 @@ val find_all : ?start:int -> sub:string -> string -> int gen (** [find_all ~sub s] finds all occurrences of [sub] in [s], even overlapping instances. @param start starting position in [s] - @since NEXT_RELEASE *) + @since 0.17 *) val find_all_l : ?start:int -> sub:string -> string -> int list (** [find_all ~sub s] finds all occurrences of [sub] in [s] and returns them in a list @param start starting position in [s] - @since NEXT_RELEASE *) + @since 0.17 *) (*$= & ~printer:Q.Print.(list int) [1; 6] (find_all_l ~sub:"bc" "abc aabc aab") @@ -222,7 +222,7 @@ val suffix : suf:string -> string -> bool val chop_prefix : pre:string -> string -> string option (** [chop_pref ~pre s] removes [pre] from [s] if [pre] really is a prefix of [s], returns [None] otherwise - @since NEXT_RELEASE *) + @since 0.17 *) (*$= & ~printer:Q.Print.(option string) (Some "cd") (chop_prefix ~pre:"aab" "aabcd") @@ -233,7 +233,7 @@ val chop_prefix : pre:string -> string -> string option val chop_suffix : suf:string -> string -> string option (** [chop_suffix ~suf s] removes [suf] from [s] if [suf] really is a suffix of [s], returns [None] otherwise - @since NEXT_RELEASE *) + @since 0.17 *) (*$= & ~printer:Q.Print.(option string) (Some "ab") (chop_suffix ~suf:"cd" "abcd") @@ -243,15 +243,15 @@ val chop_suffix : suf:string -> string -> string option val take : int -> string -> string (** [take n s] keeps only the [n] first chars of [s] - @since NEXT_RELEASE *) + @since 0.17 *) val drop : int -> string -> string (** [drop n s] removes the [n] first chars of [s] - @since NEXT_RELEASE *) + @since 0.17 *) val take_drop : int -> string -> string * string (** [take_drop n s = take n s, drop n s] - @since NEXT_RELEASE *) + @since 0.17 *) (*$= ("ab", "cd") (take_drop 2 "abcd") @@ -313,7 +313,7 @@ val mapi : (int -> char -> char) -> string -> string @since 0.12 *) val filter_map : (char -> char option) -> string -> string -(** @since NEXT_RELEASE *) +(** @since 0.17 *) (*$= & ~printer:Q.Print.string "bcef" (filter_map \ @@ -321,7 +321,7 @@ val filter_map : (char -> char option) -> string -> string *) val filter : (char -> bool) -> string -> string -(** @since NEXT_RELEASE *) +(** @since 0.17 *) (*$= & ~printer:Q.Print.string "abde" (filter (function 'c' -> false | _ -> true) "abcdec") diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index 10b5c17d..e3a329cd 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -240,7 +240,7 @@ val (--) : int -> int -> (int, 'mut) t val (--^) : int -> int -> (int, 'mut) t (** Range of integers, either ascending or descending, but excluding right., Example: [1 --^ 10] returns the vector [[1;2;3;4;5;6;7;8;9]] - @since NEXT_RELEASE *) + @since 0.17 *) val of_array : 'a array -> ('a, 'mut) t val of_list : 'a list -> ('a, 'mut) t diff --git a/src/core/containers.ml b/src/core/containers.ml index 21b95f65..b8271589 100644 --- a/src/core/containers.ml +++ b/src/core/containers.ml @@ -85,7 +85,7 @@ module Char = struct include Char include (CCChar : module type of CCChar with type t := t) end -(** @since NEXT_RELEASE *) +(** @since 0.17 *) module Result = CCResult -(** @since NEXT_RELEASE *) +(** @since 0.17 *) diff --git a/src/data/CCFQueue.mli b/src/data/CCFQueue.mli index 7f81e42c..fe159c4e 100644 --- a/src/data/CCFQueue.mli +++ b/src/data/CCFQueue.mli @@ -129,7 +129,7 @@ val (--) : int -> int -> int t val (--^) : int -> int -> int t (** [a -- b] is the integer range from [a] to [b], where [b] is excluded. - @since NEXT_RELEASE *) + @since 0.17 *) val print : 'a printer -> 'a t printer (** @since 0.13 *) diff --git a/src/data/CCHet.mli b/src/data/CCHet.mli index 1fd33be9..51ea0fe9 100644 --- a/src/data/CCHet.mli +++ b/src/data/CCHet.mli @@ -6,7 +6,7 @@ This is similar to {!CCMixtbl}, but the injection is directly used as a key. - @since NEXT_RELEASE *) + @since 0.17 *) type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option diff --git a/src/data/CCImmutArray.mli b/src/data/CCImmutArray.mli index 5bb8d910..77e0666d 100644 --- a/src/data/CCImmutArray.mli +++ b/src/data/CCImmutArray.mli @@ -7,7 +7,7 @@ Sadly, it is not possible to make this type covariant without using black magic. - @since NEXT_RELEASE *) + @since 0.17 *) type 'a t (** Array of values of type 'a. The underlying type really is diff --git a/src/data/CCIntMap.mli b/src/data/CCIntMap.mli index b0f7938f..21bb92e3 100644 --- a/src/data/CCIntMap.mli +++ b/src/data/CCIntMap.mli @@ -67,10 +67,10 @@ val iter : (int -> 'a -> unit) -> 'a t -> unit val fold : (int -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t -(** @since NEXT_RELEASE *) +(** @since 0.17 *) val map : ('a -> 'b) -> 'a t -> 'b t -(** @since NEXT_RELEASE *) +(** @since 0.17 *) val choose : 'a t -> (int * 'a) option diff --git a/src/data/CCRAL.mli b/src/data/CCRAL.mli index f716b294..0e76eca3 100644 --- a/src/data/CCRAL.mli +++ b/src/data/CCRAL.mli @@ -178,7 +178,7 @@ module Infix : sig val (--^) : int -> int -> int t (** [a -- b] is the integer range from [a] to [b], where [b] is excluded. - @since NEXT_RELEASE *) + @since 0.17 *) end include module type of Infix diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml index 5aa49a8e..7af7a165 100644 --- a/src/data/CCTrie.ml +++ b/src/data/CCTrie.ml @@ -52,7 +52,7 @@ module type S = sig Example: if [m] has keys "abc0" and "abcd", then [longest_prefix "abc2" m] will return "abc" - @since NEXT_RELEASE *) + @since 0.17 *) val update : key -> ('a option -> 'a option) -> 'a t -> 'a t (** Update the binding for the given key. The function is given @@ -65,11 +65,11 @@ module type S = sig val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t (** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys. - @since NEXT_RELEASE *) + @since 0.17 *) val map : ('a -> 'b) -> 'a t -> 'b t (** Map values, giving only the value. - @since NEXT_RELEASE *) + @since 0.17 *) val iter : (key -> 'a -> unit) -> 'a t -> unit (** Same as {!fold}, but for effectful functions *) diff --git a/src/data/CCTrie.mli b/src/data/CCTrie.mli index 0292b94b..0cb34515 100644 --- a/src/data/CCTrie.mli +++ b/src/data/CCTrie.mli @@ -52,7 +52,7 @@ module type S = sig Example: if [m] has keys "abc0" and "abcd", then [longest_prefix "abc2" m] will return "abc" - @since NEXT_RELEASE *) + @since 0.17 *) val update : key -> ('a option -> 'a option) -> 'a t -> 'a t (** Update the binding for the given key. The function is given @@ -65,11 +65,11 @@ module type S = sig val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t (** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys. - @since NEXT_RELEASE *) + @since 0.17 *) val map : ('a -> 'b) -> 'a t -> 'b t (** Map values, giving only the value. - @since NEXT_RELEASE *) + @since 0.17 *) val iter : (key -> 'a -> unit) -> 'a t -> unit (** Same as {!fold}, but for effectful functions *) diff --git a/src/data/CCWBTree.mli b/src/data/CCWBTree.mli index 8e64e08b..51af2c5c 100644 --- a/src/data/CCWBTree.mli +++ b/src/data/CCWBTree.mli @@ -64,12 +64,12 @@ module type S = sig val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t (** Map values, giving both key and value. Will use {!WORD.of_list} to rebuild keys. - @since NEXT_RELEASE + @since 0.17 *) val map : f:('a -> 'b) -> 'a t -> 'b t (** Map values, giving only the value. - @since NEXT_RELEASE + @since 0.17 *) val iter : f:(key -> 'a -> unit) -> 'a t -> unit diff --git a/src/iter/CCKList.mli b/src/iter/CCKList.mli index ab96ff38..216a1f2e 100644 --- a/src/iter/CCKList.mli +++ b/src/iter/CCKList.mli @@ -135,7 +135,7 @@ val (--) : int -> int -> int t val (--^) : int -> int -> int t (** [a -- b] is the integer range from [a] to [b], where [b] is excluded. - @since NEXT_RELEASE *) + @since 0.17 *) (** {2 Operations on two Collections} *) @@ -212,7 +212,7 @@ val (<.>) : ('a -> 'b) t -> 'a t -> 'b t (** {2 Infix operators} - @since NEXT_RELEASE *) + @since 0.17 *) module Infix : sig val (>>=) : 'a t -> ('a -> 'b t) -> 'b t diff --git a/src/iter/CCLazy_list.mli b/src/iter/CCLazy_list.mli index 42f1b19b..6a51cd3b 100644 --- a/src/iter/CCLazy_list.mli +++ b/src/iter/CCLazy_list.mli @@ -3,7 +3,7 @@ (** {1 Lazy List} - @since NEXT_RELEASE *) + @since 0.17 *) type +'a t = 'a node lazy_t and +'a node =