From 0ff7bef8adc1a9c9098f5108ec915dd6254219aa Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 23 Sep 2015 18:20:12 +0200 Subject: [PATCH 01/75] fix doc --- Makefile | 2 +- doc/intro.txt | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index 28add908..25526672 100644 --- a/Makefile +++ b/Makefile @@ -53,7 +53,7 @@ examples: all ocamlbuild $(OPTIONS) -package unix -I . $(EXAMPLES) push_doc: doc - scp -r containers.docdir/* cedeela.fr:~/simon/root/software/containers/ + rsync -tavu containers.docdir/* cedeela.fr:~/simon/root/software/containers/ DONTTEST=myocamlbuild.ml setup.ml $(wildcard src/**/*.cppo.*) QTESTABLE=$(filter-out $(DONTTEST), \ diff --git a/doc/intro.txt b/doc/intro.txt index 05b4cd88..75275dbd 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -2,7 +2,7 @@ {2 Change Log} -See {{: https://github.com/c-cube/ocaml-containers/blob/master/CHANGELOG.md } this file} +See {{: https://github.com/c-cube/ocaml-containers/blob/master/CHANGELOG.adoc } this file} {2 License} From f4ea5617e9f62b61626fd6544f6f44d54c758550 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 23 Sep 2015 18:22:55 +0200 Subject: [PATCH 02/75] doc again --- doc/intro.txt | 27 +++------------------------ 1 file changed, 3 insertions(+), 24 deletions(-) diff --git a/doc/intro.txt b/doc/intro.txt index 75275dbd..3b13b399 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -128,33 +128,11 @@ requires {{:https://github.com/c-cube/sequence} Sequence}. {4 Misc} -This list is not necessarily up-to-date. - -{!modules: -AbsSet -Automaton -Bij -CSM -Hashset -LazyGraph -PHashtbl -PrintBox -RAL -RoseTree -SmallSet -UnionFind -Univ -} +Moved to its own repository. {4 Lwt} -Utils for Lwt (including experimental stuff) - -{!modules: -Lwt_actor -Lwt_klist -Lwt_pipe -} +Moved to its own repository {4 Others} @@ -162,6 +140,7 @@ Lwt_pipe CCFuture CCLock CCSemaphore +CCThread } From 1a9db7503ab49d4079db301635f50fadc918f36b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 23 Sep 2015 18:25:43 +0200 Subject: [PATCH 03/75] doc for threads --- _oasis | 2 +- src/threads/CCFuture.mli | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/_oasis b/_oasis index 6b6ec618..dcde30ca 100644 --- a/_oasis +++ b/_oasis @@ -142,7 +142,7 @@ Document containers "-docflags '-colorize-code -short-functors -charset utf-8'" XOCamlbuildLibraries: containers, containers.iter, containers.data, - containers.string, containers.bigarray, + containers.string, containers.bigarray, containers.thread, containers.advanced, containers.io, containers.unix, containers.sexp Executable run_benchs diff --git a/src/threads/CCFuture.mli b/src/threads/CCFuture.mli index ff4691a5..c42a5785 100644 --- a/src/threads/CCFuture.mli +++ b/src/threads/CCFuture.mli @@ -55,7 +55,7 @@ val make2 : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c t val get : 'a t -> 'a (** Blocking get: wait for the future to be evaluated, and get the value, or the exception that failed the future is returned. - @raise e if the exception failed with e *) + raise e if the future failed with e *) val state : 'a t -> 'a state (** State of the future *) From 9c61cfe53a1b6942403f563ebe2ffaec145faa0b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 23 Sep 2015 23:14:29 +0200 Subject: [PATCH 04/75] update bench --- benchs/run_benchs.ml | 1 + src/threads/CCThread.ml | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index 23fa0be3..10402385 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -935,6 +935,7 @@ module Thread = struct [100; 1_000] ) [ 2, 3, 3 ; 5, 3, 3 + ; 1, 5, 5 ; 2, 10, 10 ; 5, 10, 10 ; 20, 10, 10 diff --git a/src/threads/CCThread.ml b/src/threads/CCThread.ml index a482b030..3e1b68ed 100644 --- a/src/threads/CCThread.ml +++ b/src/threads/CCThread.ml @@ -53,7 +53,7 @@ module Barrier = struct with_lock_ b (fun () -> while not b.activated do - Condition.wait b.cond b.lock + Condition.wait b.cond b.lock done ) From 87e2ab90e1d2aaa0f71b60f5f274f6c27021f9b2 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 27 Sep 2015 10:34:38 +0200 Subject: [PATCH 05/75] add `CCString.replace` and tests --- src/core/CCString.cppo.ml | 33 +++++++++++++++++++++++++++++++++ src/core/CCString.mli | 18 ++++++++++++++++++ 2 files changed, 51 insertions(+) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 7fd6e70e..4a176eb9 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -116,6 +116,39 @@ let rfind ~sub s = with Exit -> !i +(* replace substring [s.[pos]....s.[pos+len-1]] by [by] in [s] *) +let replace_at_ ~pos ~len ~by s = + let b = Buffer.create (length s + length by - len) in + Buffer.add_substring b s 0 pos; + Buffer.add_string b by; + Buffer.add_substring b s (pos+len) (String.length s - pos - len); + Buffer.contents b + +let replace ?(which=`All) ~sub ~by s = match which with + | `Left -> + let i = find ~sub s 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 -> + 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 + if i>=0 then ( + (* between last and cur occurrences *) + Buffer.add_substring b s !start (i- !start); + Buffer.add_string b by; + start := i + String.length sub + ) else ( + (* add remainder *) + Buffer.add_substring b s !start (String.length s - !start); + start := String.length s (* stop *) + ) + done; + Buffer.contents b + module Split = struct type split_state = | SplitStop diff --git a/src/core/CCString.mli b/src/core/CCString.mli index e6b86ff1..4e00f8a0 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -129,6 +129,24 @@ val rfind : sub:string -> string -> int rfind ~sub:"bc" "abcdbcd" = 4 *) +val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string -> string +(** [replace ~sub ~by s] replaces some occurrences of [sub] by [by] in [s] + @param which decides whether the occurrences to replace are: + {ul + {il [`Left] first occurrence from the left (beginning)} + {il [`Right] first occurrence from the right (end)} + {il [`All] all occurrences (default)} + } + @since NEXT_RELEASE *) + +(*$= & ~printer:CCFun.id + (replace ~which:`All ~sub:"a" ~by:"b" "abcdabcd") "bbcdbbcd" + (replace ~which:`Left ~sub:"a" ~by:"b" "abcdabcd") "bbcdabcd" + (replace ~which:`Right ~sub:"a" ~by:"b" "abcdabcd") "abcdbbcd" + (replace ~which:`All ~sub:"ab" ~by:"hello" " abab cdabb a") \ + " hellohello cdhellob a" +*) + val is_sub : sub:string -> int -> string -> int -> len:int -> bool (** [is_sub ~sub i s j ~len] returns [true] iff the substring of [sub] starting at position [i] and of length [len] *) From 610e0ed53a22afca7accd654fe5bfd7124661ff4 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 27 Sep 2015 10:48:10 +0200 Subject: [PATCH 06/75] doc --- src/core/CCString.mli | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 4e00f8a0..f9bf8930 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -145,11 +145,13 @@ val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string -> (replace ~which:`Right ~sub:"a" ~by:"b" "abcdabcd") "abcdbbcd" (replace ~which:`All ~sub:"ab" ~by:"hello" " abab cdabb a") \ " hellohello cdhellob a" + (replace ~which:`Left ~sub:"ab" ~by:"nope" " a b c d ") " a b c d " *) val is_sub : sub:string -> int -> string -> int -> len:int -> bool (** [is_sub ~sub i s j ~len] returns [true] iff the substring of - [sub] starting at position [i] and of length [len] *) + [sub] starting at position [i] and of length [len] is a substring + of [s] starting at position [j] *) val repeat : string -> int -> string (** The same string, repeated n times *) From df39602b9e25db5ff19608e97fea6c7010e2ffc1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 27 Sep 2015 10:54:04 +0200 Subject: [PATCH 07/75] doc --- src/core/CCString.mli | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index f9bf8930..4fbbe207 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -133,9 +133,9 @@ val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string -> (** [replace ~sub ~by s] replaces some occurrences of [sub] by [by] in [s] @param which decides whether the occurrences to replace are: {ul - {il [`Left] first occurrence from the left (beginning)} - {il [`Right] first occurrence from the right (end)} - {il [`All] all occurrences (default)} + {- [`Left] first occurrence from the left (beginning)} + {- [`Right] first occurrence from the right (end)} + {- [`All] all occurrences (default)} } @since NEXT_RELEASE *) From a3bc61ef94e7648709344032111a58cf858208f7 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 27 Sep 2015 17:58:59 +0200 Subject: [PATCH 08/75] bugfix in `CCString.find` --- src/core/CCString.cppo.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index 4a176eb9..eb6c33db 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -94,7 +94,7 @@ 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 + while !i + n <= String.length s do if _is_sub ~sub 0 s !i ~len:n then raise Exit; incr i done; From 8a3b53f3200a8f84633a9849d8a6290f6b078f97 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 27 Sep 2015 17:58:05 +0200 Subject: [PATCH 09/75] update ocamlinit --- .ocamlinit | 2 -- 1 file changed, 2 deletions(-) diff --git a/.ocamlinit b/.ocamlinit index 3a2564f1..e97f1fcf 100644 --- a/.ocamlinit +++ b/.ocamlinit @@ -27,11 +27,9 @@ #load "containers_string.cma";; #load "containers_pervasives.cma";; #load "containers_bigarray.cma";; -#load "containers_misc.cma";; #load "containers_top.cma";; #thread;; #load "containers_thread.cma";; -open Containers_misc;; #install_printer CCSexp.print;; (* vim:syntax=ocaml: *) From 32fb4cf0442c79556538b487a8d5f672e6b92520 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 27 Sep 2015 17:58:44 +0200 Subject: [PATCH 10/75] raise exception in `CCString.replace` if `sub=""` --- src/core/CCString.cppo.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/core/CCString.cppo.ml b/src/core/CCString.cppo.ml index eb6c33db..bf48b58a 100644 --- a/src/core/CCString.cppo.ml +++ b/src/core/CCString.cppo.ml @@ -81,7 +81,7 @@ let _is_sub ~sub i s j ~len = let rec check k = if k = len then true - else sub.[i + k] = s.[j+k] && check (k+1) + else sub.[i+k] = s.[j+k] && check (k+1) in j+len <= String.length s && check 0 @@ -124,7 +124,9 @@ let replace_at_ ~pos ~len ~by s = Buffer.add_substring b s (pos+len) (String.length s - pos - len); Buffer.contents b -let replace ?(which=`All) ~sub ~by s = match which with +let replace ?(which=`All) ~sub ~by s = + if sub="" then invalid_arg "CCstring.replace"; + match which with | `Left -> let i = find ~sub s in if i>=0 then replace_at_ ~pos:i ~len:(String.length sub) ~by s else s From fca7125c90d8db6b9eb2296f185716ece239a7a2 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 27 Sep 2015 17:58:09 +0200 Subject: [PATCH 11/75] more tests for `CCString` --- src/core/CCString.mli | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 4fbbe207..a9c4f65c 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -102,10 +102,11 @@ val find : ?start:int -> sub:string -> string -> int (** Find [sub] in string, returns its first index or [-1]. Should only be used with very small [sub] *) -(*$T - find ~sub:"bc" "abcd" = 1 - find ~sub:"bc" "abd" = ~-1 - find ~sub:"a" "_a_a_a_" = 1 +(*$= & ~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 *) val mem : ?start:int -> sub:string -> string -> bool @@ -122,11 +123,12 @@ val rfind : sub:string -> string -> int Should only be used with very small [sub] @since 0.12 *) -(*$T - rfind ~sub:"bc" "abcd" = 1 - rfind ~sub:"bc" "abd" = ~-1 - rfind ~sub:"a" "_a_a_a_" = 5 - rfind ~sub:"bc" "abcdbcd" = 4 +(*$= & ~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 *) val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string -> string @@ -137,6 +139,7 @@ val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string -> {- [`Right] first occurrence from the right (end)} {- [`All] all occurrences (default)} } + @raise Invalid_argument if [sub = ""] @since NEXT_RELEASE *) (*$= & ~printer:CCFun.id @@ -146,6 +149,7 @@ val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string -> (replace ~which:`All ~sub:"ab" ~by:"hello" " abab cdabb a") \ " hellohello cdhellob a" (replace ~which:`Left ~sub:"ab" ~by:"nope" " a b c d ") " a b c d " + (replace ~sub:"a" ~by:"b" "1aa234a") "1bb234b" *) val is_sub : sub:string -> int -> string -> int -> len:int -> bool From fe0169f0b65c4422d449959ab07417e4ea51ae76 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 27 Sep 2015 18:20:46 +0200 Subject: [PATCH 12/75] doc --- src/core/CCIO.mli | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/CCIO.mli b/src/core/CCIO.mli index e1c0d6e8..44e8e257 100644 --- a/src/core/CCIO.mli +++ b/src/core/CCIO.mli @@ -152,7 +152,8 @@ See {!File.walk} if you also need to list directories: module File : sig type 'a or_error = [`Ok of 'a | `Error of string] type t = string - (** A file is always represented by its absolute path *) + (** A file should be represented by its absolute path, but currently + this is not enforced. *) val to_string : t -> string From 6723c8283c490126464b2c11c833c2a07ddc8880 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 27 Sep 2015 19:20:01 +0200 Subject: [PATCH 13/75] more tests --- src/core/CCString.mli | 1 + 1 file changed, 1 insertion(+) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index a9c4f65c..a05cf845 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -201,6 +201,7 @@ val unlines_gen : string gen -> string (*$Q Q.printable_string (fun s -> unlines (lines s) = s) + Q.printable_string (fun s -> unlines_gen (lines_gen s) = s) *) val set : string -> int -> char -> string From 219e06c1fe24ea983ac2aa41290189bb64ee4f82 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 27 Sep 2015 19:27:44 +0200 Subject: [PATCH 14/75] update tests so they run faster --- src/core/CCHeap.ml | 4 ++-- src/data/CCHashconsedSet.ml | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/CCHeap.ml b/src/core/CCHeap.ml index 8aaf953b..97bccb00 100644 --- a/src/core/CCHeap.ml +++ b/src/core/CCHeap.ml @@ -76,10 +76,10 @@ end *) (*$QR & ~count:30 - Q.(list_of_size Gen.(return 10_000) int) (fun l -> + Q.(list_of_size Gen.(return 1_000) int) (fun l -> (* put elements into a heap *) let h = H.of_seq H.empty (Sequence.of_list l) in - OUnit.assert_equal 10_000 (H.size h); + OUnit.assert_equal 1_000 (H.size h); let l' = extract_list h in is_sorted l' ) diff --git a/src/data/CCHashconsedSet.ml b/src/data/CCHashconsedSet.ml index a6533adc..5775316e 100644 --- a/src/data/CCHashconsedSet.ml +++ b/src/data/CCHashconsedSet.ml @@ -263,7 +263,7 @@ module Make(E : ELT) : S with type elt = E.t = struct let add x t = add_rec_ (E.hash x) x t (*$Q & ~count:20 - Q.(list int) (fun l -> \ + Q.(list_of_size Gen.(0 -- 300) int) (fun l -> \ let module S = Make(CCInt) in \ let m = S.of_list l in \ List.for_all (fun x -> S.mem x m) l) @@ -396,7 +396,7 @@ module Make(E : ELT) : S with type elt = E.t = struct else empty (*$Q - Q.(list int) (fun l -> \ + Q.(list_of_size Gen.(0 -- 300) int) (fun l -> \ let module S = Make(CCInt) in \ let s = S.of_list l in S.equal s (S.inter s s)) *) From 179cafde9eaed0ff7a62a147855afe6a4311b06e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 27 Sep 2015 21:42:58 +0200 Subject: [PATCH 15/75] doc and tests for `CCLevenshtein` --- src/string/CCLevenshtein.ml | 15 +++++++++++++-- src/string/CCLevenshtein.mli | 9 ++++----- 2 files changed, 17 insertions(+), 7 deletions(-) diff --git a/src/string/CCLevenshtein.ml b/src/string/CCLevenshtein.ml index 7ccbb495..d7347f88 100644 --- a/src/string/CCLevenshtein.ml +++ b/src/string/CCLevenshtein.ml @@ -93,7 +93,7 @@ let rec klist_to_list l = match l () with l, Index.of_list l' in let gen = Q.Gen.( - list_size (3 -- 15) (string_size (0 -- 10)) >|= mklist + list_size (3 -- 15) (string_size (1 -- 10)) >|= mklist ) in let small (l,_) = List.length l in let print (l,_) = Q.Print.(list string) l in @@ -106,12 +106,23 @@ let rec klist_to_list l = match l () with let retrieved = Index.retrieve ~limit:2 idx s |> klist_to_list in List.for_all - (fun s' -> edit_distance s s' <= 2) retrieved + (fun s' -> edit_distance s s' <= 2) retrieved && + List.for_all + (fun s' -> not (edit_distance s s' <= 2) || List.mem s' retrieved) + l ) l ) *) +(*$R +let idx = Index.of_list ["aa", "aa"; "ab", "ab"; "cd", "cd"; "a'c", "a'c"] in + assert_equal ~printer:Q.Print.(list string) + ["a'c"; "aa"; "ab"] + (Index.retrieve ~limit:1 idx "ac" |> CCKList.to_list + |> List.sort Pervasives.compare) +*) + module type S = sig type char_ type string_ diff --git a/src/string/CCLevenshtein.mli b/src/string/CCLevenshtein.mli index a22bbdeb..ad92c6b4 100644 --- a/src/string/CCLevenshtein.mli +++ b/src/string/CCLevenshtein.mli @@ -79,15 +79,14 @@ The signature for a given string representation provides 3 main things: A possible use of the index could be: {[ -open Batteries;; -let words = File.with_file_in "/usr/share/dict/english" - (fun i -> IO.read_all i |> String.nsplit ~by:"\\n");; +let words = CCIO.with_in "/usr/share/dict/words" + (fun i -> CCIO.read_all i |> CCString.Split.list_cpy ~by:"\n");; let words = List.map (fun s->s,s) words;; -let idx = Levenshtein.Index.of_list words;; +let idx = CCLevenshtein.Index.of_list words;; -Levenshtein.Index.retrieve ~limit:1 idx "hell" |> Levenshtein.klist_to_list;; +CCLevenshtein.Index.retrieve ~limit:1 idx "hell" |> CCLevenshtein.klist_to_list;; ]} *) From a015b61208dda269df1274d28e8a5e3f6854acbc Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 27 Sep 2015 22:26:21 +0200 Subject: [PATCH 16/75] style --- src/string/CCLevenshtein.ml | 48 ++++++++++++++++++------------------ src/string/CCLevenshtein.mli | 48 ++++++++++++++++++------------------ 2 files changed, 48 insertions(+), 48 deletions(-) diff --git a/src/string/CCLevenshtein.ml b/src/string/CCLevenshtein.ml index d7347f88..72af7e77 100644 --- a/src/string/CCLevenshtein.ml +++ b/src/string/CCLevenshtein.ml @@ -130,70 +130,70 @@ module type S = sig (** {6 Edit Distance} *) val edit_distance : string_ -> string_ -> int - (** Edition distance between two strings. This satisfies the classical - distance axioms: it is always positive, symmetric, and satisfies - the formula [distance a b + distance b c >= distance a c] *) + (** Edition distance between two strings. This satisfies the classical + distance axioms: it is always positive, symmetric, and satisfies + the formula [distance a b + distance b c >= distance a c] *) (** {6 Automaton} An automaton, built from a string [s] and a limit [n], that accepts every string that is at distance at most [n] from [s]. *) type automaton - (** Levenshtein automaton *) + (** Levenshtein automaton *) val of_string : limit:int -> string_ -> automaton - (** Build an automaton from a string, with a maximal distance [limit]. - The automaton will accept strings whose {!edit_distance} to the - parameter is at most [limit]. *) + (** Build an automaton from a string, with a maximal distance [limit]. + The automaton will accept strings whose {!edit_distance} to the + parameter is at most [limit]. *) val of_list : limit:int -> char_ list -> automaton - (** Build an automaton from a list, with a maximal distance [limit] *) + (** Build an automaton from a list, with a maximal distance [limit] *) val debug_print : (out_channel -> char_ -> unit) -> out_channel -> automaton -> unit - (** Output the automaton's structure on the given channel. *) + (** Output the automaton's structure on the given channel. *) val match_with : automaton -> string_ -> bool - (** [match_with a s] matches the string [s] against [a], and returns - [true] if the distance from [s] to the word represented by [a] is smaller - than the limit used to build [a] *) + (** [match_with a s] matches the string [s] against [a], and returns + [true] if the distance from [s] to the word represented by [a] is smaller + than the limit used to build [a] *) (** {6 Index for one-to-many matching} *) module Index : sig type 'b t - (** Index that maps strings to values of type 'b. Internally it is - based on a trie. A string can only map to one value. *) + (** Index that maps strings to values of type 'b. Internally it is + based on a trie. A string can only map to one value. *) val empty : 'b t - (** Empty index *) + (** Empty index *) val is_empty : _ t -> bool val add : 'b t -> string_ -> 'b -> 'b t - (** Add a pair string/value to the index. If a value was already present - for this string it is replaced. *) + (** Add a pair string/value to the index. If a value was already present + for this string it is replaced. *) val remove : 'b t -> string_ -> 'b t - (** Remove a string (and its associated value, if any) from the index. *) + (** Remove a string (and its associated value, if any) from the index. *) val retrieve : limit:int -> 'b t -> string_ -> 'b klist - (** Lazy list of objects associated to strings close to the query string *) + (** Lazy list of objects associated to strings close to the query string *) val of_list : (string_ * 'b) list -> 'b t - (** Build an index from a list of pairs of strings and values *) + (** Build an index from a list of pairs of strings and values *) val to_list : 'b t -> (string_ * 'b) list - (** Extract a list of pairs from an index *) + (** Extract a list of pairs from an index *) val fold : ('a -> string_ -> 'b -> 'a) -> 'a -> 'b t -> 'a - (** Fold over the stored pairs string/value *) + (** Fold over the stored pairs string/value *) val iter : (string_ -> 'b -> unit) -> 'b t -> unit - (** Iterate on the pairs *) + (** Iterate on the pairs *) val to_klist : 'b t -> (string_ * 'b) klist - (** Conversion to an iterator *) + (** Conversion to an iterator *) end end diff --git a/src/string/CCLevenshtein.mli b/src/string/CCLevenshtein.mli index ad92c6b4..93c28d84 100644 --- a/src/string/CCLevenshtein.mli +++ b/src/string/CCLevenshtein.mli @@ -97,70 +97,70 @@ module type S = sig (** {6 Edit Distance} *) val edit_distance : string_ -> string_ -> int - (** Edition distance between two strings. This satisfies the classical - distance axioms: it is always positive, symmetric, and satisfies - the formula [distance a b + distance b c >= distance a c] *) + (** Edition distance between two strings. This satisfies the classical + distance axioms: it is always positive, symmetric, and satisfies + the formula [distance a b + distance b c >= distance a c] *) (** {6 Automaton} An automaton, built from a string [s] and a limit [n], that accepts every string that is at distance at most [n] from [s]. *) type automaton - (** Levenshtein automaton *) + (** Levenshtein automaton *) val of_string : limit:int -> string_ -> automaton - (** Build an automaton from a string, with a maximal distance [limit]. - The automaton will accept strings whose {!edit_distance} to the - parameter is at most [limit]. *) + (** Build an automaton from a string, with a maximal distance [limit]. + The automaton will accept strings whose {!edit_distance} to the + parameter is at most [limit]. *) val of_list : limit:int -> char_ list -> automaton - (** Build an automaton from a list, with a maximal distance [limit] *) + (** Build an automaton from a list, with a maximal distance [limit] *) val debug_print : (out_channel -> char_ -> unit) -> out_channel -> automaton -> unit - (** Output the automaton's structure on the given channel. *) + (** Output the automaton's structure on the given channel. *) val match_with : automaton -> string_ -> bool - (** [match_with a s] matches the string [s] against [a], and returns - [true] if the distance from [s] to the word represented by [a] is smaller - than the limit used to build [a] *) + (** [match_with a s] matches the string [s] against [a], and returns + [true] if the distance from [s] to the word represented by [a] is smaller + than the limit used to build [a] *) (** {6 Index for one-to-many matching} *) module Index : sig type 'b t - (** Index that maps strings to values of type 'b. Internally it is - based on a trie. A string can only map to one value. *) + (** Index that maps strings to values of type 'b. Internally it is + based on a trie. A string can only map to one value. *) val empty : 'b t - (** Empty index *) + (** Empty index *) val is_empty : _ t -> bool val add : 'b t -> string_ -> 'b -> 'b t - (** Add a pair string/value to the index. If a value was already present - for this string it is replaced. *) + (** Add a pair string/value to the index. If a value was already present + for this string it is replaced. *) val remove : 'b t -> string_ -> 'b t - (** Remove a string (and its associated value, if any) from the index. *) + (** Remove a string (and its associated value, if any) from the index. *) val retrieve : limit:int -> 'b t -> string_ -> 'b klist - (** Lazy list of objects associated to strings close to the query string *) + (** Lazy list of objects associated to strings close to the query string *) val of_list : (string_ * 'b) list -> 'b t - (** Build an index from a list of pairs of strings and values *) + (** Build an index from a list of pairs of strings and values *) val to_list : 'b t -> (string_ * 'b) list - (** Extract a list of pairs from an index *) + (** Extract a list of pairs from an index *) val fold : ('a -> string_ -> 'b -> 'a) -> 'a -> 'b t -> 'a - (** Fold over the stored pairs string/value *) + (** Fold over the stored pairs string/value *) val iter : (string_ -> 'b -> unit) -> 'b t -> unit - (** Iterate on the pairs *) + (** Iterate on the pairs *) val to_klist : 'b t -> (string_ * 'b) klist - (** Conversion to an iterator *) + (** Conversion to an iterator *) end end From 80b0f9b8200c125a533bd3fd710b8e418d1a5d2a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 27 Sep 2015 22:57:36 +0200 Subject: [PATCH 17/75] add `CCLevenshtein.Index.{of,to}_{gen,seq}` and `cardinal` --- src/string/CCLevenshtein.ml | 111 ++++++++++++++++++++++++++++++----- src/string/CCLevenshtein.mli | 24 ++++++++ 2 files changed, 121 insertions(+), 14 deletions(-) diff --git a/src/string/CCLevenshtein.ml b/src/string/CCLevenshtein.ml index 72af7e77..6f3d38ea 100644 --- a/src/string/CCLevenshtein.ml +++ b/src/string/CCLevenshtein.ml @@ -26,6 +26,9 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (** {1 Levenshtein distance} *) +type 'a sequence = ('a -> unit) -> unit +type 'a gen = unit -> 'a option + module type STRING = sig type char_ type t @@ -50,6 +53,15 @@ let rec klist_to_list l = match l () with (*$inject open CCFun + let list_uniq_ = Q.( + let gen = Gen.(list_size (0 -- 100) (string_size ~gen:printable (1 -- 10)) + >|= CCList.sort_uniq ~cmp:String.compare + >|= List.map (fun s->s,s) + ) in + let print = Print.(list (pair string string)) in + let shrink = Shrink.(list ~shrink:(pair string string)) in + make ~small:List.length ~print ~shrink gen + ) *) (*$Q @@ -174,6 +186,9 @@ module type S = sig (** Add a pair string/value to the index. If a value was already present for this string it is replaced. *) + val cardinal : _ t -> int + (** Number of bindings *) + val remove : 'b t -> string_ -> 'b t (** Remove a string (and its associated value, if any) from the index. *) @@ -186,6 +201,24 @@ module type S = sig val to_list : 'b t -> (string_ * 'b) list (** Extract a list of pairs from an index *) + val add_seq : 'a t -> (string_ * 'a) sequence -> 'a t + (** @since NEXT_RELEASE *) + + val of_seq : (string_ * 'a) sequence -> 'a t + (** @since NEXT_RELEASE *) + + val to_seq : 'a t -> (string_ * 'a) sequence + (** @since NEXT_RELEASE *) + + val add_gen : 'a t -> (string_ * 'a) gen -> 'a t + (** @since NEXT_RELEASE *) + + val of_gen : (string_ * 'a) gen -> 'a t + (** @since NEXT_RELEASE *) + + val to_gen : 'a t -> (string_ * 'a) gen + (** @since NEXT_RELEASE *) + val fold : ('a -> string_ -> 'b -> 'a) -> 'a -> 'b t -> 'a (** Fold over the stored pairs string/value *) @@ -197,7 +230,8 @@ module type S = sig end end -module Make(Str : STRING) = struct +module Make(Str : STRING) +: S with type char_ = Str.char_ and type string_ = Str.t = struct type string_ = Str.t type char_ = Str.char_ @@ -689,24 +723,73 @@ module Make(Str : STRING) = struct let iter f idx = fold (fun () str v -> f str v) () idx + let cardinal idx = fold (fun n _ _ -> n+1) 0 idx + let to_list idx = fold (fun acc str v -> (str,v) :: acc) [] idx + let add_seq i s = + let i = ref i in + s (fun (arr,v) -> i := add !i arr v); + !i + + let of_seq s = add_seq empty s + + let to_seq i yield = iter (fun x y -> yield (x,y)) i + + (*$Q + list_uniq_ (fun l -> \ + Sequence.of_list l |> Index.of_seq |> Index.to_seq \ + |> Sequence.to_list |> List.sort Pervasives.compare \ + = List.sort Pervasives.compare l) + *) + + let rec add_gen i g = match g() with + | None -> i + | Some (arr,v) -> add_gen (add i arr v) g + + let of_gen g = add_gen empty g + + let to_gen s = + let st = Stack.create () in + Stack.push ([],s) st; + let rec next () = + if Stack.is_empty st then None + else + let trail, Node (opt, m) = Stack.pop st in + (* explore children *) + M.iter + (fun c node' -> Stack.push (c::trail, node') st) + m; + match opt with + | None -> next() + | Some v -> + let str = Str.of_list (List.rev trail) in + Some (str,v) + in + next + + (*$Q + list_uniq_ (fun l -> \ + Gen.of_list l |> Index.of_gen |> Index.to_gen \ + |> Gen.to_list |> List.sort Pervasives.compare \ + = List.sort Pervasives.compare l) + *) + let to_klist idx = let rec traverse node trail ~(fk:(string_*'a) klist) () = - match node with - | Node (opt, m) -> - (* all alternatives: continue exploring [m], or call [fk] *) - let fk = - M.fold - (fun c node' fk -> traverse node' (c::trail) ~fk) - m fk - in - match opt with - | Some v -> - let str = Str.of_list (List.rev trail) in - `Cons ((str,v), fk) - | _ -> fk () (* fail... or explore subtrees *) + let Node (opt, m) = node in + (* all alternatives: continue exploring [m], or call [fk] *) + let fk = + M.fold + (fun c node' fk -> traverse node' (c::trail) ~fk) + m fk + in + match opt with + | Some v -> + let str = Str.of_list (List.rev trail) in + `Cons ((str,v), fk) + | _ -> fk () (* fail... or explore subtrees *) in traverse idx [] ~fk:(fun () -> `Nil) end diff --git a/src/string/CCLevenshtein.mli b/src/string/CCLevenshtein.mli index 93c28d84..96cb3730 100644 --- a/src/string/CCLevenshtein.mli +++ b/src/string/CCLevenshtein.mli @@ -31,6 +31,9 @@ We take inspiration from http://blog.notdot.net/2010/07/Damn-Cool-Algorithms-Levenshtein-Automata for the main algorithm and ideas. However some parts are adapted *) +type 'a sequence = ('a -> unit) -> unit +type 'a gen = unit -> 'a option + (** {2 Abstraction over Strings} Due to the existence of several encodings and string representations we abstract over the type of strings. A string is a finite array of characters @@ -141,6 +144,9 @@ module type S = sig (** Add a pair string/value to the index. If a value was already present for this string it is replaced. *) + val cardinal : _ t -> int + (** Number of bindings *) + val remove : 'b t -> string_ -> 'b t (** Remove a string (and its associated value, if any) from the index. *) @@ -153,6 +159,24 @@ module type S = sig val to_list : 'b t -> (string_ * 'b) list (** Extract a list of pairs from an index *) + val add_seq : 'a t -> (string_ * 'a) sequence -> 'a t + (** @since NEXT_RELEASE *) + + val of_seq : (string_ * 'a) sequence -> 'a t + (** @since NEXT_RELEASE *) + + val to_seq : 'a t -> (string_ * 'a) sequence + (** @since NEXT_RELEASE *) + + val add_gen : 'a t -> (string_ * 'a) gen -> 'a t + (** @since NEXT_RELEASE *) + + val of_gen : (string_ * 'a) gen -> 'a t + (** @since NEXT_RELEASE *) + + val to_gen : 'a t -> (string_ * 'a) gen + (** @since NEXT_RELEASE *) + val fold : ('a -> string_ -> 'b -> 'a) -> 'a -> 'b t -> 'a (** Fold over the stored pairs string/value *) From ec0e92da35aeb36f50eaf9d35f8e4a47e0ae48cb Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 1 Oct 2015 18:53:39 +0200 Subject: [PATCH 18/75] bugfix in `CCKList.take`, it was slightly too eager --- src/iter/CCKList.ml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/iter/CCKList.ml b/src/iter/CCKList.ml index 6adf9d1d..4a55e967 100644 --- a/src/iter/CCKList.ml +++ b/src/iter/CCKList.ml @@ -101,10 +101,11 @@ let iteri f l = let length l = fold (fun acc _ -> acc+1) 0 l -let rec take n (l:'a t) () = match l () with - | _ when n=0 -> `Nil - | `Nil -> `Nil - | `Cons (x,l') -> `Cons (x, take (n-1) l') +let rec take n (l:'a t) () = + if n=0 then `Nil + else match l () with + | `Nil -> `Nil + | `Cons (x,l') -> `Cons (x, take (n-1) l') let rec take_while p l () = match l () with | `Nil -> `Nil From fdcba1122d443860b8f7fa4496b04f40e2d822e8 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 1 Oct 2015 18:54:17 +0200 Subject: [PATCH 19/75] add `CCKlist.memoize` for costly computations --- doc/intro.txt | 1 + src/core/CCFormat.mli | 4 ++-- src/iter/CCKList.ml | 30 ++++++++++++++++++++++++++++++ src/iter/CCKList.mli | 4 ++++ 4 files changed, 37 insertions(+), 2 deletions(-) diff --git a/doc/intro.txt b/doc/intro.txt index 3b13b399..36fb49ce 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -72,6 +72,7 @@ CCFQueue CCFlatHashtbl CCHashSet CCHashTrie +CCImmutArray CCIntMap CCMixmap CCMixset diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 6a4c46f6..818ed3c2 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -67,7 +67,7 @@ val stdout : t val stderr : t val sprintf : ('a, t, unit, string) format4 -> 'a - (** print into a string *) +(** print into a string *) val to_file : string -> ('a, t, unit, unit) format4 -> 'a - (** Print to the given file *) +(** Print to the given file *) diff --git a/src/iter/CCKList.ml b/src/iter/CCKList.ml index 4a55e967..b09d4dde 100644 --- a/src/iter/CCKList.ml +++ b/src/iter/CCKList.ml @@ -441,6 +441,36 @@ let sort_uniq ?(cmp=Pervasives.compare) l = let l = to_list l in uniq (fun x y -> cmp x y = 0) (of_list (List.sort cmp l)) +type 'a memoize = + | MemoThunk + | MemoSave of [`Nil | `Cons of 'a * 'a t] + +let rec memoize f = + let r = ref MemoThunk in + 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 + +(*$R + let printer = Q.Print.(list int) in + let gen () = + let rec l = let r = ref 0 in fun () -> incr r; `Cons (!r, l) in l + in + let l1 = gen () in + assert_equal ~printer [1;2;3;4] (take 4 l1 |> to_list); + assert_equal ~printer [5;6;7;8] (take 4 l1 |> to_list); + let l2 = gen () |> memoize in + assert_equal ~printer [1;2;3;4] (take 4 l2 |> to_list); + assert_equal ~printer [1;2;3;4] (take 4 l2 |> to_list); +*) + + (** {2 Fair Combinations} *) let rec interleave a b () = match a() with diff --git a/src/iter/CCKList.mli b/src/iter/CCKList.mli index ef3ee73b..d785ec97 100644 --- a/src/iter/CCKList.mli +++ b/src/iter/CCKList.mli @@ -191,6 +191,10 @@ val sort_uniq : ?cmp:'a ord -> 'a t -> 'a t finite. O(n ln(n)) time and space. @since 0.3.3 *) +val memoize : 'a t -> 'a t +(** Avoid recomputations by caching intermediate results + @since NEXT_RELEASE *) + (** {2 Fair Combinations} *) val interleave : 'a t -> 'a t -> 'a t From 096948e71286cbfa6fdca40127ea3c4097b3013f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 2 Oct 2015 19:39:25 +0200 Subject: [PATCH 20/75] add `CCError.of_exn_trace` --- src/core/CCError.ml | 16 +++++++++++++++- src/core/CCError.mli | 7 +++++++ 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/src/core/CCError.ml b/src/core/CCError.ml index 47498964..c3b5a0f2 100644 --- a/src/core/CCError.ml +++ b/src/core/CCError.ml @@ -59,7 +59,7 @@ let register_printer p = _printers := p :: !_printers (* FIXME: just use {!Printexc.register_printer} instead? *) let of_exn e = - let buf = Buffer.create 15 in + let buf = Buffer.create 32 in let rec try_printers l = match l with | [] -> Buffer.add_string buf (Printexc.to_string e) | p :: l' -> @@ -69,6 +69,20 @@ let of_exn e = try_printers !_printers; `Error (Buffer.contents buf) +let of_exn_trace e = + let buf = Buffer.create 128 in + let rec try_printers l = match l with + | [] -> Buffer.add_string buf (Printexc.to_string e) + | p :: l' -> + try p buf e + with _ -> try_printers l' + in + try_printers !_printers; + Buffer.add_string buf "\nstack trace:\n"; + Buffer.add_string buf + (Printexc.raw_backtrace_to_string (Printexc.get_raw_backtrace ())); + `Error (Buffer.contents buf) + let map f e = match e with | `Ok x -> `Ok (f x) | `Error s -> `Error s diff --git a/src/core/CCError.mli b/src/core/CCError.mli index 072ecc96..5e4cda3c 100644 --- a/src/core/CCError.mli +++ b/src/core/CCError.mli @@ -50,6 +50,11 @@ val fail : 'err -> ('a,'err) t val of_exn : exn -> ('a, string) t (** [of_exn e] uses {!Printexc} to print the exception as a string *) +val of_exn_trace : exn -> ('a, string) t +(** [of_exn_trace e] is similar to [of_exn e], but it adds the stacktrace + to the error message + @since NEXT_RELEASE *) + val fail_printf : ('a, Buffer.t, unit, ('a,string) t) format4 -> 'a (** [fail_printf format] uses [format] to obtain an error message and then returns [`Error msg] @@ -205,3 +210,5 @@ This way a printer that doesn't know how to deal with an exception will let other printers do it. *) val register_printer : exn printer -> unit + +(* TODO: deprecate, should use {!Printexc} *) From fff366c41c479720d008510f264b240ab33537de Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 3 Oct 2015 08:52:14 +0200 Subject: [PATCH 21/75] use more retro-compatible fun for `CCError.of_exn_trace` --- src/core/CCError.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/core/CCError.ml b/src/core/CCError.ml index c3b5a0f2..a9336abb 100644 --- a/src/core/CCError.ml +++ b/src/core/CCError.ml @@ -79,8 +79,7 @@ let of_exn_trace e = in try_printers !_printers; Buffer.add_string buf "\nstack trace:\n"; - Buffer.add_string buf - (Printexc.raw_backtrace_to_string (Printexc.get_raw_backtrace ())); + Buffer.add_string buf (Printexc.get_backtrace ()); `Error (Buffer.contents buf) let map f e = match e with From cba2d040497b9fd0a7518917d71e57ae27b2f475 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 3 Oct 2015 08:53:58 +0200 Subject: [PATCH 22/75] doc --- src/core/CCError.ml | 2 +- src/core/CCError.mli | 5 ++++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/core/CCError.ml b/src/core/CCError.ml index a9336abb..97c06432 100644 --- a/src/core/CCError.ml +++ b/src/core/CCError.ml @@ -78,7 +78,7 @@ let of_exn_trace e = with _ -> try_printers l' in try_printers !_printers; - Buffer.add_string buf "\nstack trace:\n"; + Buffer.add_char buf '\n'; Buffer.add_string buf (Printexc.get_backtrace ()); `Error (Buffer.contents buf) diff --git a/src/core/CCError.mli b/src/core/CCError.mli index 5e4cda3c..cfd11249 100644 --- a/src/core/CCError.mli +++ b/src/core/CCError.mli @@ -52,7 +52,10 @@ val of_exn : exn -> ('a, string) t val of_exn_trace : exn -> ('a, string) t (** [of_exn_trace e] is similar to [of_exn e], but it adds the stacktrace - to the error message + to the error message. + + Remember to call [Printexc.record_backtrace true] and compile with the + debug flag for this to work. @since NEXT_RELEASE *) val fail_printf : ('a, Buffer.t, unit, ('a,string) t) format4 -> 'a From 42c4c310b4ad755ff75b7ee2ff9bd65c4d79541c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 3 Oct 2015 08:56:49 +0200 Subject: [PATCH 23/75] add `CCError.guard_str_trace` --- src/core/CCError.ml | 4 ++++ src/core/CCError.mli | 5 +++++ 2 files changed, 9 insertions(+) diff --git a/src/core/CCError.ml b/src/core/CCError.ml index 97c06432..20746abd 100644 --- a/src/core/CCError.ml +++ b/src/core/CCError.ml @@ -139,6 +139,10 @@ let guard_str f = try `Ok (f()) with e -> of_exn e +let guard_str_trace f = + try `Ok (f()) + with e -> of_exn_trace e + let wrap1 f x = try return (f x) with e -> `Error e diff --git a/src/core/CCError.mli b/src/core/CCError.mli index cfd11249..877e5874 100644 --- a/src/core/CCError.mli +++ b/src/core/CCError.mli @@ -118,6 +118,11 @@ val guard_str : (unit -> 'a) -> ('a, string) t (** Same as {!guard} but uses {!of_exn} to print the exception. See {!register_printer} *) +val guard_str_trace : (unit -> 'a) -> ('a, string) t +(** Same as {!guard_str} but uses {!of_exn_trace} instead of {!of_exn} so + that the stack trace is printed. + @since NEXT_RELEASE *) + val wrap1 : ('a -> 'b) -> 'a -> ('b, exn) t (** Same as {!guard} but gives the function one argument. *) From 5e6ade9f6888b9101e5dd1bf4aa25d3f2ecc8b71 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 3 Oct 2015 15:51:02 +0200 Subject: [PATCH 24/75] add `CCList.fold_map` --- src/core/CCList.ml | 19 +++++++++++++++++++ src/core/CCList.mli | 5 +++++ 2 files changed, 24 insertions(+) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 2c6daaae..3b9dbecc 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -152,6 +152,25 @@ let rec fold_while f acc = function fold_while (fun acc b -> if b then acc+1, `Continue else acc, `Stop) 0 [true;true;false;true] = 2 *) +let fold_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 (y :: map_acc) l' + in + aux f acc [] l + +(*$= + (6, ["1"; "2"; "3"]) \ + (fold_map (fun acc x->acc+x, string_of_int x) 0 [1;2;3]) +*) + +(*$Q + Q.(list int) (fun l -> \ + fold_map (fun acc x -> x::acc, x) [] l = (List.rev l, l)) +*) + let init len f = let rec init_rec acc i f = if i=0 then f i :: acc diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 02d8c1ce..2827b19f 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -66,6 +66,11 @@ val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a indicated by the accumulator @since 0.8 *) +val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list +(** [fold_map f acc l] is a [fold_left]-like function, but it also maps the + list to another list. + @since NEXT_RELEASE *) + val init : int -> (int -> 'a) -> 'a t (** Similar to {!Array.init} @since 0.6 *) From 1f463c1e9c8f302173ca8ead39c5e95be02a91e2 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 4 Oct 2015 21:11:12 +0200 Subject: [PATCH 25/75] expose blocking decoder in `CCSexpM` --- src/sexp/CCSexpM.ml | 6 ++++-- src/sexp/CCSexpM.mli | 8 ++++++++ 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/src/sexp/CCSexpM.ml b/src/sexp/CCSexpM.ml index 2dd9e49c..1fa12bef 100644 --- a/src/sexp/CCSexpM.ml +++ b/src/sexp/CCSexpM.ml @@ -309,11 +309,13 @@ module MakeDecode(M : MONAD) = struct expr_or_end (fun _ x -> M.return (`Ok x)) t end -module D = MakeDecode(struct +module ID_MONAD = struct type 'a t = 'a let return x = x let (>>=) x f = f x -end) +end + +module D = MakeDecode(ID_MONAD) let parse_string s : t or_error = let n = String.length s in diff --git a/src/sexp/CCSexpM.mli b/src/sexp/CCSexpM.mli index 5507fc20..704d0bc4 100644 --- a/src/sexp/CCSexpM.mli +++ b/src/sexp/CCSexpM.mli @@ -86,6 +86,14 @@ module MakeDecode(M : MONAD) : sig long enough or isn't a proper S-expression *) end +module ID_MONAD : MONAD +(** The monad that just uses blocking calls as bind + @since NEXT_RELEASE *) + +module D : module type of MakeDecode(ID_MONAD) +(** Decoder that just blocks when input is not available + @since NEXT_RELEASE *) + val parse_string : string -> t or_error (** Parse a string *) From 92510d2c70a3c5e440b8b0c08365c88835f7ff78 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 5 Oct 2015 19:27:52 +0200 Subject: [PATCH 26/75] bugfix in hashtable printing --- src/core/CCHashtbl.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/CCHashtbl.ml b/src/core/CCHashtbl.ml index 761a005f..ece4e6b6 100644 --- a/src/core/CCHashtbl.ml +++ b/src/core/CCHashtbl.ml @@ -161,7 +161,7 @@ module Make(X : Hashtbl.HashedType) = struct tbl let print pp_k pp_v fmt m = - Format.pp_print_string fmt "@[tbl {@,"; + Format.fprintf fmt "@[tbl {@,"; let first = ref true in iter (fun k v -> @@ -171,7 +171,7 @@ module Make(X : Hashtbl.HashedType) = struct pp_v fmt v; Format.pp_print_cut fmt () ) m; - Format.pp_print_string fmt "}@]" + Format.fprintf fmt "}@]" end (** {2 Default Table} *) From 164d71380a7a966058eeb1287beeb12897e97b18 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 7 Oct 2015 16:28:22 +0200 Subject: [PATCH 27/75] small bugfix in `CCSexpM.print` --- src/sexp/CCSexpM.ml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/sexp/CCSexpM.ml b/src/sexp/CCSexpM.ml index 1fa12bef..b2fa12eb 100644 --- a/src/sexp/CCSexpM.ml +++ b/src/sexp/CCSexpM.ml @@ -93,13 +93,11 @@ let rec print fmt t = match t with | `List [] -> Format.pp_print_string fmt "()" | `List [x] -> Format.fprintf fmt "@[(%a)@]" print x | `List l -> - Format.open_hovbox 2; - Format.pp_print_char fmt '('; + Format.fprintf fmt "@[("; List.iteri (fun i t' -> (if i > 0 then Format.fprintf fmt "@ "; print fmt t')) l; - Format.pp_print_char fmt ')'; - Format.close_box () + Format.fprintf fmt ")@]" let rec print_noindent fmt t = match t with | `Atom s when _must_escape s -> Format.fprintf fmt "\"%s\"" (String.escaped s) From 05fc100be2ae79cf04ee53909a7670d9357cdc1a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 7 Oct 2015 16:34:19 +0200 Subject: [PATCH 28/75] detail --- src/sexp/CCSexpM.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/sexp/CCSexpM.ml b/src/sexp/CCSexpM.ml index b2fa12eb..167db917 100644 --- a/src/sexp/CCSexpM.ml +++ b/src/sexp/CCSexpM.ml @@ -93,7 +93,7 @@ let rec print fmt t = match t with | `List [] -> Format.pp_print_string fmt "()" | `List [x] -> Format.fprintf fmt "@[(%a)@]" print x | `List l -> - Format.fprintf fmt "@[("; + Format.fprintf fmt "@[("; List.iteri (fun i t' -> (if i > 0 then Format.fprintf fmt "@ "; print fmt t')) l; From 6e99f1c8e8517a9468c001780ede909f2f364d08 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 8 Oct 2015 12:01:18 +0200 Subject: [PATCH 29/75] add `CCVector.to_seq_rev` --- src/core/CCVector.ml | 10 ++++++++++ src/core/CCVector.mli | 5 +++++ 2 files changed, 15 insertions(+) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 60f68286..2745f2b6 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -531,6 +531,16 @@ let of_seq ?(init=create ()) seq = let to_seq v k = iter k v +let to_seq_rev v k = + for i = v.size - 1 downto 0 do + k (Array.unsafe_get v.vec i) + done + +(*$Q + Q.(list int) (fun l -> \ + let v= of_list l in v |> to_seq_rev |> Sequence.to_rev_list = l) +*) + let slice_seq v start len = assert (start >= 0 && len >= 0); fun k -> diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index 79cc9798..3c5976f8 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -225,6 +225,11 @@ val of_seq : ?init:('a,rw) t -> 'a sequence -> ('a, rw) t val to_seq : ('a,_) t -> 'a sequence +val to_seq_rev : ('a, _) t -> 'a sequence +(** [to_seq_rev v] returns the sequence of elements of [v] in reverse order, + that is, the last elements of [v] are iterated on first. + @since NEXT_RELEASE *) + val slice : ('a,rw) t -> ('a array * int * int) (** Vector as an array slice. By doing it we expose the internal array, so be careful! *) From 2d05f33f2a7bc1b0d51885b72f7f7332c8522db3 Mon Sep 17 00:00:00 2001 From: Guillaume Bury Date: Tue, 13 Oct 2015 15:04:07 +0200 Subject: [PATCH 30/75] New CCPrint.char function --- src/core/CCPrint.ml | 1 + src/core/CCPrint.mli | 1 + 2 files changed, 2 insertions(+) diff --git a/src/core/CCPrint.ml b/src/core/CCPrint.ml index c73dc2ce..e93b3339 100644 --- a/src/core/CCPrint.ml +++ b/src/core/CCPrint.ml @@ -46,6 +46,7 @@ let string buf s = Buffer.add_string buf s let bool buf b = Printf.bprintf buf "%B" b let float3 buf f = Printf.bprintf buf "%.3f" f let float buf f = Buffer.add_string buf (string_of_float f) +let char buf c = Buffer.add_char buf c let list ?(start="[") ?(stop="]") ?(sep=", ") pp buf l = let rec pp_list l = match l with diff --git a/src/core/CCPrint.mli b/src/core/CCPrint.mli index a54f3cb8..ae81b69d 100644 --- a/src/core/CCPrint.mli +++ b/src/core/CCPrint.mli @@ -69,6 +69,7 @@ val string : string t val bool : bool t val float3 : float t (* 3 digits after . *) val float : float t +val char : char t val list : ?start:string -> ?stop:string -> ?sep:string -> 'a t -> 'a list t val array : ?start:string -> ?stop:string -> ?sep:string -> 'a t -> 'a array t From 22c205f1d45637533a4ef5ae3c175c16a4368a5c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 13 Oct 2015 15:07:12 +0200 Subject: [PATCH 31/75] add functions in `CCFormat` --- src/core/CCFormat.ml | 11 +++++++++-- src/core/CCFormat.mli | 10 ++++++++++ 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index f20ae774..419569ce 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -37,11 +37,16 @@ let silent _fmt _ = () let unit fmt () = Format.pp_print_string fmt "()" let int fmt i = Format.pp_print_string fmt (string_of_int i) -let string fmt s = Format.pp_print_string fmt s -let bool fmt b = Format.fprintf fmt "%B" b +let string = Format.pp_print_string +let bool = Format.pp_print_bool let float3 fmt f = Format.fprintf fmt "%.3f" f let float fmt f = Format.pp_print_string fmt (string_of_float f) +let char = Format.pp_print_char +let int32 fmt n = Format.fprintf fmt "%ld" n +let int64 fmt n = Format.fprintf fmt "%Ld" n +let nativeint fmt n = Format.fprintf fmt "%nd" n + let list ?(start="[") ?(stop="]") ?(sep=", ") pp fmt l = let rec pp_list l = match l with | x::((_::_) as l) -> @@ -125,6 +130,8 @@ let sprintf format = fmt format +let fprintf = Format.fprintf + let stdout = Format.std_formatter let stderr = Format.err_formatter diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 818ed3c2..a53185e8 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -44,6 +44,12 @@ val bool : bool printer val float3 : float printer (* 3 digits after . *) val float : float printer +val char : char printer (** @since NEXT_RELEASE *) +val int32 : int32 printer (** @since NEXT_RELEASE *) +val int64 : int64 printer (** @since NEXT_RELEASE *) +val nativeint : nativeint printer (** @since NEXT_RELEASE *) + + val list : ?start:string -> ?stop:string -> ?sep:string -> 'a printer -> 'a list printer val array : ?start:string -> ?stop:string -> ?sep:string -> 'a printer -> 'a array printer val arrayi : ?start:string -> ?stop:string -> ?sep:string -> @@ -69,5 +75,9 @@ val stderr : t val sprintf : ('a, t, unit, string) format4 -> 'a (** print into a string *) +val fprintf : t -> ('a, t, unit ) format -> 'a +(** Alias to {!Format.fprintf} + @since NEXT_RELEASE *) + val to_file : string -> ('a, t, unit, unit) format4 -> 'a (** Print to the given file *) From c71dfcf6f3b80e6a1134469b854a30bbae7596ef Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 13 Oct 2015 15:09:52 +0200 Subject: [PATCH 32/75] new module `CCChar` --- README.adoc | 2 ++ _oasis | 4 ++-- doc/intro.txt | 1 + src/core/CCChar.ml | 14 ++++++++++++++ src/core/CCChar.mli | 14 ++++++++++++++ 5 files changed, 33 insertions(+), 2 deletions(-) create mode 100644 src/core/CCChar.ml create mode 100644 src/core/CCChar.mli diff --git a/README.adoc b/README.adoc index d3f40103..8c8286b0 100644 --- a/README.adoc +++ b/README.adoc @@ -117,6 +117,8 @@ Documentation http://cedeela.fr/~simon/software/containers[here]. - `CCError` (monadic error handling, very useful) - `CCIO`, basic utilities for IO (channels, files) - `CCInt64,` utils for `int64` +- `CCChar`, utils for `char` +- `CCFormat`, pretty-printing utils around `Format` === Containers.data diff --git a/_oasis b/_oasis index dcde30ca..e3782bc7 100644 --- a/_oasis +++ b/_oasis @@ -45,8 +45,8 @@ Library "containers" Path: src/core Modules: CCVector, CCPrint, CCError, CCHeap, CCList, CCOpt, CCPair, CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray, CCRef, CCSet, - CCOrd, CCRandom, CCString, CCHashtbl, CCMap, CCFormat, CCIO, CCInt64, - Containers + CCOrd, CCRandom, CCString, CCHashtbl, CCMap, CCFormat, CCIO, + CCInt64, CCChar, Containers BuildDepends: bytes # BuildDepends: bytes, bisect_ppx diff --git a/doc/intro.txt b/doc/intro.txt index 36fb49ce..45adfe72 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -25,6 +25,7 @@ by ocamlfind). {!modules: CCArray CCBool +CCChar CCError CCFloat CCFun diff --git a/src/core/CCChar.ml b/src/core/CCChar.ml new file mode 100644 index 00000000..563bc962 --- /dev/null +++ b/src/core/CCChar.ml @@ -0,0 +1,14 @@ +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Utils around char} + + @since NEXT_RELEASE *) + +type t = char + +let equal (a:char) b = a=b +let compare = Char.compare + +let print = Format.pp_print_char + + diff --git a/src/core/CCChar.mli b/src/core/CCChar.mli new file mode 100644 index 00000000..c5af32c4 --- /dev/null +++ b/src/core/CCChar.mli @@ -0,0 +1,14 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Utils around char} + + @since NEXT_RELEASE *) + +type t = char + +val equal : t -> t -> bool +val compare : t -> t -> int + +val print : Format.formatter -> t -> unit + From 0610d014f128f1ec06e2552444d7c468cb43cf75 Mon Sep 17 00:00:00 2001 From: Guillaume Bury Date: Tue, 13 Oct 2015 15:13:50 +0200 Subject: [PATCH 33/75] Added @since in documentation --- src/core/CCPrint.mli | 1 + 1 file changed, 1 insertion(+) diff --git a/src/core/CCPrint.mli b/src/core/CCPrint.mli index ae81b69d..2e712110 100644 --- a/src/core/CCPrint.mli +++ b/src/core/CCPrint.mli @@ -70,6 +70,7 @@ val bool : bool t val float3 : float t (* 3 digits after . *) val float : float t val char : char t +(** @since NEXT_RELEASE *) val list : ?start:string -> ?stop:string -> ?sep:string -> 'a t -> 'a list t val array : ?start:string -> ?stop:string -> ?sep:string -> 'a t -> 'a array t From b3cbb518b47cd56b43ccd24f9cdecd70cfad775c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 13 Oct 2015 17:37:27 +0200 Subject: [PATCH 34/75] missing printer --- src/core/CCChar.ml | 1 + src/core/CCChar.mli | 1 + 2 files changed, 2 insertions(+) diff --git a/src/core/CCChar.ml b/src/core/CCChar.ml index 563bc962..026c7fbb 100644 --- a/src/core/CCChar.ml +++ b/src/core/CCChar.ml @@ -9,6 +9,7 @@ type t = char let equal (a:char) b = a=b let compare = Char.compare +let pp = Buffer.add_char let print = Format.pp_print_char diff --git a/src/core/CCChar.mli b/src/core/CCChar.mli index c5af32c4..14a8cb18 100644 --- a/src/core/CCChar.mli +++ b/src/core/CCChar.mli @@ -10,5 +10,6 @@ type t = char val equal : t -> t -> bool val compare : t -> t -> int +val pp : Buffer.t -> t -> unit val print : Format.formatter -> t -> unit From dd833cc667c5a51b4da647be412849a4607cffd0 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 14 Oct 2015 16:33:37 +0200 Subject: [PATCH 35/75] add `CCList.fold_flat_map` --- src/core/CCList.ml | 21 +++++++++++++++++++++ src/core/CCList.mli | 5 +++++ src/core/CCPrint.ml | 1 + 3 files changed, 27 insertions(+) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 3b9dbecc..4be891a6 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -171,6 +171,27 @@ let fold_map f acc l = fold_map (fun acc x -> x::acc, x) [] l = (List.rev l, l)) *) +let fold_flat_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 (List.rev_append y map_acc) l' + in + aux f acc [] l + +(*$= + (6, ["1"; "a1"; "2"; "a2"; "3"; "a3"]) \ + (let pf = Printf.sprintf in \ + fold_flat_map (fun acc x->acc+x, [pf "%d" x; pf "a%d" x]) 0 [1;2;3]) +*) + +(*$Q + Q.(list int) (fun l -> \ + fold_flat_map (fun acc x -> x::acc, [x;x+10]) [] l = \ + (List.rev l, flat_map (fun x->[x;x+10]) l) ) +*) + let init len f = let rec init_rec acc i f = if i=0 then f i :: acc diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 2827b19f..06144586 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -71,6 +71,11 @@ val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list list to another list. @since NEXT_RELEASE *) +val fold_flat_map : ('acc -> 'a -> 'acc * 'b list) -> 'acc -> 'a list -> 'acc * 'b list +(** [fold_map f acc l] is a [fold_left]-like function, but it also maps the + list to a list of list that is then [flatten]'d.. + @since NEXT_RELEASE *) + val init : int -> (int -> 'a) -> 'a t (** Similar to {!Array.init} @since 0.6 *) diff --git a/src/core/CCPrint.ml b/src/core/CCPrint.ml index e93b3339..9afcf7f9 100644 --- a/src/core/CCPrint.ml +++ b/src/core/CCPrint.ml @@ -149,6 +149,7 @@ let to_file filename format = module type MONAD_IO = sig type 'a t (** the IO monad *) + type output (** Output channels *) val (>>=) : 'a t -> ('a -> 'b t) -> 'b t From 1cc835dfd4fab9cceb55aa35c63cdcf6c484e932 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 16 Oct 2015 15:08:03 +0200 Subject: [PATCH 36/75] improve `CCHashtbl.MakeCounter` --- src/core/CCHashtbl.ml | 71 ++++++++++++++++++++++++++++++++++++++++-- src/core/CCHashtbl.mli | 34 ++++++++++++++++++-- 2 files changed, 101 insertions(+), 4 deletions(-) diff --git a/src/core/CCHashtbl.ml b/src/core/CCHashtbl.ml index ece4e6b6..0321c464 100644 --- a/src/core/CCHashtbl.ml +++ b/src/core/CCHashtbl.ml @@ -249,19 +249,48 @@ module type COUNTER = sig (** Increment the counter for the given element *) val incr_by : t -> int -> elt -> unit - (** Add several occurrences at once *) + (** Add or remove several occurrences at once. [incr_by c x n] + will add [n] occurrences of [x] if [n>0], + and remove [abs n] occurrences if [n<0]. *) val get : t -> elt -> int (** Number of occurrences for this element *) + val decr : t -> elt -> unit + (** Remove one occurrence of the element + @since NEXT_RELEASE *) + + val length : t -> int + (** Number of distinct elements + @since NEXT_RELEASE *) + val add_seq : t -> elt sequence -> unit (** Increment each element of the sequence *) val of_seq : elt sequence -> t (** [of_seq s] is the same as [add_seq (create ())] *) + + val to_seq : t -> (elt * int) sequence + (** [to_seq tbl] returns elements of [tbl] along with their multiplicity + @since NEXT_RELEASE *) + + val add_list : t -> (elt * int) list -> unit + (** Similar to {!add_seq} + @since NEXT_RELEASE *) + + val of_list : (elt * int) list -> t + (** Similar to {!of_seq} + @since NEXT_RELEASE *) + + val to_list : t -> (elt * int) list + (** @since NEXT_RELEASE *) end -module MakeCounter(X : Hashtbl.HashedType) = struct +module MakeCounter(X : Hashtbl.HashedType) + : COUNTER + with type elt = X.t + and type t = int Hashtbl.Make(X).t += struct type elt = X.t module T = Hashtbl.Make(X) @@ -272,6 +301,8 @@ module MakeCounter(X : Hashtbl.HashedType) = struct let get tbl x = try T.find tbl x with Not_found -> 0 + let length = T.length + let incr tbl x = let n = get tbl x in T.replace tbl x (n+1) @@ -282,10 +313,46 @@ module MakeCounter(X : Hashtbl.HashedType) = struct then T.remove tbl x else T.replace tbl x (n+n') + let decr tbl x = incr_by tbl 1 x + let add_seq tbl seq = seq (incr tbl) let of_seq seq = let tbl = create 32 in add_seq tbl seq; tbl + + let to_seq tbl yield = T.iter (fun x i -> yield (x,i)) tbl + + let add_list tbl l = + List.iter (fun (x,i) -> incr_by tbl i x) l + + let of_list l = + let tbl = create 32 in + add_list tbl l; + tbl + + let to_list tbl = + T.fold (fun x i acc -> (x,i) :: acc) tbl [] end + +(*$inject + module C = MakeCounter(CCInt) + + let list_int = Q.(make + ~print:Print.(list (pair int int)) + ~small:List.length + ~shrink:Shrink.(list ?shrink:None) + Gen.(list small_int >|= List.map (fun i->i,1)) + ) + + *) + +(*$Q + list_int (fun l -> \ + l |> C.of_list |> C.to_list |> List.length = \ + (l |> CCList.sort_uniq |> List.length)) + list_int (fun l -> \ + l |> C.of_list |> C.to_seq |> Sequence.fold (fun n(_,i)->i+n) 0 = \ + List.fold_left (fun n (_,_) ->n+1) 0 l) +*) diff --git a/src/core/CCHashtbl.mli b/src/core/CCHashtbl.mli index 32b4c6f4..fa5f521c 100644 --- a/src/core/CCHashtbl.mli +++ b/src/core/CCHashtbl.mli @@ -169,16 +169,46 @@ module type COUNTER = sig (** Increment the counter for the given element *) val incr_by : t -> int -> elt -> unit - (** Add several occurrences at once *) + (** Add or remove several occurrences at once. [incr_by c x n] + will add [n] occurrences of [x] if [n>0], + and remove [abs n] occurrences if [n<0]. *) val get : t -> elt -> int (** Number of occurrences for this element *) + val decr : t -> elt -> unit + (** Remove one occurrence of the element + @since NEXT_RELEASE *) + + val length : t -> int + (** Number of distinct elements + @since NEXT_RELEASE *) + val add_seq : t -> elt sequence -> unit (** Increment each element of the sequence *) val of_seq : elt sequence -> t (** [of_seq s] is the same as [add_seq (create ())] *) + + val to_seq : t -> (elt * int) sequence + (** [to_seq tbl] returns elements of [tbl] along with their multiplicity + @since NEXT_RELEASE *) + + val add_list : t -> (elt * int) list -> unit + (** Similar to {!add_seq} + @since NEXT_RELEASE *) + + val of_list : (elt * int) list -> t + (** Similar to {!of_seq} + @since NEXT_RELEASE *) + + val to_list : t -> (elt * int) list + (** @since NEXT_RELEASE *) end -module MakeCounter(X : Hashtbl.HashedType) : COUNTER with type elt = X.t +module MakeCounter(X : Hashtbl.HashedType) + : COUNTER + with type elt = X.t + and type t = int Hashtbl.Make(X).t +(** Create a new counter type + The type [t] is exposed @since NEXT_RELEASE *) From c10b240474b8f81898b2a0d975c6da217d0146ab Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 16 Oct 2015 15:22:23 +0200 Subject: [PATCH 37/75] add `CCHashtbl.update` --- src/core/CCHashtbl.ml | 41 ++++++++++++++++++++++++++++++++++++++++- src/core/CCHashtbl.mli | 16 ++++++++++++++++ 2 files changed, 56 insertions(+), 1 deletion(-) diff --git a/src/core/CCHashtbl.ml b/src/core/CCHashtbl.ml index 0321c464..65412453 100644 --- a/src/core/CCHashtbl.ml +++ b/src/core/CCHashtbl.ml @@ -71,6 +71,25 @@ let of_list l = List.iter (fun (k,v) -> Hashtbl.add tbl k v) l; tbl +let update tbl ~f ~k = + let v = get tbl k in + match v, f k v with + | None, None -> () + | None, Some v' -> Hashtbl.add tbl k v' + | Some _, Some v' -> Hashtbl.replace tbl k v' + | Some _, None -> Hashtbl.remove tbl k + +(*$R + let tbl = Hashtbl.create 32 in + update tbl ~k:1 ~f:(fun _ _ -> Some "1"); + assert_equal (Some "1") (get tbl 1); + update tbl ~k:2 ~f:(fun _ v->match v with Some _ -> assert false | None -> Some "2"); + assert_equal (Some "2") (get tbl 2); + assert_equal 2 (Hashtbl.length tbl); + update tbl ~k:1 ~f:(fun _ _ -> None); + assert_equal None (get tbl 1); +*) + let print pp_k pp_v fmt m = Format.fprintf fmt "@[tbl {@,"; let first = ref true in @@ -121,10 +140,22 @@ module type S = sig val of_list : (key * 'a) list -> 'a t (** From the given list of bindings, added in order *) + val update : 'a t -> f:(key -> 'a option -> 'a option) -> k:key -> unit + (** [update tbl ~f ~k] updates key [k] by calling [f k (Some v)] if + [k] was mapped to [v], or [f k None] otherwise; if the call + returns [None] then [k] is removed/stays removed, if the call + returns [Some v'] then the binding [k -> v'] is inserted + using {!Hashtbl.replace} + @since NEXT_RELEASE *) + val print : key printer -> 'a printer -> 'a t printer + (** Printer for tables + @since 0.13 *) end -module Make(X : Hashtbl.HashedType) = struct +module Make(X : Hashtbl.HashedType) + : S with type key = X.t and type 'a t = 'a Hashtbl.Make(X).t += struct include Hashtbl.Make(X) let get tbl x = @@ -143,6 +174,14 @@ module Make(X : Hashtbl.HashedType) = struct (fun x y acc -> f x y :: acc) h [] + let update tbl ~f ~k = + let v = get tbl k in + match v, f k v with + | None, None -> () + | None, Some v' -> add tbl k v' + | Some _, Some v' -> replace tbl k v' + | Some _, None -> remove tbl k + let to_seq tbl k = iter (fun key v -> k (key,v)) tbl let of_seq seq = diff --git a/src/core/CCHashtbl.mli b/src/core/CCHashtbl.mli index fa5f521c..aaa3cf2c 100644 --- a/src/core/CCHashtbl.mli +++ b/src/core/CCHashtbl.mli @@ -68,6 +68,14 @@ val to_list : ('a,'b) Hashtbl.t -> ('a * 'b) list val of_list : ('a * 'b) list -> ('a,'b) Hashtbl.t (** From the given list of bindings, added in order *) +val update : ('a, 'b) Hashtbl.t -> f:('a -> 'b option -> 'b option) -> k:'a -> unit +(** [update tbl ~f ~k] updates key [k] by calling [f k (Some v)] if + [k] was mapped to [v], or [f k None] otherwise; if the call + returns [None] then [k] is removed/stays removed, if the call + returns [Some v'] then the binding [k -> v'] is inserted + using {!Hashtbl.replace} + @since NEXT_RELEASE *) + val print : 'a printer -> 'b printer -> ('a, 'b) Hashtbl.t printer (** Printer for table @since 0.13 *) @@ -109,6 +117,14 @@ module type S = sig val of_list : (key * 'a) list -> 'a t (** From the given list of bindings, added in order *) + val update : 'a t -> f:(key -> 'a option -> 'a option) -> k:key -> unit + (** [update tbl ~f ~k] updates key [k] by calling [f k (Some v)] if + [k] was mapped to [v], or [f k None] otherwise; if the call + returns [None] then [k] is removed/stays removed, if the call + returns [Some v'] then the binding [k -> v'] is inserted + using {!Hashtbl.replace} + @since NEXT_RELEASE *) + val print : key printer -> 'a printer -> 'a t printer (** Printer for tables @since 0.13 *) From b34986518d87ed5d5ca967471a0040f30e117886 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 16 Oct 2015 23:14:27 +0200 Subject: [PATCH 38/75] large update of `CCList.Zipper`. Breaking semantics of `CCList.Zipper.is_empty` --- src/core/CCList.ml | 36 +++++++++++++++++++++++++++++------- src/core/CCList.mli | 39 +++++++++++++++++++++++++++++++++++++-- 2 files changed, 66 insertions(+), 9 deletions(-) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 4be891a6..5833d17d 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -815,14 +815,17 @@ module Zipper = struct let empty = [], [] let is_empty = function - | _, [] -> true - | _, _::_ -> false + | [], [] -> true + | _ -> false - let to_list (l,r) = - let rec append l acc = match l with - | [] -> acc - | x::l' -> append l' (x::acc) - in append l r + let to_list (l,r) = List.rev_append l r + + let to_rev_list (l,r) = List.rev_append r l + + (*$Q + Q.(pair (list small_int)(list small_int)) (fun z -> \ + Zipper.to_list z = List.rev (Zipper.to_rev_list z)) + *) let make l = [], l @@ -846,6 +849,10 @@ module Zipper = struct | Some _ -> l, x::r end + let is_focused = function + | _, [] -> true + | _ -> false + let focused = function | _, x::_ -> Some x | _, [] -> None @@ -853,6 +860,21 @@ module Zipper = struct let focused_exn = function | _, x::_ -> x | _, [] -> raise Not_found + + let insert x (l,r) = l, x::r + + let remove (l,r) = match r with + | [] -> l, [] + | _ :: r' -> l, r' + + (*$Q + Q.(triple int (list small_int)(list small_int)) (fun (x,l,r) -> \ + Zipper.insert x (l,r) |> Zipper.remove = (l,r)) + *) + + let drop_before (_, r) = [], r + + let drop_after (l, _) = l, [] end (** {2 References on Lists} *) diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 06144586..f470396e 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -302,15 +302,28 @@ end module Zipper : sig type 'a t = 'a list * 'a list + (** The pair [l, r] represents the list [List.rev_append l r], but + with the focus on [r]. *) val empty : 'a t (** Empty zipper *) val is_empty : _ t -> bool - (** Empty zipper, or at the end of the zipper? *) + (** Empty zipper? Returns true iff the two lists are empty. *) + + (*$T + Zipper.(is_empty empty) + not ([42] |> Zipper.make |> Zipper.right |> Zipper.is_empty) + *) val to_list : 'a t -> 'a list - (** Convert the zipper back to a list *) + (** Convert the zipper back to a list. + [to_list (l,r)] is [List.rev_append l r] *) + + val to_rev_list : 'a t -> 'a list + (** Convert the zipper back to a {i reversed} list. + In other words, [to_list (l,r)] is [List.rev_append r l] + @since NEXT_RELEASE *) val make : 'a list -> 'a t (** Create a zipper pointing at the first element of the list *) @@ -325,6 +338,20 @@ module Zipper : sig (** Modify the current element, if any, by returning a new element, or returning [None] if the element is to be deleted *) + val insert : 'a -> 'a t -> 'a t + (** Insert an element at the current position. If an element was focused, + [insert x l] adds [x] just before it, and focuses on [x] + @since NEXT_RELEASE *) + + val remove : 'a t -> 'a t + (** [remove l] removes the current element, if any. + @since NEXT_RELEASE *) + + val is_focused : _ t -> bool + (** Is the zipper focused on some element? That is, will {!focused} + return a [Some v]? + @since NEXT_RELEASE *) + val focused : 'a t -> 'a option (** Returns the focused element, if any. [focused zip = Some _] iff [empty zip = false] *) @@ -332,6 +359,14 @@ module Zipper : sig val focused_exn : 'a t -> 'a (** Returns the focused element, or @raise Not_found if the zipper is at an end *) + + val drop_before : 'a t -> 'a t + (** Drop every element on the "left" (calling {!left} then will do nothing). + @since NEXT_RELEASE *) + + val drop_after : 'a t -> 'a t + (** Drop every element on the "right" (calling {!right} then will do nothing). + @since NEXT_RELEASE *) end (** {2 References on Lists} From 79f872daf4bd82ae9b71d2b0e8a062447b6cb7ab Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 16 Oct 2015 23:29:15 +0200 Subject: [PATCH 39/75] more functions in `CCList.Zipper` --- src/core/CCList.ml | 14 +++++++++++++- src/core/CCList.mli | 24 +++++++++++++++++++++++- 2 files changed, 36 insertions(+), 2 deletions(-) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 5833d17d..f6239ecd 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -833,10 +833,18 @@ module Zipper = struct | x::l, r -> l, x::r | [], r -> [], r + let left_exn = function + | x::l, r -> l, x::r + | [], _ -> invalid_arg "zipper.left_exn" + let right = function | l, x::r -> x::l, r | l, [] -> l, [] + let right_exn = function + | l, x::r -> x::l, r + | _, [] -> invalid_arg "zipper.right_exn" + let modify f z = match z with | l, [] -> begin match f None with @@ -874,7 +882,11 @@ module Zipper = struct let drop_before (_, r) = [], r - let drop_after (l, _) = l, [] + let drop_after (l, r) = match r with + | [] -> l, [] + | x :: _ -> l, [x] + + let drop_after_and_focused (l, _) = l, [] end (** {2 References on Lists} *) diff --git a/src/core/CCList.mli b/src/core/CCList.mli index f470396e..c825a00c 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -331,9 +331,19 @@ module Zipper : sig val left : 'a t -> 'a t (** Go to the left, or do nothing if the zipper is already at leftmost pos *) + val left_exn : 'a t -> 'a t + (** Go to the left, or + @raise Invalid_argument if the zipper is already at leftmost pos + @since NEXT_RELEASE *) + val right : 'a t -> 'a t (** Go to the right, or do nothing if the zipper is already at rightmost pos *) + val right_exn : 'a t -> 'a t + (** Go to the right, or + @raise Invalid_argument if the zipper is already at rightmost position + @since NEXT_RELEASE *) + val modify : ('a option -> 'a option) -> 'a t -> 'a t (** Modify the current element, if any, by returning a new element, or returning [None] if the element is to be deleted *) @@ -365,8 +375,20 @@ module Zipper : sig @since NEXT_RELEASE *) val drop_after : 'a t -> 'a t - (** Drop every element on the "right" (calling {!right} then will do nothing). + (** Drop every element on the "right" (calling {!right} then will do nothing), + keeping the focused element, if any. @since NEXT_RELEASE *) + + val drop_after_and_focused : 'a t -> 'a t + (** Drop every element on the "right" (calling {!right} then will do nothing), + {i including} the focused element if it is present. + @since NEXT_RELEASE *) + + (*$= + ([1], [2]) (Zipper.drop_after ([1], [2;3])) + ([1], []) (Zipper.drop_after ([1], [])) + ([1], []) (Zipper.drop_after_and_focused ([1], [2;3])) + *) end (** {2 References on Lists} From 3c458a2c037c1148385af78148e24c8af748f0a7 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 19 Oct 2015 20:27:52 +0200 Subject: [PATCH 40/75] fix broken link to changelog (fix #51) --- README.adoc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.adoc b/README.adoc index 8c8286b0..3b70f5e7 100644 --- a/README.adoc +++ b/README.adoc @@ -43,7 +43,7 @@ toc::[] == Change Log -See link:CHANGELOG.md[this file]. +See link:CHANGELOG.adoc[this file]. == Finding help From d18db5f3d99bf8da6401eb139a57ce14eda62f70 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 19 Oct 2015 20:29:33 +0200 Subject: [PATCH 41/75] remove obsolete section of readme --- README.adoc | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/README.adoc b/README.adoc index 3b70f5e7..50f637d8 100644 --- a/README.adoc +++ b/README.adoc @@ -203,19 +203,6 @@ The library has moved to https://github.com/c-cube/containers-misc . `containers.lwt` has moved to https://github.com/c-cube/containers-lwt . -== Incoming (Breaking) Changes - -- change exceptions in `CCVector` -- change signature of `CCDeque.of_seq` (remove optional argument) -- heavily refactor `CCLinq` in `containers.advanced`. If you use this module, - you will most likely have to change your code (into simpler code, hopefully). -- `RAL` in `containers.misc` moved to `containers.data` as `CCRAL`, and is - getting improved on the way -- moving `containers.lwt` into its own repository and opam package -- moving `containers.misc` into its own repository and opam package (improving the average quality of containers!) -- aliasing and deprecating `CCList.split` (confusion with `List.split`) - - [[build]] == Build From c1b15129e48c4781848387eb56ed82c180eea743 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 19 Oct 2015 21:54:38 +0200 Subject: [PATCH 42/75] update readme to link to `gen` and `sequence` --- README.adoc | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/README.adoc b/README.adoc index 50f637d8..67a00539 100644 --- a/README.adoc +++ b/README.adoc @@ -89,6 +89,24 @@ The library contains a <> that mostly extends the stdlib and adds a few very common structures (heap, vector), and sub-libraries that deal with either more specific things, or require additional dependencies. +Some structural types are used throughout the library: + +gen:: `'a gen = unit -> 'a option` is an iterator type. Many combinators + are defined in the opam library called "gen" +sequence:: `'a sequence = (unit -> 'a) -> unit` is also an iterator type. + It is easier to define on data structures than `gen`, but it a bit less + powerful. The opam library `sequence` can be used to consume and produce + values of this type. +error:: `'a or_error = [`Error of string | `Ok of 'a]` is a error type + that is used in other libraries, too. The reference module in containers + is `CCError`. +klist:: `'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]` is a lazy list + without memoization, used as a persistent iterator. The reference + module is `CCKList` (in `containers.iter`). +printer:: `'a printer = Format.formatter -> 'a -> unit` is a pretty-printer + to be used with the standard module `Format`. In particular, in many cases, + `"foo: %a" Foo.print foo` will type-check. + [[core]] === Core Modules (extension of the standard library) From bba674cdd3fc79ed576ed1fcb3c9f1059715e78e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 19 Oct 2015 21:56:43 +0200 Subject: [PATCH 43/75] urls --- README.adoc | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.adoc b/README.adoc index 67a00539..f2a79adc 100644 --- a/README.adoc +++ b/README.adoc @@ -92,11 +92,11 @@ that deal with either more specific things, or require additional dependencies. Some structural types are used throughout the library: gen:: `'a gen = unit -> 'a option` is an iterator type. Many combinators - are defined in the opam library called "gen" + are defined in the opam library https://github.com/c-cube/gen[gen] sequence:: `'a sequence = (unit -> 'a) -> unit` is also an iterator type. It is easier to define on data structures than `gen`, but it a bit less - powerful. The opam library `sequence` can be used to consume and produce - values of this type. + powerful. The opam library https://github.com/c-cube/sequence[sequence] + can be used to consume and produce values of this type. error:: `'a or_error = [`Error of string | `Ok of 'a]` is a error type that is used in other libraries, too. The reference module in containers is `CCError`. From f95254104483b77815fe4ebd7f04835399208eec Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 19 Oct 2015 22:16:52 +0200 Subject: [PATCH 44/75] add `Containers.Hashtbl` with most combinators of `CCHashtbl` --- src/core/containers.ml | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/core/containers.ml b/src/core/containers.ml index 4ee3802b..b00aeb7b 100644 --- a/src/core/containers.ml +++ b/src/core/containers.ml @@ -61,17 +61,21 @@ end module Fun = CCFun module Hash = CCHash module Int = CCInt -(* FIXME + +(** @since NEXT_RELEASE *) module Hashtbl = struct include (Hashtbl : module type of Hashtbl with type statistics = Hashtbl.statistics - and module Make := Hashtbl.Make - and module type S := Hashtbl.S + and module Make = Hashtbl.Make and type ('a,'b) t := ('a,'b) Hashtbl.t ) - include CCHashtbl + (* still unable to include CCHashtbl itself, for the polymorphic functions *) + module type S' = CCHashtbl.S + module Make' = CCHashtbl.Make + module Counter = CCHashtbl.MakeCounter + module MakeDefault = CCHashtbl.MakeDefault end -*) + module List = struct include List include CCList From 799089659a3302c4435834865b8afdb2f8b6a7aa Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 14:15:33 +0200 Subject: [PATCH 45/75] add `CCVector.find_map` --- src/core/CCVector.ml | 21 ++++++++++++++++++++- src/core/CCVector.mli | 5 +++++ 2 files changed, 25 insertions(+), 1 deletion(-) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 2745f2b6..2254a04d 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -454,7 +454,9 @@ let find_exn p v = let n = v.size in let rec check i = if i = n then raise Not_found - else if p v.vec.(i) then v.vec.(i) + else + let x = v.vec.(i) in + if p x then x else check (i+1) in check 0 @@ -462,6 +464,23 @@ let find p v = try Some (find_exn p v) with Not_found -> None +let find_map f v = + let n = v.size in + let rec search i = + if i=n then None + else match f v.vec.(i) with + | None -> search (i+1) + | Some _ as res -> res + in + search 0 + +(*$Q + Q.(list small_int) (fun l -> \ + let v = of_list l in \ + let f x = x>30 && x < 35 in \ + find_map (fun x -> if f x then Some x else None) v = find f v) +*) + let filter_map f v = let v' = create () in iter diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index 3c5976f8..26871405 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -164,6 +164,11 @@ val find_exn : ('a -> bool) -> ('a,_) t -> 'a (** find an element that satisfies the predicate, or @raise Not_found if no element does *) +val find_map : ('a -> 'b option) -> ('a,_) t -> 'b option +(** [find_map f v] returns the first [Some y = f x] for [x] in [v], + or [None] if [f x = None] for each [x] in [v] + @since NEXT_RELEASE *) + val filter_map : ('a -> 'b option) -> ('a,_) t -> ('b, 'mut) t (** Map elements with a function, possibly filtering some of them out *) From 2c39b63945a8281c464c2ba15beacee7087fbd8a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 14:43:13 +0200 Subject: [PATCH 46/75] add `CCVector.return`; refactoring --- src/core/CCVector.ml | 18 ++++++++++++++---- src/core/CCVector.mli | 4 ++++ 2 files changed, 18 insertions(+), 4 deletions(-) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 2254a04d..7159faca 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -68,6 +68,16 @@ let create_with ?(capacity=128) x = { (create_with ~capacity:200 1 |> capacity) >= 200 *) +let return x = { + size=1; + vec= [| x |]; +} + +(*$T + return 42 |> to_list = [42] + return 42 |> length = 1 +*) + let make n x = { size=n; vec=Array.make n x; @@ -134,14 +144,14 @@ let clear v = let is_empty v = v.size = 0 -let push_unsafe v x = +let push_unsafe_ v x = Array.unsafe_set v.vec v.size x; v.size <- v.size + 1 let push v x = if v.size = Array.length v.vec then _grow v x; - push_unsafe v x + push_unsafe_ v x (** add all elements of b to a *) let append a b = @@ -410,7 +420,7 @@ let filter p v = else ( let v' = create_with ~capacity:v.size v.vec.(0) in Array.iter - (fun x -> if p x then push_unsafe v' x) + (fun x -> if p x then push_unsafe_ v' x) v.vec; v' ) @@ -598,7 +608,7 @@ let of_list l = match l with | [] -> create() | x::_ -> let v = create_with ~capacity:(List.length l + 5) x in - List.iter (push_unsafe v) l; + List.iter (push_unsafe_ v) l; v (*$T diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index 26871405..5febb003 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -59,6 +59,10 @@ val create_with : ?capacity:int -> 'a -> ('a, rw) t @param capacity the size of the underlying array {b caution}: the value will likely not be GC'd before the vector is. *) +val return : 'a -> ('a, 'mut) t +(** Singleton vector + @since NEXT_RELEASE *) + val make : int -> 'a -> ('a, 'mut) t (** [make n x] makes a vector of size [n], filled with [x] *) From fb3ffa1bb59133a0bf62f5e981d19857fc777828 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 14:44:20 +0200 Subject: [PATCH 47/75] add `CCVector.ensure_with` --- src/core/CCVector.ml | 21 +++++++++++++++------ src/core/CCVector.mli | 9 ++++++++- 2 files changed, 23 insertions(+), 7 deletions(-) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 7159faca..3fc6eacf 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -117,13 +117,12 @@ let _grow v x = _resize v size ) -(* resize so that capacity is at least size. Use a doubling-size - strategy so that calling many times [ensure] will +(* v is not empty; ensure it has at least [size] slots. + + Use a doubling-size strategy so that calling many times [ensure] will behave well *) -let ensure v size = - if Array.length v.vec = 0 - then () - else if size > Sys.max_array_length +let ensure_not_empty_ v size = + if size > Sys.max_array_length then failwith "vec.ensure: size too big" else ( let n = ref (max 16 (Array.length v.vec)) in @@ -131,6 +130,16 @@ let ensure v size = _resize v !n ) +let ensure_with ~init v size = + if Array.length v.vec = 0 + then v.vec <- Array.make size init + else ensure_not_empty_ v size + +let ensure v size = + if Array.length v.vec = 0 + then () + else ensure_not_empty_ v size + let clear v = v.size <- 0 diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index 5febb003..cee9ad08 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -72,9 +72,16 @@ val init : int -> (int -> 'a) -> ('a, 'mut) t val clear : ('a, rw) t -> unit (** clear the content of the vector *) +val ensure_with : init:'a -> ('a, rw) t -> int -> unit +(** Hint to the vector that it should have at least the given capacity. + @param init if [capacity v = 0], used as a filler + element for the underlying array (see {!create_with}) + @since NEXT_RELEASE *) + val ensure : ('a, rw) t -> int -> unit (** Hint to the vector that it should have at least the given capacity. - Just a hint, will not be enforced if the vector is empty. *) + Just a hint, will not be enforced if the vector is empty and [init] + is not provided. *) val is_empty : ('a, _) t -> bool (** is the vector empty? *) From 3a21aab9c8d32524d5f0a89bb65adef89e3917e4 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 14:44:36 +0200 Subject: [PATCH 48/75] add `CCVector.append_list` --- src/core/CCVector.ml | 19 +++++++++++++++++++ src/core/CCVector.mli | 4 ++++ 2 files changed, 23 insertions(+) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 3fc6eacf..5180758e 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -222,6 +222,25 @@ let append_array a b = append_array v1 v2; to_list v1 = CCList.(0--9) *) +let append_list a b = match b with + | [] -> () + | x :: _ -> + (* need to push at least one elem *) + let len_a = a.size in + let len_b = List.length b in + ensure_with ~init:x a (len_a + len_b); + List.iter (push_unsafe_ a) b; + () + +(*$Q + Q.(pair (list int)(list int)) (fun (l1,l2) -> \ + let v = of_list l1 in append_list v l2; \ + to_list v = (l1 @ l2)) + Q.(pair (list int)(list int)) (fun (l1,l2) -> \ + let v = of_list l1 in append_list v l2; \ + length v = List.length l1 + List.length l2) +*) + (*$inject let gen x = let small = length in diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index cee9ad08..17d21bfd 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -98,6 +98,10 @@ val append_array : ('a, rw) t -> 'a array -> unit val append_seq : ('a, rw) t -> 'a sequence -> unit (** Append content of sequence *) +val append_list : ('a, rw) t -> 'a list -> unit +(** Append content of list + @since NEXT_RELEASE *) + val equal : 'a equal -> ('a,_) t equal val compare : 'a ord -> ('a,_) t ord From 8e85872beb574101589e02bfea262484bfd1c055 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 14:44:43 +0200 Subject: [PATCH 49/75] deprecate `CCVector.flat_map'`, renamed `flat_map_seq`; add `flat_map_list` --- src/core/CCVector.ml | 15 +++++++++++++-- src/core/CCVector.mli | 13 ++++++++++++- 2 files changed, 25 insertions(+), 3 deletions(-) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 5180758e..acf8d8ca 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -533,15 +533,26 @@ let flat_map f v = iter (fun x -> iter (push v') (f x)) v; v' -let flat_map' f v = +let flat_map_seq f v = let v' = create () in iter (fun x -> let seq = f x in - seq (fun y -> push v' y) + append_seq v' seq; ) v; v' +let flat_map_list f v = + let v' = create () in + iter + (fun x -> + let l = f x in + append_list v' l; + ) v; + v' + +let flat_map' = flat_map_seq + let (>>=) x f = flat_map f x let (>|=) x f = map f x diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index 17d21bfd..deec25fd 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -190,8 +190,19 @@ val filter_map : ('a -> 'b option) -> ('a,_) t -> ('b, 'mut) t val flat_map : ('a -> ('b,_) t) -> ('a,_) t -> ('b, 'mut) t (** Map each element to a sub-vector *) +val flat_map_seq : ('a -> 'b sequence) -> ('a,_) t -> ('b, 'mut) t +(** Like {!flat_map}, but using {!sequence} for + intermediate collections. + @since NEXT_RELEASE *) + +val flat_map_list : ('a -> 'b list) -> ('a,_) t -> ('b, 'mut) t +(** Like {!flat_map}, but using {!list} for + intermediate collections. + @since NEXT_RELEASE *) + val flat_map' : ('a -> 'b sequence) -> ('a,_) t -> ('b, 'mut) t -(** Like {!flat_map}, but using {!sequence} for intermediate collections *) +(** Alias to {!flat_map_seq} + @deprecated since NEXT_RELEASE , use {!flat_map_seq} *) val (>>=) : ('a,_) t -> ('a -> ('b,_) t) -> ('b, 'mut) t (** Infix version of {!flat_map} *) From da188ec911fbbf41739b2832d47e5a2d31b477f4 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 14:53:41 +0200 Subject: [PATCH 50/75] tests --- src/core/CCVector.ml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index acf8d8ca..792d178e 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -162,6 +162,11 @@ let push v x = then _grow v x; push_unsafe_ v x +(*$T + let v = create () in push v 1; to_list v = [1] + let v = of_list [1;2;3] in push v 4; to_list v = [1;2;3;4] +*) + (** add all elements of b to a *) let append a b = if _empty_array a From 526cda8ecb174ab4c2cca3353e91637507310274 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 15:02:51 +0200 Subject: [PATCH 51/75] add `CCVector.rev_iter` --- src/core/CCVector.ml | 15 +++++++++++++++ src/core/CCVector.mli | 4 ++++ 2 files changed, 19 insertions(+) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 792d178e..a93ab7b8 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -586,6 +586,21 @@ let rev v = rev (create ()) |> to_list = [] *) +let rev_iter f v = + for i = v.size-1 downto 0 do + f v.vec.(i) + done + +(*$T + let v = of_list [1;2;3] in (fun f->rev_iter f v) |> Sequence.to_list = [3;2;1] +*) + +(*$Q + Q.(list int) (fun l -> \ + let v = of_list l in \ + (fun f->rev_iter f v) |> Sequence.to_list = List.rev l) +*) + let size v = v.size let length v = v.size diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index deec25fd..d1b00c06 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -228,6 +228,10 @@ val rev : ('a,_) t -> ('a, 'mut) t val rev' : ('a, rw) t -> unit (** Reverse the vector in place *) +val rev_iter : ('a -> unit) -> ('a,_) t -> unit +(** [rev_iter f a] is the same as [iter f (rev a)], only more efficient. + @since NEXT_RELEASE *) + val size : ('a,_) t -> int (** number of elements in vector *) From 41beb03dd03bb21a3fb4848eb252fb484d256a23 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 15:06:00 +0200 Subject: [PATCH 52/75] deprecate `CCVector.rev'`, renamed into `CCVector.rev_in_place` --- src/core/CCVector.ml | 6 ++++-- src/core/CCVector.mli | 6 +++++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index a93ab7b8..088b40e6 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -562,7 +562,7 @@ let (>>=) x f = flat_map f x let (>|=) x f = map f x -let rev' v = +let rev_in_place v = if v.size > 0 then ( let n = v.size in @@ -575,9 +575,11 @@ let rev' v = done ) +let rev' = rev_in_place + let rev v = let v' = copy v in - rev' v'; + rev_in_place v'; v' (*$T diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index d1b00c06..887e5c22 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -225,8 +225,12 @@ val remove : ('a, rw) t -> int -> unit val rev : ('a,_) t -> ('a, 'mut) t (** Reverse the vector *) +val rev_in_place : ('a, rw) t -> unit +(** Reverse the vector in place + @since NEXT_RELEASE *) + val rev' : ('a, rw) t -> unit -(** Reverse the vector in place *) +(** @deprecated old name for {!rev_in_place} *) val rev_iter : ('a -> unit) -> ('a,_) t -> unit (** [rev_iter f a] is the same as [iter f (rev a)], only more efficient. From fb484c6e81a7b36cea32a1e486d43b889161fa93 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 20:34:04 +0200 Subject: [PATCH 53/75] add `make watch` target --- Makefile | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Makefile b/Makefile index 25526672..4f0e4731 100644 --- a/Makefile +++ b/Makefile @@ -128,4 +128,10 @@ devel: --enable-bigarray --enable-thread --enable-advanced make all +watch: + while find src/ -print0 | xargs -0 inotifywait -e delete_self -e modify ; do \ + echo "============ at `date` ==========" ; \ + make ; \ + done + .PHONY: examples push_doc tags qtest-gen qtest-clean devel update_next_tag From aa1c5fb0e90cbc2877cb9ad739a6e5a26386b421 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 22:20:04 +0200 Subject: [PATCH 54/75] bew bench to compare `CCPersistentHashtbl` with ref implementation --- benchs/ref_impl.ml | 346 +++++++++++++++++++++++++++++++++++++++++++ benchs/run_benchs.ml | 42 +++++- 2 files changed, 380 insertions(+), 8 deletions(-) create mode 100644 benchs/ref_impl.ml diff --git a/benchs/ref_impl.ml b/benchs/ref_impl.ml new file mode 100644 index 00000000..04fca7d2 --- /dev/null +++ b/benchs/ref_impl.ml @@ -0,0 +1,346 @@ + +(* reference implementations for some structures, for comparison purpose *) + +module PersistentHashtbl(H : Hashtbl.HashedType) = struct + module Table = Hashtbl.Make(H) + (** Imperative hashtable *) + + type key = H.t + type 'a t = 'a zipper ref + and 'a zipper = + | Table of 'a Table.t (** Concrete table *) + | Add of key * 'a * 'a t (** Add key *) + | Replace of key * 'a * 'a t (** Replace key by value *) + | Remove of key * 'a t (** As the table, but without given key *) + + let create i = + ref (Table (Table.create i)) + + let empty () = create 11 + + (* pass continuation to get a tailrec rerooting *) + let rec _reroot t k = match !t with + | Table tbl -> k tbl (* done *) + | Add (key, v, t') -> + _reroot t' + (fun tbl -> + t' := Remove (key, t); + Table.add tbl key v; + t := Table tbl; + k tbl) + | Replace (key, v, t') -> + _reroot t' + (fun tbl -> + let v' = Table.find tbl key in + t' := Replace (key, v', t); + t := Table tbl; + Table.replace tbl key v; + k tbl) + | Remove (key, t') -> + _reroot t' + (fun tbl -> + let v = Table.find tbl key in + t' := Add (key, v, t); + t := Table tbl; + Table.remove tbl key; + k tbl) + + (* Reroot: modify the zipper so that the current node is a proper + hashtable, and return the hashtable *) + let reroot t = match !t with + | Table tbl -> tbl + | _ -> _reroot t (fun x -> x) + + let is_empty t = Table.length (reroot t) = 0 + + let find t k = Table.find (reroot t) k + + (*$R + let h = H.of_seq my_seq in + OUnit.assert_equal "a" (H.find h 1); + OUnit.assert_raises Not_found (fun () -> H.find h 5); + let h' = H.replace h 5 "e" in + OUnit.assert_equal "a" (H.find h' 1); + OUnit.assert_equal "e" (H.find h' 5); + OUnit.assert_equal "a" (H.find h 1); + OUnit.assert_raises Not_found (fun () -> H.find h 5); + *) + + (*$R + let n = 10000 in + let seq = Sequence.map (fun i -> i, string_of_int i) Sequence.(0--n) in + let h = H.of_seq seq in + Sequence.iter + (fun (k,v) -> + OUnit.assert_equal ~printer:(fun x -> x) v (H.find h k)) + seq; + OUnit.assert_raises Not_found (fun () -> H.find h (n+1)); + *) + + (*$QR + _list_int_int + (fun l -> + let h = H.of_list l in + List.for_all + (fun (k,v) -> + try + H.find h k = v + with Not_found -> false) + l + ) + *) + + let get_exn k t = find t k + + let get k t = + try Some (find t k) + with Not_found -> None + + let mem t k = Table.mem (reroot t) k + + let length t = Table.length (reroot t) + + (*$R + let h = H.of_seq + Sequence.(map (fun i -> i, string_of_int i) + (0 -- 200)) in + OUnit.assert_equal 201 (H.length h); + *) + + (*$QR + _list_int_int (fun l -> + let h = H.of_list l in + H.length h = List.length l + ) + *) + + let replace t k v = + let tbl = reroot t in + (* create the new hashtable *) + let t' = ref (Table tbl) in + (* update [t] to point to the new hashtable *) + (try + let v' = Table.find tbl k in + t := Replace (k, v', t') + with Not_found -> + t := Remove (k, t') + ); + (* modify the underlying hashtable *) + Table.replace tbl k v; + t' + + let remove t k = + let tbl = reroot t in + try + let v' = Table.find tbl k in + (* value present, make a new hashtable without this value *) + let t' = ref (Table tbl) in + t := Add (k, v', t'); + Table.remove tbl k; + t' + with Not_found -> + (* not member, nothing to do *) + t + + (*$R + let h = H.of_seq my_seq in + OUnit.assert_equal (H.find h 2) "b"; + OUnit.assert_equal (H.find h 3) "c"; + OUnit.assert_equal (H.find h 4) "d"; + OUnit.assert_equal (H.length h) 4; + let h = H.remove h 2 in + OUnit.assert_equal (H.find h 3) "c"; + OUnit.assert_equal (H.length h) 3; + OUnit.assert_raises Not_found (fun () -> H.find h 2) + *) + + (*$R + let open Sequence.Infix in + let n = 10000 in + let seq = Sequence.map (fun i -> i, string_of_int i) (0 -- n) in + let h = H.of_seq seq in + OUnit.assert_equal (n+1) (H.length h); + let h = Sequence.fold (fun h i -> H.remove h i) h (0 -- 500) in + OUnit.assert_equal (n-500) (H.length h); + OUnit.assert_bool "is_empty" (H.is_empty (H.create 16)); + *) + + (*$QR + _list_int_int (fun l -> + let h = H.of_list l in + let h = List.fold_left (fun h (k,_) -> H.remove h k) h l in + H.is_empty h) + *) + + let update t k f = + let v = get k t in + match v, f v with + | None, None -> t (* no change *) + | Some _, None -> remove t k + | _, Some v' -> replace t k v' + + let copy t = + let tbl = reroot t in + (* no one will point to the new [t] *) + let t = ref (Table (Table.copy tbl)) in + t + + let iter t f = + let tbl = reroot t in + Table.iter f tbl + + let fold f acc t = + let tbl = reroot t in + Table.fold (fun k v acc -> f acc k v) tbl acc + + let map f t = + let tbl = reroot t in + let res = Table.create (Table.length tbl) in + Table.iter (fun k v -> Table.replace res k (f k v)) tbl; + ref (Table res) + + let filter p t = + let tbl = reroot t in + let res = Table.create (Table.length tbl) in + Table.iter (fun k v -> if p k v then Table.replace res k v) tbl; + ref (Table res) + + let filter_map f t = + let tbl = reroot t in + let res = Table.create (Table.length tbl) in + Table.iter + (fun k v -> match f k v with + | None -> () + | Some v' -> Table.replace res k v' + ) tbl; + ref (Table res) + + exception ExitPTbl + + let for_all p t = + try + iter t (fun k v -> if not (p k v) then raise ExitPTbl); + true + with ExitPTbl -> false + + let exists p t = + try + iter t (fun k v -> if p k v then raise ExitPTbl); + false + with ExitPTbl -> true + + let merge f t1 t2 = + let tbl = Table.create (max (length t1) (length t2)) in + iter t1 + (fun k v1 -> + let v2 = try Some (find t2 k) with Not_found -> None in + match f k (Some v1) v2 with + | None -> () + | Some v' -> Table.replace tbl k v'); + iter t2 + (fun k v2 -> + if not (mem t1 k) then match f k None (Some v2) with + | None -> () + | Some _ -> Table.replace tbl k v2); + ref (Table tbl) + + (*$R + 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) + t1 t2 + in + OUnit.assert_equal ~printer:string_of_int 3 (H.length t); + OUnit.assert_equal "a" (H.find t 1); + OUnit.assert_equal "b1" (H.find t 2); + OUnit.assert_equal "c" (H.find t 3); + *) + + let add_seq init seq = + let tbl = ref init in + seq (fun (k,v) -> tbl := replace !tbl k v); + !tbl + + let of_seq seq = add_seq (empty ()) seq + + let add_list init l = + add_seq init (fun k -> List.iter k l) + + (*$QR + _list_int_int (fun l -> + let l1, l2 = List.partition (fun (x,_) -> x mod 2 = 0) l in + let h1 = H.of_list l1 in + let h2 = H.add_list h1 l2 in + List.for_all + (fun (k,v) -> H.find h2 k = v) + l + && + List.for_all + (fun (k,v) -> H.find h1 k = v) + l1 + && + List.length l1 = H.length h1 + && + List.length l = H.length h2 + ) + *) + + let of_list l = add_list (empty ()) l + + let to_list t = + let tbl = reroot t in + let bindings = Table.fold (fun k v acc -> (k,v)::acc) tbl [] in + bindings + + (*$R + let h = H.of_seq my_seq in + let l = Sequence.to_list (H.to_seq h) in + OUnit.assert_equal my_list (List.sort compare l) + *) + + let to_seq t = + fun k -> + let tbl = reroot t in + Table.iter (fun x y -> k (x,y)) tbl + + (*$R + let h = H.of_seq my_seq in + OUnit.assert_equal "b" (H.find h 2); + OUnit.assert_equal "a" (H.find h 1); + OUnit.assert_raises Not_found (fun () -> H.find h 42); + *) + + let equal eq t1 t2 = + length t1 = length t2 + && + for_all + (fun k v -> match get k t2 with + | None -> false + | Some v' -> eq v v' + ) t1 + + let pp pp_k pp_v buf t = + Buffer.add_string buf "{"; + let first = ref true in + iter t + (fun k v -> + if !first then first:=false else Buffer.add_string buf ", "; + Printf.bprintf buf "%a -> %a" pp_k k pp_v v + ); + Buffer.add_string buf "}" + + let print pp_k pp_v fmt t = + Format.pp_print_string fmt "{"; + let first = ref true in + iter t + (fun k v -> + if !first then first:=false + else (Format.pp_print_string fmt ", "; Format.pp_print_cut fmt ()); + Format.fprintf fmt "%a -> %a" pp_k k pp_v v + ); + Format.pp_print_string fmt "}" +end diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index 10402385..2445742a 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -268,12 +268,25 @@ module Tbl = struct end in (module T) + let persistent_hashtbl_ref = + let module T = Ref_impl.PersistentHashtbl(CCInt) in + let module U = struct + type key = int + type 'a t = 'a T.t ref + let name = "persistent_tbl_old" + let create _ = ref (T.empty ()) + let find m k = T.find !m k + let add m k v = m := T.replace !m k v + let replace = add + end in + (module U : INT_MUT) + let persistent_hashtbl = let module T = CCPersistentHashtbl.Make(CCInt) in let module U = struct type key = int type 'a t = 'a T.t ref - let name = "ccpersistent_hashtbl" + let name = "persistent_tbl" let create _ = ref (T.empty ()) let find m k = T.find !m k let add m k v = m := T.replace !m k v @@ -395,7 +408,7 @@ module Tbl = struct ; trie ] - let bench_add n = + let bench_add_to which n = let make (module T : INT_MUT) = let run() = let t = T.create 50 in @@ -405,7 +418,9 @@ module Tbl = struct in T.name, run, () in - B.throughputN 3 ~repeat (List.map make modules_int) + B.throughputN 3 ~repeat (List.map make which) + + let bench_add = bench_add_to modules_int let bench_add_string n = let keys = CCList.( 1 -- n |> map (fun i->string_of_int i,i)) in @@ -477,7 +492,7 @@ module Tbl = struct ; persistent_array ] @ List.map find_of_mut modules_int - let bench_find n = + let bench_find_to which n = let make (module T : INT_FIND) = let m = T.init n (fun i -> i) in let run() = @@ -487,7 +502,9 @@ module Tbl = struct in T.name, run, () in - Benchmark.throughputN 3 ~repeat (List.map make modules_int_find) + Benchmark.throughputN 3 ~repeat (List.map make which) + + let bench_find = bench_find_to modules_int_find let bench_find_string n = let keys = CCList.( 1 -- n |> map (fun i->string_of_int i,i)) in @@ -503,14 +520,23 @@ module Tbl = struct in Benchmark.throughputN 3 ~repeat (List.map make modules_string) - let () = B.Tree.register ( - "tbl" @>>> + let () = + B.Tree.register ("tbl" @>>> [ "add_int" @>> app_ints bench_add [10; 100; 1_000; 10_000;] ; "add_string" @>> app_ints bench_add_string [10; 100; 1_000; 10_000;] ; "replace" @>> app_ints bench_replace [10; 100; 1_000; 10_000] ; "find" @>> app_ints bench_find [10; 20; 100; 1_000; 10_000] ; "find_string" @>> app_ints bench_find_string [10; 20; 100; 1_000; 10_000] - ]) + ]); + B.Tree.register ("tbl_persistent" @>>> + [ "add_int" @>> app_ints + (bench_add_to [persistent_hashtbl; persistent_hashtbl_ref]) [10; 100; 1_000; 10_000;] + ; "find_int" @>> app_ints + (bench_find_to + (List.map find_of_mut [persistent_hashtbl; persistent_hashtbl_ref])) + [10; 20; 100; 1_000; 10_000] + ]); + () end module Iter = struct From 15d5da628dd13456a143ad61ed361c0dae636324 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 22:19:28 +0200 Subject: [PATCH 55/75] reimplementation of `CCPersistentHashtbl` --- _tags | 2 +- src/data/CCPersistentHashtbl.ml | 353 ++++++++++++++++++++++---------- 2 files changed, 242 insertions(+), 113 deletions(-) diff --git a/_tags b/_tags index 98970d9a..233f46bb 100644 --- a/_tags +++ b/_tags @@ -3,6 +3,6 @@ : thread : thread : inline(25) - or : inline(15) + or or : inline(15) and not : warn_A, warn(-4), warn(-44) true: no_alias_deps, safe_string diff --git a/src/data/CCPersistentHashtbl.ml b/src/data/CCPersistentHashtbl.ml index 338d9826..9f73f2d3 100644 --- a/src/data/CCPersistentHashtbl.ml +++ b/src/data/CCPersistentHashtbl.ml @@ -155,58 +155,85 @@ end (** {2 Implementation} *) module Make(H : HashedType) : S with type key = H.t = struct - module Table = Hashtbl.Make(H) - (** Imperative hashtable *) - type key = H.t - type 'a t = 'a zipper ref - and 'a zipper = - | Table of 'a Table.t (** Concrete table *) - | Add of key * 'a * 'a t (** Add key *) - | Replace of key * 'a * 'a t (** Replace key by value *) - | Remove of key * 'a t (** As the table, but without given key *) + + (* main hashtable *) + type 'a t = { + mutable arr: 'a p_array; (* invariant: length is a power of 2 *) + length: int; + } + + (* piece of a persistent array *) + and 'a p_array = + | Arr of 'a bucket array + | Set of int * 'a bucket * 'a t + + (* bucket of the hashtbl *) + and 'a bucket = + | Nil + | Cons of key * 'a * 'a bucket + + (* first power of two that is bigger than [than], starting from [n] *) + let rec power_two_larger ~than n = + if n>= than then n else power_two_larger ~than (2*n) let create i = - ref (Table (Table.create i)) + let i = power_two_larger ~than:i 16 in + { length=0; + arr=Arr (Array.make i Nil) + } - let empty () = create 11 + let empty () = create 16 - (* pass continuation to get a tailrec rerooting *) - let rec _reroot t k = match !t with - | Table tbl -> k tbl (* done *) - | Add (key, v, t') -> - _reroot t' - (fun tbl -> - t' := Remove (key, t); - Table.add tbl key v; - t := Table tbl; - k tbl) - | Replace (key, v, t') -> - _reroot t' - (fun tbl -> - let v' = Table.find tbl key in - t' := Replace (key, v', t); - t := Table tbl; - Table.replace tbl key v; - k tbl) - | Remove (key, t') -> - _reroot t' - (fun tbl -> - let v = Table.find tbl key in - t' := Add (key, v, t); - t := Table tbl; - Table.remove tbl key; - k tbl) + let rec reroot_rec_ t k = match t.arr with + | Arr a -> k a + | Set (i, v, t') -> + reroot_rec_ t' (fun a -> + let v' = a.(i) in + a.(i) <- v; + t.arr <- Arr a; + t'.arr <- Set (i, v', t); + k a + ) - (* Reroot: modify the zipper so that the current node is a proper - hashtable, and return the hashtable *) - let reroot t = match !t with - | Table tbl -> tbl - | _ -> _reroot t (fun x -> x) + (* obtain the array *) + let reroot_ t = match t.arr with + | Arr a -> a + | _ -> reroot_rec_ t (fun x -> x) - let is_empty t = Table.length (reroot t) = 0 + let is_empty t = t.length = 0 - let find t k = Table.find (reroot t) k + let length t = t.length + + (* find index of [h] in [a] *) + let find_idx_ a ~h = + (* bitmask 00001111 if length(a) = 10000 *) + h land (Array.length a - 1) + + let rec find_rec_ k l = match l with + | Nil -> raise Not_found + | Cons (k', v', l') -> + if H.equal k k' then v' else find_rec_ k l' + + let find t k = + let a = reroot_ t in + (* unroll like crazy *) + match a.(find_idx_ ~h:(H.hash k) a) with + | Nil -> raise Not_found + | Cons (k1, v1, l1) -> + if H.equal k k1 then v1 + else match l1 with + | Nil -> raise Not_found + | Cons (k2,v2,l2) -> + if H.equal k k2 then v2 + else match l2 with + | Nil -> raise Not_found + | Cons (k3,v3,l3) -> + if H.equal k k3 then v3 + else match l3 with + | Nil -> raise Not_found + | Cons (k4,v4,l4) -> + if H.equal k k4 then v4 else find_rec_ k l4 (*$R let h = H.of_seq my_seq in @@ -249,9 +276,9 @@ module Make(H : HashedType) : S with type key = H.t = struct try Some (find t k) with Not_found -> None - let mem t k = Table.mem (reroot t) k - - let length t = Table.length (reroot t) + let mem t k = + try ignore (find t k); true + with Not_found -> false (*$R let h = H.of_seq @@ -267,33 +294,98 @@ module Make(H : HashedType) : S with type key = H.t = struct ) *) + let rec buck_rev_iter_ ~f l = match l with + | Nil -> () + | Cons (k,v,l') -> buck_rev_iter_ ~f l'; f k v + + (* resize [a] so it has capacity [new_size], and insert [k,v] in it *) + let resize_ k v h a new_size = + assert (new_size > Array.length a); + let a' = Array.make new_size Nil in + (* preserve order of elements by iterating on each bucket in rev order *) + Array.iter + (buck_rev_iter_ + ~f:(fun k v -> + let i = find_idx_ ~h:(H.hash k) a' in + a'.(i) <- Cons (k,v,a'.(i)) + ) + ) + a; + let i = find_idx_ ~h a' in + a'.(i) <- Cons (k,v,a'.(i)); + a' + + (* insert [k,v] in [l] and returns new list and boolean flag indicating + whether it's a new element *) + let rec replace_rec_ k v l = match l with + | Nil -> Cons (k,v,Nil), true + | Cons (k',v',l') -> + if H.equal k k' + then Cons (k,v,l'), false + else + let l', is_new = replace_rec_ k v l' in + Cons (k',v',l'), is_new + let replace t k v = - let tbl = reroot t in - (* create the new hashtable *) - let t' = ref (Table tbl) in - (* update [t] to point to the new hashtable *) - (try - let v' = Table.find tbl k in - t := Replace (k, v', t') - with Not_found -> - t := Remove (k, t') - ); - (* modify the underlying hashtable *) - Table.replace tbl k v; - t' + let a = reroot_ t in + let h = H.hash k in + let i = find_idx_ ~h a in + match a.(i) with + | Nil -> + if t.length > (Array.length a) lsl 1 + then ( + (* resize *) + let new_size = min (2 * (Array.length a)) Sys.max_array_length in + let a = resize_ k v h a new_size in + {length=t.length+1; arr=Arr a} + ) else ( + a.(i) <- Cons (k, v, Nil); + let t' = {length=t.length + 1; arr=Arr a} in + t.arr <- Set (i,Nil,t'); + t' + ) + | Cons _ as l -> + let l', is_new = replace_rec_ k v l in + if is_new && t.length > (Array.length a) lsl 1 + then ( + (* resize and insert [k,v] (again, it's new anyway) *) + let new_size = min (2 * (Array.length a)) Sys.max_array_length in + let a = resize_ k v h a new_size in + {length=t.length+1; arr=Arr a} + ) else ( + (* no resize *) + a.(i) <- l'; + let t' = { + length=if is_new then t.length+1 else t.length; + arr=Arr a; + } in + t.arr <- Set (i,l,t'); + t' + ) + + (* return [Some l'] if [l] changed into [l'] by removing [k] *) + let rec remove_rec_ k l = match l with + | Nil -> None + | Cons (k', v', l') -> + if H.equal k k' + then Some l' + else match remove_rec_ k l' with + | None -> None + | Some l' -> Some (Cons (k', v', l')) let remove t k = - let tbl = reroot t in - try - let v' = Table.find tbl k in - (* value present, make a new hashtable without this value *) - let t' = ref (Table tbl) in - t := Add (k, v', t'); - Table.remove tbl k; - t' - with Not_found -> - (* not member, nothing to do *) - t + let a = reroot_ t in + let i = find_idx_ ~h:(H.hash k) a in + match a.(i) with + | Nil -> t + | Cons _ as l -> + match remove_rec_ k l with + | None -> t + | Some l' -> + a.(i) <- l'; + let t' = {length=t.length-1; arr=Arr a} in + t.arr <- Set (i,l,t'); + t' (*$R let h = H.of_seq my_seq in @@ -333,40 +425,78 @@ module Make(H : HashedType) : S with type key = H.t = struct | _, Some v' -> replace t k v' let copy t = - let tbl = reroot t in - (* no one will point to the new [t] *) - let t = ref (Table (Table.copy tbl)) in - t + let a = Array.copy (reroot_ t) in + {t with arr=Arr a} + + let rec buck_iter_ ~f l = match l with + | Nil -> () + | Cons (k,v,l') -> f k v; buck_iter_ ~f l' let iter t f = - let tbl = reroot t in - Table.iter f tbl + let a = reroot_ t in + Array.iter (buck_iter_ ~f) a + + let rec buck_fold_ f acc l = match l with + | Nil -> acc + | Cons (k,v,l') -> + let acc = f acc k v in + buck_fold_ f acc l' let fold f acc t = - let tbl = reroot t in - Table.fold (fun k v acc -> f acc k v) tbl acc + let a = reroot_ t in + Array.fold_left (buck_fold_ f) acc a let map f t = - let tbl = reroot t in - let res = Table.create (Table.length tbl) in - Table.iter (fun k v -> Table.replace res k (f k v)) tbl; - ref (Table res) + let rec buck_map_ f l = match l with + | Nil -> Nil + | Cons (k,v,l') -> + let v' = f k v in + Cons (k,v', buck_map_ f l') + in + let a = reroot_ t in + let a' = Array.map (buck_map_ f) a in + {length=t.length; arr=Arr a'} + + let rec buck_filter_ ~f l = match l with + | Nil -> Nil + | Cons (k,v,l') -> + let l' = buck_filter_ ~f l' in + if f k v then Cons (k,v,l') else l' + + let buck_length_ b = buck_fold_ (fun n _ _ -> n+1) 0 b let filter p t = - let tbl = reroot t in - let res = Table.create (Table.length tbl) in - Table.iter (fun k v -> if p k v then Table.replace res k v) tbl; - ref (Table res) + let a = reroot_ t in + let length = ref 0 in + let a' = Array.map + (fun b -> + let b' = buck_filter_ ~f:p b in + length := !length + (buck_length_ b'); + b' + ) a + in + {length= !length; arr=Arr a'} + + let rec buck_filter_map_ ~f l = match l with + | Nil -> Nil + | Cons (k,v,l') -> + let l' = buck_filter_map_ ~f l' in + match f k v with + | None -> l' + | Some v' -> + Cons (k,v',l') let filter_map f t = - let tbl = reroot t in - let res = Table.create (Table.length tbl) in - Table.iter - (fun k v -> match f k v with - | None -> () - | Some v' -> Table.replace res k v' - ) tbl; - ref (Table res) + let a = reroot_ t in + let length = ref 0 in + let a' = Array.map + (fun b -> + let b' = buck_filter_map_ ~f b in + length := !length + (buck_length_ b'); + b' + ) a + in + {length= !length; arr=Arr a'} exception ExitPTbl @@ -383,19 +513,22 @@ module Make(H : HashedType) : S with type key = H.t = struct with ExitPTbl -> true let merge f t1 t2 = - let tbl = Table.create (max (length t1) (length t2)) in - iter t1 - (fun k v1 -> + 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 - | None -> () - | Some v' -> Table.replace tbl k v'); - iter t2 - (fun k v2 -> - if not (mem t1 k) then match f k None (Some v2) with - | None -> () - | Some _ -> Table.replace tbl k v2); - ref (Table tbl) + | None -> tbl + | Some v' -> replace tbl k v') + tbl t1 + in + fold + (fun tbl k v2 -> + if mem t1 k then tbl + else match f k None (Some v2) with + | None -> tbl + | Some _ -> replace tbl k v2 + ) tbl t2 (*$R let t1 = H.of_list [1, "a"; 2, "b1"] in @@ -444,10 +577,7 @@ module Make(H : HashedType) : S with type key = H.t = struct let of_list l = add_list (empty ()) l - let to_list t = - let tbl = reroot t in - let bindings = Table.fold (fun k v acc -> (k,v)::acc) tbl [] in - bindings + let to_list t = fold (fun acc k v -> (k,v)::acc) [] t (*$R let h = H.of_seq my_seq in @@ -457,8 +587,7 @@ module Make(H : HashedType) : S with type key = H.t = struct let to_seq t = fun k -> - let tbl = reroot t in - Table.iter (fun x y -> k (x,y)) tbl + iter t (fun x y -> k (x,y)) (*$R let h = H.of_seq my_seq in From 54c2e4541e638302891c1acaf6435853b9c8923d Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 22:48:51 +0200 Subject: [PATCH 56/75] add `CCPersistentHashtbl.stats` --- src/data/CCPersistentHashtbl.ml | 21 +++++++++++++++++++++ src/data/CCPersistentHashtbl.mli | 4 ++++ 2 files changed, 25 insertions(+) diff --git a/src/data/CCPersistentHashtbl.ml b/src/data/CCPersistentHashtbl.ml index 9f73f2d3..a0dbbf20 100644 --- a/src/data/CCPersistentHashtbl.ml +++ b/src/data/CCPersistentHashtbl.ml @@ -129,6 +129,10 @@ module type S = sig val pp : key printer -> 'a printer -> 'a t printer val print : key formatter -> 'a formatter -> 'a t formatter + + val stats : _ t -> Hashtbl.statistics + (** Statistics on the internal table. + @since NEXT_RELEASE *) end (*$inject @@ -625,5 +629,22 @@ module Make(H : HashedType) : S with type key = H.t = struct Format.fprintf fmt "%a -> %a" pp_k k pp_v v ); Format.pp_print_string fmt "}" + + let stats t = + let a = reroot_ t in + let max_bucket_length = + Array.fold_left (fun n b -> max n (buck_length_ b)) 0 a in + let bucket_histogram = Array.make (max_bucket_length+1) 0 in + Array.iter + (fun b -> + let l = buck_length_ b in + bucket_histogram.(l) <- bucket_histogram.(l) + 1 + ) a; + {Hashtbl. + num_bindings=t.length; + num_buckets=Array.length a; + max_bucket_length; + bucket_histogram; + } end diff --git a/src/data/CCPersistentHashtbl.mli b/src/data/CCPersistentHashtbl.mli index 30de0f03..8651f34c 100644 --- a/src/data/CCPersistentHashtbl.mli +++ b/src/data/CCPersistentHashtbl.mli @@ -136,6 +136,10 @@ module type S = sig val pp : key printer -> 'a printer -> 'a t printer val print : key formatter -> 'a formatter -> 'a t formatter + + val stats : _ t -> Hashtbl.statistics + (** Statistics on the internal table. + @since NEXT_RELEASE *) end (** {2 Implementation} *) From 2d2f92c8990b4eadb18311db62e6afd6e22b6215 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 23:01:14 +0200 Subject: [PATCH 57/75] improve benchmarks --- benchs/run_benchs.ml | 53 +++++++++++++++++++++++++++----------------- 1 file changed, 33 insertions(+), 20 deletions(-) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index 2445742a..ad756618 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -263,36 +263,40 @@ module Tbl = struct = fun key -> let (module Key), name = arg_make key in let module T = struct - let name = sprintf "hashtbl.make(%s)" name + let name = sprintf "hashtbl(%s)" name include Hashtbl.Make(Key) end in (module T) - let persistent_hashtbl_ref = - let module T = Ref_impl.PersistentHashtbl(CCInt) in + let persistent_hashtbl_ref : type a. a key_type -> (module MUT with type key = a) + = fun key -> + let (module Key), name = arg_make key in + let module T = Ref_impl.PersistentHashtbl(Key) in let module U = struct - type key = int + type key = a type 'a t = 'a T.t ref - let name = "persistent_tbl_old" + let name = sprintf "persistent_tbl_old(%s)" name let create _ = ref (T.empty ()) let find m k = T.find !m k let add m k v = m := T.replace !m k v let replace = add end in - (module U : INT_MUT) + (module U) - let persistent_hashtbl = - let module T = CCPersistentHashtbl.Make(CCInt) in + let persistent_hashtbl : type a. a key_type -> (module MUT with type key = a) + = fun key -> + let (module Key), name = arg_make key in + let module T = CCPersistentHashtbl.Make(Key) in let module U = struct - type key = int + type key = a type 'a t = 'a T.t ref - let name = "persistent_tbl" + let name = sprintf "persistent_tbl(%s)" name let create _ = ref (T.empty ()) let find m k = T.find !m k let add m k v = m := T.replace !m k v let replace = add end in - (module U : INT_MUT) + (module U) let hashtbl = let module T = struct @@ -389,7 +393,7 @@ module Tbl = struct let modules_int = [ hashtbl_make Int ; hashtbl - ; persistent_hashtbl + ; persistent_hashtbl Int (* ; poly_hashtbl *) ; map Int ; wbt Int @@ -404,6 +408,7 @@ module Tbl = struct ; map Str ; wbt Str ; hashtrie Str + ; persistent_hashtbl Str ; hamt Str ; trie ] @@ -422,7 +427,7 @@ module Tbl = struct let bench_add = bench_add_to modules_int - let bench_add_string n = + let bench_add_string_to l n = let keys = CCList.( 1 -- n |> map (fun i->string_of_int i,i)) in let make (module T : STRING_MUT) = let run() = @@ -433,7 +438,9 @@ module Tbl = struct in T.name, run, () in - B.throughputN 3 ~repeat (List.map make modules_string) + B.throughputN 3 ~repeat (List.map make l) + + let bench_add_string = bench_add_string_to modules_string let bench_replace n = let make (module T : INT_MUT) = @@ -506,7 +513,7 @@ module Tbl = struct let bench_find = bench_find_to modules_int_find - let bench_find_string n = + let bench_find_string_to l n = let keys = CCList.( 1 -- n |> map (fun i->string_of_int i,i)) in let make (module T : STRING_MUT) = let m = T.create n in @@ -518,7 +525,9 @@ module Tbl = struct in T.name, run, () in - Benchmark.throughputN 3 ~repeat (List.map make modules_string) + Benchmark.throughputN 3 ~repeat (List.map make l) + + let bench_find_string = bench_find_string_to modules_string let () = B.Tree.register ("tbl" @>>> @@ -529,12 +538,16 @@ module Tbl = struct ; "find_string" @>> app_ints bench_find_string [10; 20; 100; 1_000; 10_000] ]); B.Tree.register ("tbl_persistent" @>>> - [ "add_int" @>> app_ints - (bench_add_to [persistent_hashtbl; persistent_hashtbl_ref]) [10; 100; 1_000; 10_000;] + let l_int = [persistent_hashtbl Int; persistent_hashtbl_ref Int] in + let l_str = [persistent_hashtbl Str; persistent_hashtbl_ref Str] in + [ "add_int" @>> app_ints (bench_add_to l_int) [10; 100; 1_000; 10_000;] ; "find_int" @>> app_ints - (bench_find_to - (List.map find_of_mut [persistent_hashtbl; persistent_hashtbl_ref])) + (bench_find_to (List.map find_of_mut l_int)) [10; 20; 100; 1_000; 10_000] + ; "add_string" @>> app_ints + (bench_add_string_to l_str) [10; 100; 1_000; 10_000;] + ; "find_string" @>> app_ints + (bench_find_string_to l_str) [10; 20; 100; 1_000; 10_000] ]); () end From 523097f1587949bc4164660621d24c625b8f510a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 23:06:17 +0200 Subject: [PATCH 58/75] fix doc generation for `containers.string` --- doc/intro.txt | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/doc/intro.txt b/doc/intro.txt index 45adfe72..fc23b41c 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -113,7 +113,12 @@ Iterators: {4 String} -{!modules: Levenshtein KMP} +{!modules: +CCApp_parse +CCKMP +CCLevenshtein +CCParse +} {4 Bigarrays} From 49c2e6fba2b1b44ac05c28e2d5fe65796755301d Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 23:51:35 +0200 Subject: [PATCH 59/75] add labels on `CCParse.parse_` functions --- src/string/CCParse.ml | 18 +++++++++--------- src/string/CCParse.mli | 19 ++++++++++++------- 2 files changed, 21 insertions(+), 16 deletions(-) diff --git a/src/string/CCParse.ml b/src/string/CCParse.ml index 9edc928e..9b5578c9 100644 --- a/src/string/CCParse.ml +++ b/src/string/CCParse.ml @@ -357,30 +357,30 @@ let fix_memo f = in p -let parse_exn ~input p = p input +let parse_exn ~input ~p = p input -let parse ~input p = - try `Ok (parse_exn ~input p) +let parse ~input ~p = + try `Ok (parse_exn ~input ~p) with ParseError (lnum, cnum, msg) -> `Error (Printf.sprintf "at line %d, column %d: error, %s" lnum cnum (msg ())) -let parse_string s p = parse ~input:(input_of_string s) p -let parse_string_exn s p = parse_exn ~input:(input_of_string s) p +let parse_string s ~p = parse ~input:(input_of_string s) ~p +let parse_string_exn s ~p = parse_exn ~input:(input_of_string s) ~p -let parse_file_exn ?size ~file p = +let parse_file_exn ?size ~file ~p = let ic = open_in file in let input = input_of_chan ?size ic in try - let res = parse_exn ~input p in + let res = parse_exn ~input ~p in close_in ic; res with e -> close_in ic; raise e -let parse_file ?size ~file p = +let parse_file ?size ~file ~p = try - `Ok (parse_file_exn ?size ~file p) + `Ok (parse_file_exn ?size ~file ~p) with | ParseError (lnum, cnum, msg) -> `Error (Printf.sprintf "at line %d, column %d: error, %s" lnum cnum (msg ())) diff --git a/src/string/CCParse.mli b/src/string/CCParse.mli index da4383ec..e55a4a6c 100644 --- a/src/string/CCParse.mli +++ b/src/string/CCParse.mli @@ -27,6 +27,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (** {1 Very Simple Parser Combinators} +{b status} still a bit unstable, the type {!'a t} might still change. + Examples: {6 parse recursive structures} @@ -238,28 +240,31 @@ val fix_memo : ('a t -> 'a t) -> 'a t (** Same as {!fix}, but the fixpoint is memoized. @since 0.13 *) -(** {2 Parse} *) +(** {2 Parse} -val parse : input:input -> 'a t -> 'a or_error + Those functions have a label [~p] on the parser, since NEXT_RELEASE. +*) + +val parse : input:input -> p:'a t -> 'a or_error (** [parse ~input p] applies [p] on the input, and returns [`Ok x] if [p] succeeds with [x], or [`Error s] otherwise *) -val parse_exn : input:input -> 'a t -> 'a +val parse_exn : input:input -> p:'a t -> 'a (** @raise ParseError if it fails *) -val parse_string : string -> 'a t -> 'a or_error +val parse_string : string -> p:'a t -> 'a or_error (** Specialization of {!parse} for string inputs *) -val parse_string_exn : string -> 'a t -> 'a +val parse_string_exn : string -> p:'a t -> 'a (** @raise ParseError if it fails *) -val parse_file : ?size:int -> file:string -> 'a t -> 'a or_error +val parse_file : ?size:int -> file:string -> p:'a t -> 'a or_error (** [parse_file ~file p] parses [file] with [p] by opening the file and using {!input_of_chan}. @param size size of chunks read from file @since 0.13 *) -val parse_file_exn : ?size:int -> file:string -> 'a t -> 'a +val parse_file_exn : ?size:int -> file:string -> p:'a t -> 'a (** Unsafe version of {!parse_file} @since 0.13 *) From d30e86f62862d22413323badda7ebaaa01c9253e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 21 Oct 2015 23:51:56 +0200 Subject: [PATCH 60/75] change the type `'a CCParse.t` with continuations - goal: avoid stack overflows (tailcalls!) - add stress test in comments and test --- src/string/CCParse.ml | 157 ++++++++++++++++++++++++----------------- src/string/CCParse.mli | 25 ++++++- 2 files changed, 115 insertions(+), 67 deletions(-) diff --git a/src/string/CCParse.ml b/src/string/CCParse.ml index 9b5578c9..b1398b9a 100644 --- a/src/string/CCParse.ml +++ b/src/string/CCParse.ml @@ -105,6 +105,23 @@ exception ParseError of line_num * col_num * (unit -> string) (parse_string "[abc , de, hello ,world ]" p); *) +(*$R + let test n = + let p = CCParse.(U.list ~sep:"," U.int) in + + let l = CCList.(1 -- n) in + let l_printed = + CCFormat.to_string (CCList.print ~sep:"," ~start:"[" ~stop:"]" CCInt.print) l in + + let l' = CCParse.parse_string_exn ~p l_printed 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 = @@ -179,59 +196,62 @@ let input_of_chan ?(size=1024) ic = sub=(fun j len -> assert (j + len <= !i); Bytes.sub_string !b j len); } -type 'a t = input -> 'a +type 'a t = input -> ok:('a -> unit) -> err:(exn -> unit) -> unit -let return x _ = x +let return : 'a -> 'a t = fun x _st ~ok ~err:_ -> ok x let pure = return -let (>|=) p f st = f (p st) -let (>>=) p f st = - let x = p st in - f x st -let (<*>) x y st = - let f = x st in - let g = y st in - f g -let (<* ) x y st = - let res = x st in - let _ = y st in - res -let ( *>) x y st = - let _ = x st in - let res = y st in - res +let (>|=) : 'a t -> ('a -> 'b) -> 'b t + = fun p f st ~ok ~err -> p st ~err ~ok:(fun x -> ok (f x)) +let (>>=) : 'a t -> ('a -> 'b t) -> 'b t + = fun p f st ~ok ~err -> p st ~err ~ok:(fun x -> f x st ~err ~ok) +let (<*>) : ('a -> 'b) t -> 'a t -> 'b t + = fun f x st ~ok ~err -> + f st ~err ~ok:(fun f' -> x st ~err ~ok:(fun x' -> ok (f' x'))) +let (<* ) : 'a t -> _ t -> 'a t + = fun x y st ~ok ~err -> + x st ~err ~ok:(fun res -> y st ~err ~ok:(fun _ -> ok res)) +let ( *>) : _ t -> 'a t -> 'a t + = fun x y st ~ok ~err -> + x st ~err ~ok:(fun _ -> y st ~err ~ok) let junk_ st = ignore (st.next ()) let pf = Printf.sprintf -let fail_ st msg = raise (ParseError (st.lnum(), st.cnum(), msg)) +let fail_ ~err st msg = err (ParseError (st.lnum(), st.cnum(), msg)) -let eoi st = if st.is_done() then () else fail_ st (const_ "expected EOI") -let fail msg st = fail_ st (const_ msg) -let nop _ = () +let eoi st ~ok ~err = + if st.is_done() + then ok () + else fail_ ~err st (const_ "expected EOI") + +let fail msg st ~ok:_ ~err = fail_ ~err st (const_ msg) +let nop _ ~ok ~err:_ = ok() let char c = let msg = pf "expected '%c'" c in - fun st -> if st.next () = c then c else fail_ st (const_ msg) + fun st ~ok ~err -> if st.next () = c then ok c else fail_ ~err st (const_ msg) -let char_if p st = +let char_if p st ~ok ~err = let c = st.next () in - if p c then c else fail_ st (fun () -> pf "unexpected char '%c'" c) + if p c then ok c else fail_ ~err st (fun () -> pf "unexpected char '%c'" c) -let chars_if p st = +let chars_if p st ~ok ~err:_ = let i = st.pos () in let len = ref 0 in while not (st.is_done ()) && p (st.cur ()) do junk_ st; incr len done; - st.sub i !len + ok (st.sub i !len) -let chars1_if p st = - let s = chars_if p st in - if s = "" then fail_ st (const_ "unexpected sequence of chars"); - s +let chars1_if p st ~ok ~err = + chars_if p st ~err + ~ok:(fun s -> + if s = "" then fail_ ~err st (const_ "unexpected sequence of chars"); + ok s + ) -let rec skip_chars p st = +let rec skip_chars p st ~ok ~err = if not (st.is_done ()) && p (st.cur ()) then ( junk_ st; - skip_chars p st - ) + skip_chars p st ~ok ~err + ) else ok() let is_alpha = function | 'a' .. 'z' | 'A' .. 'Z' -> true @@ -255,48 +275,50 @@ let skip_white = skip_chars is_white (* XXX: combine errors? *) -let (<|>) x y st = - let i = st.pos () in - try - x st - with ParseError _ -> - st.backtrack i; (* restore pos *) - y st +let (<|>) : 'a t -> 'a t -> 'a t + = fun x y st ~ok ~err -> + let i = st.pos () in + x st ~ok + ~err:(fun _ -> + st.backtrack i; (* restore pos *) + y st ~ok ~err + ) -let string s st = +let string s st ~ok ~err = let rec check i = i = String.length s || (s.[i] = st.next () && check (i+1)) in - if check 0 then s else fail_ st (fun () -> pf "expected \"%s\"" s) + if check 0 then ok s else fail_ ~err st (fun () -> pf "expected \"%s\"" s) -let rec many_rec p st acc = - if st.is_done () then List.rev acc +let rec many_rec : 'a t -> 'a list -> 'a list t = fun p acc st ~ok ~err -> + if st.is_done () then ok(List.rev acc) else let i = st.pos () in - try - let x = p st in - many_rec p st (x :: acc) - with ParseError _ -> - st.backtrack i; - List.rev acc + p st ~err + ~ok:(fun x -> + many_rec p (x :: acc) st ~ok + ~err:(fun _ -> + st.backtrack i; + ok(List.rev acc) + ) + ) -let many p st = many_rec p st [] +let many : 'a t -> 'a list t + = fun p st ~ok ~err -> many_rec p [] st ~ok ~err -let many1 p st = - let x = p st in - many_rec p st [x] +let many1 : 'a t -> 'a list t = + fun p st ~ok ~err -> + p st ~err ~ok:(fun x -> many_rec p [x] st ~err ~ok) -let rec skip p st = +let rec skip p st ~ok ~err = let i = st.pos () in - let matched = - try - let _ = p st in - true - with ParseError _ -> - false - in - if matched then skip p st else st.backtrack i + p st + ~ok:(fun _ -> skip p st ~ok ~err) + ~err:(fun _ -> + st.backtrack i; + ok() + ) let rec sep1 ~by p = p >>= fun x -> @@ -357,7 +379,12 @@ let fix_memo f = in p -let parse_exn ~input ~p = p input +let parse_exn ~input ~p = + let res = ref None in + p input ~ok:(fun x -> res := Some x) ~err:(fun e -> raise e); + match !res with + | None -> failwith "no input returned by parser" + | Some x -> x let parse ~input ~p = try `Ok (parse_exn ~input ~p) diff --git a/src/string/CCParse.mli b/src/string/CCParse.mli index e55a4a6c..5b7caee7 100644 --- a/src/string/CCParse.mli +++ b/src/string/CCParse.mli @@ -61,6 +61,21 @@ let p = U.list ~sep:"," U.word;; parse_string_exn "[abc , de, hello ,world ]" p;; ]} +{6 Stress Test} +This makes a list of 100_000 integers, prints it and parses it back. + +{[ +let p = CCParse.(U.list ~sep:"," U.int);; + +let l = CCList.(1 -- 100_000);; +let l_printed = + CCFormat.to_string (CCList.print ~sep:"," ~start:"[" ~stop:"]" CCInt.print) l;; + +let l' = CCParse.parse_string_exn ~p l_printed;; + +assert (l=l');; +]} + @since 0.11 *) @@ -111,8 +126,14 @@ val input_of_chan : ?size:int -> in_channel -> input (** {2 Combinators} *) -type 'a t = input -> 'a -(** @raise ParseError in case of failure *) +type 'a t = input -> ok:('a -> unit) -> err:(exn -> unit) -> unit +(** Takes the input and two continuations: + {ul + {- [ok] to call with the result when it's done} + {- [err] to call when the parser met an error} + } + The type definition changed since NEXT_RELEASE to avoid stack overflows + @raise ParseError in case of failure *) val return : 'a -> 'a t (** Always succeeds, without consuming its input *) From 4138acc1666e0a992107bedffb2456f977c59c85 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 22 Oct 2015 00:14:41 +0200 Subject: [PATCH 61/75] fix `CCParse.memo` so it uses the new continuations --- src/string/CCParse.ml | 55 ++++++++++++++++++++++++++++-------------- src/string/CCParse.mli | 12 +++++++++ 2 files changed, 49 insertions(+), 18 deletions(-) diff --git a/src/string/CCParse.ml b/src/string/CCParse.ml index b1398b9a..680d82cf 100644 --- a/src/string/CCParse.ml +++ b/src/string/CCParse.ml @@ -85,13 +85,13 @@ exception ParseError of line_num * col_num * (unit -> string) (*$= & ~printer:errpptree (`Ok (N (L 1, N (L 2, L 3)))) \ - (parse_string "(1 (2 3))" ptree) + (parse_string ~p:ptree "(1 (2 3))" ) (`Ok (N (N (L 1, L 2), N (L 3, N (L 4, L 5))))) \ - (parse_string "((1 2) (3 (4 5)))" ptree) + (parse_string ~p:ptree "((1 2) (3 (4 5)))" ) (`Ok (N (L 1, N (L 2, L 3)))) \ - (parse_string "(1 (2 3))" ptree' ) + (parse_string ~p:ptree' "(1 (2 3))" ) (`Ok (N (N (L 1, L 2), N (L 3, N (L 4, L 5))))) \ - (parse_string "((1 2) (3 (4 5)))" ptree' ) + (parse_string ~p:ptree' "((1 2) (3 (4 5)))" ) *) (*$R @@ -102,7 +102,7 @@ exception ParseError of line_num * col_num * (unit -> string) in assert_equal ~printer (`Ok ["abc"; "de"; "hello"; "world"]) - (parse_string "[abc , de, hello ,world ]" p); + (parse_string ~p "[abc , de, hello ,world ]"); *) (*$R @@ -342,14 +342,14 @@ module MemoTbl = struct end let fix f = - let rec p st = f p st in + let rec p st ~ok ~err = f p st ~ok ~err in p -let memo p = +let memo (type a) (p:a t):a t = let id = !MemoTbl.id_ in incr MemoTbl.id_; let r = ref None in (* used for universal encoding *) - fun input -> + fun input ~ok ~err -> let i = input.pos () in let (lazy tbl) = input.memo in try @@ -359,23 +359,25 @@ let memo p = f (); begin match !r with | None -> assert false - | Some (MemoTbl.Ok x) -> x - | Some (MemoTbl.Fail e) -> raise e + | Some (MemoTbl.Ok x) -> ok x + | Some (MemoTbl.Fail e) -> err e end with Not_found -> (* parse, and save *) - try - let x = p input in - H.replace tbl (i,id) (fun () -> r := Some (MemoTbl.Ok x)); - x - with (ParseError _) as e -> - H.replace tbl (i,id) (fun () -> r := Some (MemoTbl.Fail e)); - raise e + p input + ~err:(fun e -> + H.replace tbl (i,id) (fun () -> r := Some (MemoTbl.Fail e)); + err e + ) + ~ok:(fun x -> + H.replace tbl (i,id) (fun () -> r := Some (MemoTbl.Ok x)); + ok x + ) let fix_memo f = let rec p = let p' = lazy (memo p) in - fun st -> f (Lazy.force p') st + fun st ~ok ~err -> f (Lazy.force p') st ~ok ~err in p @@ -436,4 +438,21 @@ module U = struct let word = map2 prepend_str (char_if is_alpha) (chars_if is_alpha_num) + + let pair ?(start="(") ?(stop=")") ?(sep=",") p1 p2 = + string start *> skip_white *> + p1 >>= fun x1 -> + skip_white *> string sep *> skip_white *> + p2 >>= fun x2 -> + string stop *> return (x1,x2) + + let triple ?(start="(") ?(stop=")") ?(sep=",") p1 p2 p3 = + string start *> skip_white *> + p1 >>= fun x1 -> + skip_white *> string sep *> skip_white *> + p2 >>= fun x2 -> + skip_white *> string sep *> skip_white *> + p3 >>= fun x3 -> + string stop *> return (x1,x2,x3) + end diff --git a/src/string/CCParse.mli b/src/string/CCParse.mli index 5b7caee7..6b30148f 100644 --- a/src/string/CCParse.mli +++ b/src/string/CCParse.mli @@ -307,4 +307,16 @@ module U : sig val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t val map3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t + + val pair : ?start:string -> ?stop:string -> ?sep:string -> + 'a t -> 'b t -> ('a * 'b) t + (** Parse a pair using OCaml whitespace conventions. + The default is "(a, b)". + @since NEXT_RELEASE *) + + val triple : ?start:string -> ?stop:string -> ?sep:string -> + 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t + (** Parse a triple using OCaml whitespace conventions. + The default is "(a, b, c)". + @since NEXT_RELEASE *) end From e1e51470f133467c6b8ab6cb88a81ba695d4fa7f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 22 Oct 2015 22:43:00 +0200 Subject: [PATCH 62/75] add `CCHashtbl.add` mimicking the stdlib `Hashtbl.add` --- src/data/CCPersistentHashtbl.ml | 45 ++++++++++++++++++++++++++++++++ src/data/CCPersistentHashtbl.mli | 6 +++++ 2 files changed, 51 insertions(+) diff --git a/src/data/CCPersistentHashtbl.ml b/src/data/CCPersistentHashtbl.ml index a0dbbf20..54428bed 100644 --- a/src/data/CCPersistentHashtbl.ml +++ b/src/data/CCPersistentHashtbl.ml @@ -67,6 +67,12 @@ module type S = sig val length : _ t -> int (** Number of bindings *) + val add : 'a t -> key -> 'a -> 'a t + (** Add the binding to the table, returning a new table. The old binding + for this key, if it exists, is shadowed and will be restored upon + [remove tbl k]. + @since NEXT_RELEASE *) + val replace : 'a t -> key -> 'a -> 'a t (** Add the binding to the table, returning a new table. This erases the current binding for [key], if any. *) @@ -367,6 +373,45 @@ module Make(H : HashedType) : S with type key = H.t = struct t' ) + let add t k v = + let a = reroot_ t in + let h = H.hash k in + let i = find_idx_ ~h a in + if t.length > (Array.length a) lsl 1 + then ( + (* resize *) + let new_size = min (2 * (Array.length a)) Sys.max_array_length in + let a = resize_ k v h a new_size in + {length=t.length+1; arr=Arr a} + ) else ( + (* prepend *) + let old = a.(i) in + a.(i) <- Cons (k, v, old); + let t' = {length=t.length + 1; arr=Arr a} in + t.arr <- Set (i,old,t'); + t' + ) + + (*$R + let h = H.of_seq my_seq in + OUnit.assert_equal "a" (H.find h 1); + OUnit.assert_raises Not_found (fun () -> H.find h 5); + let h1 = H.add h 5 "e" in + OUnit.assert_equal "a" (H.find h1 1); + OUnit.assert_equal "e" (H.find h1 5); + OUnit.assert_equal "a" (H.find h 1); + let h2 = H.add h1 5 "ee" in + OUnit.assert_equal "ee" (H.find h2 5); + OUnit.assert_raises Not_found (fun () -> H.find h 5); + let h3 = H.remove h2 1 in + OUnit.assert_equal "ee" (H.find h3 5); + OUnit.assert_raises Not_found (fun () -> H.find h3 1); + let h4 = H.remove h3 5 in + OUnit.assert_equal "e" (H.find h4 5); + OUnit.assert_equal "ee" (H.find h3 5); + *) + + (* return [Some l'] if [l] changed into [l'] by removing [k] *) let rec remove_rec_ k l = match l with | Nil -> None diff --git a/src/data/CCPersistentHashtbl.mli b/src/data/CCPersistentHashtbl.mli index 8651f34c..712e62ed 100644 --- a/src/data/CCPersistentHashtbl.mli +++ b/src/data/CCPersistentHashtbl.mli @@ -74,6 +74,12 @@ module type S = sig val length : _ t -> int (** Number of bindings *) + val add : 'a t -> key -> 'a -> 'a t + (** Add the binding to the table, returning a new table. The old binding + for this key, if it exists, is shadowed and will be restored upon + [remove tbl k]. + @since NEXT_RELEASE *) + val replace : 'a t -> key -> 'a -> 'a t (** Add the binding to the table, returning a new table. This erases the current binding for [key], if any. *) From 89f30e2891a062f33b2355c701c5565bf529e726 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 23 Oct 2015 16:30:22 +0200 Subject: [PATCH 63/75] fix bench --- benchs/run_benchs.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index ad756618..af191949 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -989,4 +989,5 @@ module Thread = struct end let () = - B.Tree.run_global () + try B.Tree.run_global () + with Arg.Help msg -> print_endline msg From 7105221ff085609df64f17f72ae2b7a0c47de67b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 23 Oct 2015 18:38:29 +0200 Subject: [PATCH 64/75] add a test in `CCGraph` --- src/data/CCGraph.ml | 6 ++++++ src/data/CCGraph.mli | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/src/data/CCGraph.ml b/src/data/CCGraph.ml index 72781d08..7b323a2e 100644 --- a/src/data/CCGraph.ml +++ b/src/data/CCGraph.ml @@ -339,6 +339,12 @@ let topo_sort ?eq ?rev ?(tbl=mk_table 128) ~graph seq = let idx_j = CCList.find_idx ((=)j) l |> CCOpt.get_exn |> fst in \ idx_i < idx_j) \ [ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3] + let l = topo_sort ~rev:true ~graph:divisors_graph (Seq.return 42) in \ + List.for_all (fun (i,j) -> \ + let idx_i = CCList.find_idx ((=)i) l |> CCOpt.get_exn |> fst in \ + let idx_j = CCList.find_idx ((=)j) l |> CCOpt.get_exn |> fst in \ + idx_i > idx_j) \ + [ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3] *) (** {2 Lazy Spanning Tree} *) diff --git a/src/data/CCGraph.mli b/src/data/CCGraph.mli index e7f75193..340b312c 100644 --- a/src/data/CCGraph.mli +++ b/src/data/CCGraph.mli @@ -235,7 +235,7 @@ val topo_sort_tag : ?eq:('v -> 'v -> bool) -> graph:('v, 'e) t -> 'v sequence -> 'v list -(** Same as {!topo_sort} *) +(** Same as {!topo_sort} but uses an explicit tag set *) (** {2 Lazy Spanning Tree} *) From f7a7ce19b30df1db6d9c3866c1515c600666025d Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 23 Oct 2015 23:47:07 +0200 Subject: [PATCH 65/75] add `CCArray.sort_generic` for sorting over array-like structures in place --- src/core/CCArray.ml | 139 +++++++++++++++++++++++++++++++++++++++++++ src/core/CCArray.mli | 20 +++++++ 2 files changed, 159 insertions(+) diff --git a/src/core/CCArray.ml b/src/core/CCArray.ml index 09d3938e..66d8d1dd 100644 --- a/src/core/CCArray.ml +++ b/src/core/CCArray.ml @@ -641,3 +641,142 @@ module Sub = struct let to_klist a = _to_klist a.arr a.i a.j end + +(** {2 Generic Functions} *) + +module type MONO_ARRAY = sig + type elt + type t + + val length : t -> int + + val get : t -> int -> elt + + val set : t -> int -> elt -> unit +end + +(* Dual Pivot Quicksort (YaroslavSkiy) + from "average case analysis of Java 7's Dual Pivot Quicksort" *) +module SortGeneric(A : MONO_ARRAY) = struct + module Rand = Random.State + + let seed_ = [|123456|] + + type state = { + rand: Rand.t; (* random state *) + cmp: A.elt -> A.elt -> int; + mutable l: int; (* left pointer *) + mutable g: int; (* right pointer *) + mutable k: int; + } + + let swap_ a i j = + if i=j then () + else ( + let tmp = A.get a i in + A.set a i (A.get a j); + A.set a j tmp + ) + + let rec insert_ ~cmp a i k = + if k 0 then ( + swap_ a k (k+1); + insert_ ~cmp a i (k-1) + ) + + (* recursive part of insertion sort *) + let rec sort_insertion_rec ~cmp a i j k = + if k 1 then sort_insertion_rec ~cmp a i j (i+1) + + let rand_idx_ ~st i j = + i + Rand.int st.rand (j-i) + + (* sort slice. + There is a chance that the two pivots are equal, but it's unlikely. *) + let rec sort_slice_ ~st a i j = + if j-i>16 then ( + st.l <- i; + st.g <- j-1; + st.k <- i; + (* choose pivots *) + let p = A.get a (rand_idx_ ~st i j) in + let q = A.get a (rand_idx_ ~st i j) in + (* invariant: st.p <= st.q, swap them otherwise *) + let p, q = if st.cmp p q > 0 then q, p else p, q in + while st.k <= st.g do + let cur = A.get a st.k in + if st.cmp cur p < 0 then ( + (* insert in leftmost band *) + if st.k <> st.l then swap_ a st.k st.l; + st.l <- st.l + 1 + ) else if st.cmp cur q > 0 then ( + (* insert in rightmost band *) + while st.k < st.g && st.cmp (A.get a st.g) q > 0 do + st.g <- st.g - 1 + done; + swap_ a st.k st.g; + st.g <- st.g - 1; + (* the element swapped from the right might be in the first situation. + that is, < p (we know it's <= q already) *) + if st.cmp (A.get a st.k) p < 0 then ( + if st.k <> st.l then swap_ a st.k st.l; + st.l <- st.l + 1 + ) + ); + st.k <- st.k + 1 + done; + (* save values before recursing *) + let l = st.l and g = st.g and sort_middle = st.cmp p q < 0 in + sort_slice_ ~st a i l; + if sort_middle then sort_slice_ ~st a l (g+1); + sort_slice_ ~st a (g+1) j; + ) else sort_insertion ~cmp:st.cmp a i j + + let sort ~cmp a = + if A.length a > 0 then ( + let st = { + rand=Rand.make seed_; cmp; + l=0; g=A.length a; k=0; + } in + sort_slice_ ~st a 0 (A.length a) + ) +end + + +let sort_generic (type arr)(type elt) +(module A : MONO_ARRAY with type t = arr and type elt = elt) +?(cmp=Pervasives.compare) a += + let module S = SortGeneric(A) in + S.sort ~cmp a + +(*$inject + module IA = struct + type elt = int + type t = int array + include Array + end + + let gen_arr = Q.Gen.(array_size (1--100) small_int) + let arr_arbitrary = Q.make + ~print:Q.Print.(array int) + ~small:Array.length + ~shrink:Q.Shrink.(array ?shrink:None) + gen_arr +*) + +(*$Q & ~count:300 + arr_arbitrary (fun a -> \ + let a1 = Array.copy a and a2 = Array.copy a in \ + Array.sort CCInt.compare a1; sort_generic ~cmp:CCInt.compare (module IA) a2; \ + a1 = a2 ) +*) + diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index 2b1256c4..10da7de4 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -232,3 +232,23 @@ module Sub : sig include S with type 'a t := 'a t end +(** {2 Generic Functions} *) + +module type MONO_ARRAY = sig + type elt + type t + + val length : t -> int + + val get : t -> int -> elt + + val set : t -> int -> elt -> unit +end + +val sort_generic : + (module MONO_ARRAY with type t = 'arr and type elt = 'elt) -> + ?cmp:('elt -> 'elt -> int) -> 'arr -> unit +(** Sort the array, without allocating (eats stack space though). Performance + might be lower than {!Array.sort}. + @since NEXT_RELEASE *) + From 3b1922671e9113677fcc4a565abcea40a7c70c4c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 23 Oct 2015 23:48:10 +0200 Subject: [PATCH 66/75] add benchmark for sorting fucntion --- benchs/run_benchs.ml | 46 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 45 insertions(+), 1 deletion(-) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index af191949..17bcc401 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -26,7 +26,7 @@ module L = struct let map_naive () = ignore (try List.map f_ l with Stack_overflow -> []) and map_tailrec () = ignore (List.rev (List.rev_map f_ l)) and ccmap () = ignore (CCList.map f_ l) - and ralmap () = ignore (CCRAL.map f_ ral) + and ralmap () = ignore (CCRAL.map ~f:f_ ral) in B.throughputN time ~repeat [ "List.map", map_naive, () @@ -116,6 +116,50 @@ module L = struct ) end +module Arr = struct + let rand = Random.State.make [| 1;2;3;4 |] + + let mk_arr n = + Array.init n (fun _ -> Random.State.int rand 5_000) + + module IntArr = struct + type elt=int + type t = int array + let get = Array.get + let set = Array.set + let length = Array.length + end + + let sort_ccarray a = + CCArray.sort_generic (module IntArr) ~cmp:CCInt.compare a + + let sort_std a = Array.sort CCInt.compare a + + (* helper, to apply a sort function over a list of arrays *) + let app_list sort l = + List.iter + (fun a -> + let a = Array.copy a in + sort a + ) l + + let bench_sort ?(time=2) n = + let a1 = mk_arr n in + let a2 = mk_arr n in + let a3 = mk_arr n in + B.throughputN time ~repeat + [ "std", app_list sort_std, [a1;a2;a3] + ; "ccarray.sort_gen", app_list sort_ccarray, [a1;a2;a3] + ] + + let () = + B.Tree.register ("array" @>>> + [ "sort" @>> + app_ints (bench_sort ?time:None) [100; 1000; 10_000; 50_000; 100_000; 500_000] + ] + ) +end + module Vec = struct let f x = x+1 From 2608fc90bbf6f4bb1b96e8c652f69ced64012fd9 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 24 Oct 2015 00:13:02 +0200 Subject: [PATCH 67/75] tune `CCarray.sort_generic` --- src/core/CCArray.ml | 129 +++++++++++++++++++++----------------------- 1 file changed, 62 insertions(+), 67 deletions(-) diff --git a/src/core/CCArray.ml b/src/core/CCArray.ml index 66d8d1dd..17b351d5 100644 --- a/src/core/CCArray.ml +++ b/src/core/CCArray.ml @@ -663,13 +663,13 @@ module SortGeneric(A : MONO_ARRAY) = struct let seed_ = [|123456|] type state = { - rand: Rand.t; (* random state *) - cmp: A.elt -> A.elt -> int; mutable l: int; (* left pointer *) mutable g: int; (* right pointer *) mutable k: int; } + let rand_idx_ rand i j = i + Rand.int rand (j-i) + let swap_ a i j = if i=j then () else ( @@ -678,74 +678,69 @@ module SortGeneric(A : MONO_ARRAY) = struct A.set a j tmp ) - let rec insert_ ~cmp a i k = - if k 0 then ( - swap_ a k (k+1); - insert_ ~cmp a i (k-1) - ) - - (* recursive part of insertion sort *) - let rec sort_insertion_rec ~cmp a i j k = - if k 1 then sort_insertion_rec ~cmp a i j (i+1) - - let rand_idx_ ~st i j = - i + Rand.int st.rand (j-i) - - (* sort slice. - There is a chance that the two pivots are equal, but it's unlikely. *) - let rec sort_slice_ ~st a i j = - if j-i>16 then ( - st.l <- i; - st.g <- j-1; - st.k <- i; - (* choose pivots *) - let p = A.get a (rand_idx_ ~st i j) in - let q = A.get a (rand_idx_ ~st i j) in - (* invariant: st.p <= st.q, swap them otherwise *) - let p, q = if st.cmp p q > 0 then q, p else p, q in - while st.k <= st.g do - let cur = A.get a st.k in - if st.cmp cur p < 0 then ( - (* insert in leftmost band *) - if st.k <> st.l then swap_ a st.k st.l; - st.l <- st.l + 1 - ) else if st.cmp cur q > 0 then ( - (* insert in rightmost band *) - while st.k < st.g && st.cmp (A.get a st.g) q > 0 do - st.g <- st.g - 1 - done; - swap_ a st.k st.g; - st.g <- st.g - 1; - (* the element swapped from the right might be in the first situation. - that is, < p (we know it's <= q already) *) - if st.cmp (A.get a st.k) p < 0 then ( + let sort ~cmp a = + let rec insert_ a i k = + if k 0 then ( + swap_ a k (k+1); + insert_ a i (k-1) + ) + in + (* recursive part of insertion sort *) + let rec sort_insertion_rec a i j k = + if k 1 then sort_insertion_rec a i j (i+1) + in + let rand = Rand.make seed_ in + (* sort slice. + There is a chance that the two pivots are equal, but it's unlikely. *) + let rec sort_slice_ ~st a i j = + if j-i>10 then ( + st.l <- i; + st.g <- j-1; + st.k <- i; + (* choose pivots *) + let p = A.get a (rand_idx_ rand i j) in + let q = A.get a (rand_idx_ rand i j) in + (* invariant: st.p <= st.q, swap them otherwise *) + let p, q = if cmp p q > 0 then q, p else p, q in + while st.k <= st.g do + let cur = A.get a st.k in + if cmp cur p < 0 then ( + (* insert in leftmost band *) if st.k <> st.l then swap_ a st.k st.l; st.l <- st.l + 1 - ) - ); - st.k <- st.k + 1 - done; - (* save values before recursing *) - let l = st.l and g = st.g and sort_middle = st.cmp p q < 0 in - sort_slice_ ~st a i l; - if sort_middle then sort_slice_ ~st a l (g+1); - sort_slice_ ~st a (g+1) j; - ) else sort_insertion ~cmp:st.cmp a i j - - let sort ~cmp a = + ) else if cmp cur q > 0 then ( + (* insert in rightmost band *) + while st.k < st.g && cmp (A.get a st.g) q > 0 do + st.g <- st.g - 1 + done; + swap_ a st.k st.g; + st.g <- st.g - 1; + (* the element swapped from the right might be in the first situation. + that is, < p (we know it's <= q already) *) + if cmp (A.get a st.k) p < 0 then ( + if st.k <> st.l then swap_ a st.k st.l; + st.l <- st.l + 1 + ) + ); + st.k <- st.k + 1 + done; + (* save values before recursing *) + let l = st.l and g = st.g and sort_middle = cmp p q < 0 in + sort_slice_ ~st a i l; + if sort_middle then sort_slice_ ~st a l (g+1); + sort_slice_ ~st a (g+1) j; + ) else sort_insertion a i j + in if A.length a > 0 then ( - let st = { - rand=Rand.make seed_; cmp; - l=0; g=A.length a; k=0; - } in + let st = { l=0; g=A.length a; k=0; } in sort_slice_ ~st a 0 (A.length a) ) end From 7a6ac1369fd991a8913d9b9cb86ca7627b382fbe Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 25 Oct 2015 22:52:50 +0100 Subject: [PATCH 68/75] readme --- README.adoc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.adoc b/README.adoc index f2a79adc..8689a4a3 100644 --- a/README.adoc +++ b/README.adoc @@ -37,7 +37,7 @@ What is _containers_? Some of the modules have been moved to their own repository (e.g. `sequence`, `gen`, `qcheck`) and are on opam for great fun and profit. -image:http://ci.cedeela.fr/buildStatus/icon?job=containers[alt="Build Status", link="http://ci.cedeela.fr/job/containers/"] +image:https://ci.cedeela.fr/buildStatus/icon?job=containers[alt="Build Status", link="http://ci.cedeela.fr/job/containers/"] toc::[] From 437852d18e0643206e21bcdc49af9373c0fd425f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 26 Oct 2015 09:52:01 +0100 Subject: [PATCH 69/75] add `CCFormat.{ksprintf,string_quoted}` --- src/core/CCFormat.ml | 9 +++++++++ src/core/CCFormat.mli | 19 ++++++++++++++++++- 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 419569ce..c294d91a 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -46,6 +46,7 @@ let char = Format.pp_print_char let int32 fmt n = Format.fprintf fmt "%ld" n let int64 fmt n = Format.fprintf fmt "%Ld" n let nativeint fmt n = Format.fprintf fmt "%nd" n +let string_quoted fmt s = Format.fprintf fmt "\"%s\"" s let list ?(start="[") ?(stop="]") ?(sep=", ") pp fmt l = let rec pp_list l = match l with @@ -132,6 +133,14 @@ let sprintf format = let fprintf = Format.fprintf + +let ksprintf ~f fmt = + let buf = Buffer.create 32 in + let out = Format.formatter_of_buffer buf in + Format.kfprintf + (fun _ -> Format.pp_print_flush out (); f (Buffer.contents buf)) + out fmt + let stdout = Format.std_formatter let stderr = Format.err_formatter diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index a53185e8..3e836ad8 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -49,6 +49,9 @@ val int32 : int32 printer (** @since NEXT_RELEASE *) val int64 : int64 printer (** @since NEXT_RELEASE *) val nativeint : nativeint printer (** @since NEXT_RELEASE *) +val string_quoted : string printer +(** Similar to {!CCString.print}. + @since NEXT_RELEASE *) val list : ?start:string -> ?stop:string -> ?sep:string -> 'a printer -> 'a list printer val array : ?start:string -> ?stop:string -> ?sep:string -> 'a printer -> 'a array printer @@ -73,11 +76,25 @@ val stdout : t val stderr : t val sprintf : ('a, t, unit, string) format4 -> 'a -(** print into a string *) +(** Print into a string any format string that would usually be compatible + with {!fprintf}. Similar to {!Format.asprintf}. *) val fprintf : t -> ('a, t, unit ) format -> 'a (** Alias to {!Format.fprintf} @since NEXT_RELEASE *) +val ksprintf : + f:(string -> 'b) -> + ('a, Format.formatter, unit, 'b) format4 -> + 'a +(** [ksprintf fmt ~f] formats using [fmt], in a way similar to {!sprintf}, + and then calls [f] on the resulting string. + @since NEXT_RELEASE *) + +(*$= & ~printer:CCFormat.(to_string (opt string)) + (Some "hello world") \ + (ksprintf "hello %a" CCFormat.string "world" ~f:(fun s -> Some s)) +*) + val to_file : string -> ('a, t, unit, unit) format4 -> 'a (** Print to the given file *) From 80f36d20eb34e225bd8fc0536293e53aa0cd40cf Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 26 Oct 2015 10:01:34 +0100 Subject: [PATCH 70/75] doc; test --- src/core/CCString.mli | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index a05cf845..393010e4 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -66,6 +66,7 @@ module type S = sig val pp : Buffer.t -> t -> unit val print : Format.formatter -> t -> unit + (** Print the string within quotes *) end (** {2 Strings} *) @@ -380,4 +381,9 @@ module Sub : sig Sub.make "abcde" 1 3 |> Sub.copy = "bcd" Sub.full "abcde" |> Sub.copy = "abcde" *) + + (*$T + let sub = Sub.make " abc " 1 ~len:3 in \ + "\"abc\"" = (CCFormat.to_string Sub.print sub) + *) end From 5a2c7f3f603a90bb195486d87bc9a986be525763 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 26 Oct 2015 17:21:01 +0100 Subject: [PATCH 71/75] fix small uglyness in `Map.print` --- src/core/CCMap.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/core/CCMap.ml b/src/core/CCMap.ml index 0ae3cb3f..6b63e834 100644 --- a/src/core/CCMap.ml +++ b/src/core/CCMap.ml @@ -105,11 +105,13 @@ module Make(O : Map.OrderedType) = struct let first = ref true in iter (fun k v -> - if !first then first := false else Format.pp_print_string fmt sep; + if !first then first := false else ( + Format.pp_print_string fmt sep; + Format.pp_print_cut fmt () + ); pp_k fmt k; Format.pp_print_string fmt arrow; pp_v fmt v; - Format.pp_print_cut fmt () ) m; Format.pp_print_string fmt stop end From 59835f8ef2e492fd59b6e4675b583ccd15830c59 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 26 Oct 2015 17:22:56 +0100 Subject: [PATCH 72/75] fix the same uglyness in `Set.print` --- src/core/CCSet.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/core/CCSet.ml b/src/core/CCSet.ml index 5abed74a..f62a96e0 100644 --- a/src/core/CCSet.ml +++ b/src/core/CCSet.ml @@ -77,9 +77,11 @@ module Make(O : Map.OrderedType) = struct let first = ref true in iter (fun x -> - if !first then first := false else Format.pp_print_string fmt sep; + if !first then first := false else ( + Format.pp_print_string fmt sep; + Format.pp_print_cut fmt () + ); pp_x fmt x; - Format.pp_print_cut fmt () ) m; Format.pp_print_string fmt stop end From 431c3a1e535f0c36acaafcaa2c2b4fe454365610 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 28 Oct 2015 15:39:01 +0100 Subject: [PATCH 73/75] add `CCSet.add_{list,seq}` --- src/core/CCSet.ml | 18 ++++++++++++++---- src/core/CCSet.mli | 6 ++++++ 2 files changed, 20 insertions(+), 4 deletions(-) diff --git a/src/core/CCSet.ml b/src/core/CCSet.ml index f62a96e0..0603ee73 100644 --- a/src/core/CCSet.ml +++ b/src/core/CCSet.ml @@ -35,10 +35,16 @@ module type S = sig val of_seq : elt sequence -> t + val add_seq : t -> elt sequence -> t + (** @since NEXT_RELEASE *) + val to_seq : t -> elt sequence val of_list : elt list -> t + val add_list : t -> elt list -> t + (** @since NEXT_RELEASE *) + val to_list : t -> elt list val pp : ?start:string -> ?stop:string -> ?sep:string -> @@ -51,14 +57,18 @@ end module Make(O : Map.OrderedType) = struct include Set.Make(O) - let of_seq s = - let set = ref empty in - s (fun x -> set := add x !set); + let add_seq set seq = + let set = ref set in + seq (fun x -> set := add x !set); !set + let of_seq s = add_seq empty s + let to_seq s yield = iter yield s - let of_list l = List.fold_left (fun set x -> add x set) empty l + let add_list = List.fold_left (fun set x -> add x set) + + let of_list l = add_list empty l let to_list = elements diff --git a/src/core/CCSet.mli b/src/core/CCSet.mli index a9b1912a..3ea014f4 100644 --- a/src/core/CCSet.mli +++ b/src/core/CCSet.mli @@ -37,10 +37,16 @@ module type S = sig val of_seq : elt sequence -> t + val add_seq : t -> elt sequence -> t + (** @since NEXT_RELEASE *) + val to_seq : t -> elt sequence val of_list : elt list -> t + val add_list : t -> elt list -> t + (** @since NEXT_RELEASE *) + val to_list : t -> elt list val pp : ?start:string -> ?stop:string -> ?sep:string -> From 344844ff9f8ecafa815cd67effac6464d903f656 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 28 Oct 2015 15:41:06 +0100 Subject: [PATCH 74/75] add `CCMap.add_{list,seq}` --- src/core/CCMap.ml | 18 +++++++++++++----- src/core/CCMap.mli | 6 ++++++ 2 files changed, 19 insertions(+), 5 deletions(-) diff --git a/src/core/CCMap.ml b/src/core/CCMap.ml index 6b63e834..47a77cc4 100644 --- a/src/core/CCMap.ml +++ b/src/core/CCMap.ml @@ -44,10 +44,16 @@ module type S = sig val of_seq : (key * 'a) sequence -> 'a t + val add_seq : 'a t -> (key * 'a) sequence -> 'a t + (** @since NEXT_RELEASE *) + val to_seq : 'a t -> (key * 'a) sequence val of_list : (key * 'a) list -> 'a t + val add_list : 'a t -> (key * 'a) list -> 'a t + (** @since NEXT_RELEASE *) + val to_list : 'a t -> (key * 'a) list val pp : ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string -> @@ -73,17 +79,19 @@ module Make(O : Map.OrderedType) = struct | None -> remove k m | Some v' -> add k v' m - let of_seq s = - let m = ref empty in + let add_seq m s = + let m = ref m in s (fun (k,v) -> m := add k v !m); !m + let of_seq s = add_seq empty s + let to_seq m yield = iter (fun k v -> yield (k,v)) m - let of_list l = - List.fold_left - (fun m (k,v) -> add k v m) empty l + let add_list m l = List.fold_left (fun m (k,v) -> add k v m) m l + + let of_list l = add_list empty l let to_list m = fold (fun k v acc -> (k,v)::acc) m [] diff --git a/src/core/CCMap.mli b/src/core/CCMap.mli index 2ff1d310..cb7dceca 100644 --- a/src/core/CCMap.mli +++ b/src/core/CCMap.mli @@ -47,10 +47,16 @@ module type S = sig val of_seq : (key * 'a) sequence -> 'a t + val add_seq : 'a t -> (key * 'a) sequence -> 'a t + (** @since NEXT_RELEASE *) + val to_seq : 'a t -> (key * 'a) sequence val of_list : (key * 'a) list -> 'a t + val add_list : 'a t -> (key * 'a) list -> 'a t + (** @since NEXT_RELEASE *) + val to_list : 'a t -> (key * 'a) list val pp : ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string -> From 60aea817507699941c6ed870e7e2eaeda0fe4634 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 8 Nov 2015 13:04:09 +0100 Subject: [PATCH 75/75] prepare for 0.14 --- CHANGELOG.adoc | 55 ++++++++++++++++++++++++++++++++ _oasis | 2 +- src/core/CCArray.mli | 2 +- src/core/CCChar.ml | 2 +- src/core/CCChar.mli | 2 +- src/core/CCError.mli | 4 +-- src/core/CCFormat.mli | 14 ++++---- src/core/CCHashtbl.ml | 14 ++++---- src/core/CCHashtbl.mli | 18 +++++------ src/core/CCList.mli | 22 ++++++------- src/core/CCMap.ml | 4 +-- src/core/CCMap.mli | 4 +-- src/core/CCPrint.mli | 2 +- src/core/CCSet.ml | 4 +-- src/core/CCSet.mli | 4 +-- src/core/CCString.mli | 2 +- src/core/CCVector.mli | 22 ++++++------- src/core/containers.ml | 2 +- src/data/CCPersistentHashtbl.ml | 4 +-- src/data/CCPersistentHashtbl.mli | 4 +-- src/iter/CCKList.mli | 2 +- src/sexp/CCSexpM.mli | 4 +-- src/string/CCLevenshtein.ml | 12 +++---- src/string/CCLevenshtein.mli | 12 +++---- src/string/CCParse.mli | 8 ++--- 25 files changed, 140 insertions(+), 85 deletions(-) diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc index 8611b834..43e557f2 100644 --- a/CHANGELOG.adoc +++ b/CHANGELOG.adoc @@ -1,5 +1,60 @@ = Changelog +== 0.14 + +=== breaking changes + +- change the type `'a CCParse.t` with continuations +- add labels on `CCParse.parse_*` functions +- change semantics of `CCList.Zipper.is_empty` + +=== other changes + +- deprecate `CCVector.rev'`, renamed into `CCVector.rev_in_place` +- deprecate `CCVector.flat_map'`, renamed `flat_map_seq` + +- add `CCMap.add_{list,seq}` +- add `CCSet.add_{list,seq}` +- fix small uglyness in `Map.print` and `Set.print` +- add `CCFormat.{ksprintf,string_quoted}` +- add `CCArray.sort_generic` for sorting over array-like structures in place +- add `CCHashtbl.add` mimicking the stdlib `Hashtbl.add` +- add `CCString.replace` and tests +- add `CCPersistentHashtbl.stats` +- reimplementation of `CCPersistentHashtbl` +- add `make watch` target +- add `CCVector.rev_iter` +- add `CCVector.append_list` +- add `CCVector.ensure_with` +- add `CCVector.return` +- add `CCVector.find_map` +- add `CCVector.flat_map_list` +- add `Containers.Hashtbl` with most combinators of `CCHashtbl` +- many more functions in `CCList.Zipper` +- large update of `CCList.Zipper` +- add `CCHashtbl.update` +- improve `CCHashtbl.MakeCounter` +- add `CCList.fold_flat_map` +- add module `CCChar` +- add functions in `CCFormat` +- add `CCPrint.char` +- add `CCVector.to_seq_rev` +- doc and tests for `CCLevenshtein` +- expose blocking decoder in `CCSexpM` +- add `CCList.fold_map` +- add `CCError.guard_str_trace` +- add `CCError.of_exn_trace` +- add `CCKlist.memoize` for costly computations +- add `CCLevenshtein.Index.{of,to}_{gen,seq}` and `cardinal` + +- small bugfix in `CCSexpM.print` +- fix broken link to changelog (fix #51) +- fix doc generation for `containers.string` +- bugfix in `CCString.find` +- raise exception in `CCString.replace` if `sub=""` +- bugfix in hashtable printing +- bugfix in `CCKList.take`, it was slightly too eager + == 0.13 === Breaking changes diff --git a/_oasis b/_oasis index e3782bc7..d282f26f 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.4 Name: containers -Version: 0.13 +Version: 0.14 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 10da7de4..2a84b628 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -250,5 +250,5 @@ val sort_generic : ?cmp:('elt -> 'elt -> int) -> 'arr -> unit (** Sort the array, without allocating (eats stack space though). Performance might be lower than {!Array.sort}. - @since NEXT_RELEASE *) + @since 0.14 *) diff --git a/src/core/CCChar.ml b/src/core/CCChar.ml index 026c7fbb..8f4db0d6 100644 --- a/src/core/CCChar.ml +++ b/src/core/CCChar.ml @@ -2,7 +2,7 @@ (** {1 Utils around char} - @since NEXT_RELEASE *) + @since 0.14 *) type t = char diff --git a/src/core/CCChar.mli b/src/core/CCChar.mli index 14a8cb18..3f12e666 100644 --- a/src/core/CCChar.mli +++ b/src/core/CCChar.mli @@ -3,7 +3,7 @@ (** {1 Utils around char} - @since NEXT_RELEASE *) + @since 0.14 *) type t = char diff --git a/src/core/CCError.mli b/src/core/CCError.mli index 877e5874..b01af19f 100644 --- a/src/core/CCError.mli +++ b/src/core/CCError.mli @@ -56,7 +56,7 @@ val of_exn_trace : exn -> ('a, string) t Remember to call [Printexc.record_backtrace true] and compile with the debug flag for this to work. - @since NEXT_RELEASE *) + @since 0.14 *) val fail_printf : ('a, Buffer.t, unit, ('a,string) t) format4 -> 'a (** [fail_printf format] uses [format] to obtain an error message @@ -121,7 +121,7 @@ val guard_str : (unit -> 'a) -> ('a, string) t val guard_str_trace : (unit -> 'a) -> ('a, string) t (** Same as {!guard_str} but uses {!of_exn_trace} instead of {!of_exn} so that the stack trace is printed. - @since NEXT_RELEASE *) + @since 0.14 *) val wrap1 : ('a -> 'b) -> 'a -> ('b, exn) t (** Same as {!guard} but gives the function one argument. *) diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli index 3e836ad8..c27e0eb8 100644 --- a/src/core/CCFormat.mli +++ b/src/core/CCFormat.mli @@ -44,14 +44,14 @@ val bool : bool printer val float3 : float printer (* 3 digits after . *) val float : float printer -val char : char printer (** @since NEXT_RELEASE *) -val int32 : int32 printer (** @since NEXT_RELEASE *) -val int64 : int64 printer (** @since NEXT_RELEASE *) -val nativeint : nativeint printer (** @since NEXT_RELEASE *) +val char : char printer (** @since 0.14 *) +val int32 : int32 printer (** @since 0.14 *) +val int64 : int64 printer (** @since 0.14 *) +val nativeint : nativeint printer (** @since 0.14 *) val string_quoted : string printer (** Similar to {!CCString.print}. - @since NEXT_RELEASE *) + @since 0.14 *) val list : ?start:string -> ?stop:string -> ?sep:string -> 'a printer -> 'a list printer val array : ?start:string -> ?stop:string -> ?sep:string -> 'a printer -> 'a array printer @@ -81,7 +81,7 @@ val sprintf : ('a, t, unit, string) format4 -> 'a val fprintf : t -> ('a, t, unit ) format -> 'a (** Alias to {!Format.fprintf} - @since NEXT_RELEASE *) + @since 0.14 *) val ksprintf : f:(string -> 'b) -> @@ -89,7 +89,7 @@ val ksprintf : 'a (** [ksprintf fmt ~f] formats using [fmt], in a way similar to {!sprintf}, and then calls [f] on the resulting string. - @since NEXT_RELEASE *) + @since 0.14 *) (*$= & ~printer:CCFormat.(to_string (opt string)) (Some "hello world") \ diff --git a/src/core/CCHashtbl.ml b/src/core/CCHashtbl.ml index 65412453..58bf360d 100644 --- a/src/core/CCHashtbl.ml +++ b/src/core/CCHashtbl.ml @@ -146,7 +146,7 @@ module type S = sig returns [None] then [k] is removed/stays removed, if the call returns [Some v'] then the binding [k -> v'] is inserted using {!Hashtbl.replace} - @since NEXT_RELEASE *) + @since 0.14 *) val print : key printer -> 'a printer -> 'a t printer (** Printer for tables @@ -297,11 +297,11 @@ module type COUNTER = sig val decr : t -> elt -> unit (** Remove one occurrence of the element - @since NEXT_RELEASE *) + @since 0.14 *) val length : t -> int (** Number of distinct elements - @since NEXT_RELEASE *) + @since 0.14 *) val add_seq : t -> elt sequence -> unit (** Increment each element of the sequence *) @@ -311,18 +311,18 @@ module type COUNTER = sig val to_seq : t -> (elt * int) sequence (** [to_seq tbl] returns elements of [tbl] along with their multiplicity - @since NEXT_RELEASE *) + @since 0.14 *) val add_list : t -> (elt * int) list -> unit (** Similar to {!add_seq} - @since NEXT_RELEASE *) + @since 0.14 *) val of_list : (elt * int) list -> t (** Similar to {!of_seq} - @since NEXT_RELEASE *) + @since 0.14 *) val to_list : t -> (elt * int) list - (** @since NEXT_RELEASE *) + (** @since 0.14 *) end module MakeCounter(X : Hashtbl.HashedType) diff --git a/src/core/CCHashtbl.mli b/src/core/CCHashtbl.mli index aaa3cf2c..d4079c5a 100644 --- a/src/core/CCHashtbl.mli +++ b/src/core/CCHashtbl.mli @@ -74,7 +74,7 @@ val update : ('a, 'b) Hashtbl.t -> f:('a -> 'b option -> 'b option) -> k:'a -> u returns [None] then [k] is removed/stays removed, if the call returns [Some v'] then the binding [k -> v'] is inserted using {!Hashtbl.replace} - @since NEXT_RELEASE *) + @since 0.14 *) val print : 'a printer -> 'b printer -> ('a, 'b) Hashtbl.t printer (** Printer for table @@ -123,7 +123,7 @@ module type S = sig returns [None] then [k] is removed/stays removed, if the call returns [Some v'] then the binding [k -> v'] is inserted using {!Hashtbl.replace} - @since NEXT_RELEASE *) + @since 0.14 *) val print : key printer -> 'a printer -> 'a t printer (** Printer for tables @@ -194,11 +194,11 @@ module type COUNTER = sig val decr : t -> elt -> unit (** Remove one occurrence of the element - @since NEXT_RELEASE *) + @since 0.14 *) val length : t -> int (** Number of distinct elements - @since NEXT_RELEASE *) + @since 0.14 *) val add_seq : t -> elt sequence -> unit (** Increment each element of the sequence *) @@ -208,18 +208,18 @@ module type COUNTER = sig val to_seq : t -> (elt * int) sequence (** [to_seq tbl] returns elements of [tbl] along with their multiplicity - @since NEXT_RELEASE *) + @since 0.14 *) val add_list : t -> (elt * int) list -> unit (** Similar to {!add_seq} - @since NEXT_RELEASE *) + @since 0.14 *) val of_list : (elt * int) list -> t (** Similar to {!of_seq} - @since NEXT_RELEASE *) + @since 0.14 *) val to_list : t -> (elt * int) list - (** @since NEXT_RELEASE *) + (** @since 0.14 *) end module MakeCounter(X : Hashtbl.HashedType) @@ -227,4 +227,4 @@ module MakeCounter(X : Hashtbl.HashedType) with type elt = X.t and type t = int Hashtbl.Make(X).t (** Create a new counter type - The type [t] is exposed @since NEXT_RELEASE *) + The type [t] is exposed @since 0.14 *) diff --git a/src/core/CCList.mli b/src/core/CCList.mli index c825a00c..5158730e 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -69,12 +69,12 @@ val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list (** [fold_map f acc l] is a [fold_left]-like function, but it also maps the list to another list. - @since NEXT_RELEASE *) + @since 0.14 *) val fold_flat_map : ('acc -> 'a -> 'acc * 'b list) -> 'acc -> 'a list -> 'acc * 'b list (** [fold_map f acc l] is a [fold_left]-like function, but it also maps the list to a list of list that is then [flatten]'d.. - @since NEXT_RELEASE *) + @since 0.14 *) val init : int -> (int -> 'a) -> 'a t (** Similar to {!Array.init} @@ -323,7 +323,7 @@ module Zipper : sig val to_rev_list : 'a t -> 'a list (** Convert the zipper back to a {i reversed} list. In other words, [to_list (l,r)] is [List.rev_append r l] - @since NEXT_RELEASE *) + @since 0.14 *) val make : 'a list -> 'a t (** Create a zipper pointing at the first element of the list *) @@ -334,7 +334,7 @@ module Zipper : sig val left_exn : 'a t -> 'a t (** Go to the left, or @raise Invalid_argument if the zipper is already at leftmost pos - @since NEXT_RELEASE *) + @since 0.14 *) val right : 'a t -> 'a t (** Go to the right, or do nothing if the zipper is already at rightmost pos *) @@ -342,7 +342,7 @@ module Zipper : sig val right_exn : 'a t -> 'a t (** Go to the right, or @raise Invalid_argument if the zipper is already at rightmost position - @since NEXT_RELEASE *) + @since 0.14 *) val modify : ('a option -> 'a option) -> 'a t -> 'a t (** Modify the current element, if any, by returning a new element, or @@ -351,16 +351,16 @@ module Zipper : sig val insert : 'a -> 'a t -> 'a t (** Insert an element at the current position. If an element was focused, [insert x l] adds [x] just before it, and focuses on [x] - @since NEXT_RELEASE *) + @since 0.14 *) val remove : 'a t -> 'a t (** [remove l] removes the current element, if any. - @since NEXT_RELEASE *) + @since 0.14 *) val is_focused : _ t -> bool (** Is the zipper focused on some element? That is, will {!focused} return a [Some v]? - @since NEXT_RELEASE *) + @since 0.14 *) val focused : 'a t -> 'a option (** Returns the focused element, if any. [focused zip = Some _] iff @@ -372,17 +372,17 @@ module Zipper : sig val drop_before : 'a t -> 'a t (** Drop every element on the "left" (calling {!left} then will do nothing). - @since NEXT_RELEASE *) + @since 0.14 *) val drop_after : 'a t -> 'a t (** Drop every element on the "right" (calling {!right} then will do nothing), keeping the focused element, if any. - @since NEXT_RELEASE *) + @since 0.14 *) val drop_after_and_focused : 'a t -> 'a t (** Drop every element on the "right" (calling {!right} then will do nothing), {i including} the focused element if it is present. - @since NEXT_RELEASE *) + @since 0.14 *) (*$= ([1], [2]) (Zipper.drop_after ([1], [2;3])) diff --git a/src/core/CCMap.ml b/src/core/CCMap.ml index 47a77cc4..ec9c6d0e 100644 --- a/src/core/CCMap.ml +++ b/src/core/CCMap.ml @@ -45,14 +45,14 @@ module type S = sig val of_seq : (key * 'a) sequence -> 'a t val add_seq : 'a t -> (key * 'a) sequence -> 'a t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val to_seq : 'a t -> (key * 'a) sequence val of_list : (key * 'a) list -> 'a t val add_list : 'a t -> (key * 'a) list -> 'a t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val to_list : 'a t -> (key * 'a) list diff --git a/src/core/CCMap.mli b/src/core/CCMap.mli index cb7dceca..b386ad63 100644 --- a/src/core/CCMap.mli +++ b/src/core/CCMap.mli @@ -48,14 +48,14 @@ module type S = sig val of_seq : (key * 'a) sequence -> 'a t val add_seq : 'a t -> (key * 'a) sequence -> 'a t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val to_seq : 'a t -> (key * 'a) sequence val of_list : (key * 'a) list -> 'a t val add_list : 'a t -> (key * 'a) list -> 'a t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val to_list : 'a t -> (key * 'a) list diff --git a/src/core/CCPrint.mli b/src/core/CCPrint.mli index 2e712110..64eb5d24 100644 --- a/src/core/CCPrint.mli +++ b/src/core/CCPrint.mli @@ -70,7 +70,7 @@ val bool : bool t val float3 : float t (* 3 digits after . *) val float : float t val char : char t -(** @since NEXT_RELEASE *) +(** @since 0.14 *) val list : ?start:string -> ?stop:string -> ?sep:string -> 'a t -> 'a list t val array : ?start:string -> ?stop:string -> ?sep:string -> 'a t -> 'a array t diff --git a/src/core/CCSet.ml b/src/core/CCSet.ml index 0603ee73..2ebe62ab 100644 --- a/src/core/CCSet.ml +++ b/src/core/CCSet.ml @@ -36,14 +36,14 @@ module type S = sig val of_seq : elt sequence -> t val add_seq : t -> elt sequence -> t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val to_seq : t -> elt sequence val of_list : elt list -> t val add_list : t -> elt list -> t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val to_list : t -> elt list diff --git a/src/core/CCSet.mli b/src/core/CCSet.mli index 3ea014f4..5ec3fe62 100644 --- a/src/core/CCSet.mli +++ b/src/core/CCSet.mli @@ -38,14 +38,14 @@ module type S = sig val of_seq : elt sequence -> t val add_seq : t -> elt sequence -> t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val to_seq : t -> elt sequence val of_list : elt list -> t val add_list : t -> elt list -> t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val to_list : t -> elt list diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 393010e4..5173e0be 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -141,7 +141,7 @@ val replace : ?which:[`Left|`Right|`All] -> sub:string -> by:string -> string -> {- [`All] all occurrences (default)} } @raise Invalid_argument if [sub = ""] - @since NEXT_RELEASE *) + @since 0.14 *) (*$= & ~printer:CCFun.id (replace ~which:`All ~sub:"a" ~by:"b" "abcdabcd") "bbcdbbcd" diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index 887e5c22..12268b75 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -61,7 +61,7 @@ val create_with : ?capacity:int -> 'a -> ('a, rw) t val return : 'a -> ('a, 'mut) t (** Singleton vector - @since NEXT_RELEASE *) + @since 0.14 *) val make : int -> 'a -> ('a, 'mut) t (** [make n x] makes a vector of size [n], filled with [x] *) @@ -76,7 +76,7 @@ val ensure_with : init:'a -> ('a, rw) t -> int -> unit (** Hint to the vector that it should have at least the given capacity. @param init if [capacity v = 0], used as a filler element for the underlying array (see {!create_with}) - @since NEXT_RELEASE *) + @since 0.14 *) val ensure : ('a, rw) t -> int -> unit (** Hint to the vector that it should have at least the given capacity. @@ -100,7 +100,7 @@ val append_seq : ('a, rw) t -> 'a sequence -> unit val append_list : ('a, rw) t -> 'a list -> unit (** Append content of list - @since NEXT_RELEASE *) + @since 0.14 *) val equal : 'a equal -> ('a,_) t equal @@ -182,7 +182,7 @@ val find_exn : ('a -> bool) -> ('a,_) t -> 'a val find_map : ('a -> 'b option) -> ('a,_) t -> 'b option (** [find_map f v] returns the first [Some y = f x] for [x] in [v], or [None] if [f x = None] for each [x] in [v] - @since NEXT_RELEASE *) + @since 0.14 *) val filter_map : ('a -> 'b option) -> ('a,_) t -> ('b, 'mut) t (** Map elements with a function, possibly filtering some of them out *) @@ -193,16 +193,16 @@ val flat_map : ('a -> ('b,_) t) -> ('a,_) t -> ('b, 'mut) t val flat_map_seq : ('a -> 'b sequence) -> ('a,_) t -> ('b, 'mut) t (** Like {!flat_map}, but using {!sequence} for intermediate collections. - @since NEXT_RELEASE *) + @since 0.14 *) val flat_map_list : ('a -> 'b list) -> ('a,_) t -> ('b, 'mut) t (** Like {!flat_map}, but using {!list} for intermediate collections. - @since NEXT_RELEASE *) + @since 0.14 *) val flat_map' : ('a -> 'b sequence) -> ('a,_) t -> ('b, 'mut) t (** Alias to {!flat_map_seq} - @deprecated since NEXT_RELEASE , use {!flat_map_seq} *) + @deprecated since 0.14 , use {!flat_map_seq} *) val (>>=) : ('a,_) t -> ('a -> ('b,_) t) -> ('b, 'mut) t (** Infix version of {!flat_map} *) @@ -227,14 +227,14 @@ val rev : ('a,_) t -> ('a, 'mut) t val rev_in_place : ('a, rw) t -> unit (** Reverse the vector in place - @since NEXT_RELEASE *) + @since 0.14 *) val rev' : ('a, rw) t -> unit -(** @deprecated old name for {!rev_in_place} *) +(** @deprecated since 0.14 old name for {!rev_in_place} *) val rev_iter : ('a -> unit) -> ('a,_) t -> unit (** [rev_iter f a] is the same as [iter f (rev a)], only more efficient. - @since NEXT_RELEASE *) + @since 0.14 *) val size : ('a,_) t -> int (** number of elements in vector *) @@ -267,7 +267,7 @@ val to_seq : ('a,_) t -> 'a sequence val to_seq_rev : ('a, _) t -> 'a sequence (** [to_seq_rev v] returns the sequence of elements of [v] in reverse order, that is, the last elements of [v] are iterated on first. - @since NEXT_RELEASE *) + @since 0.14 *) val slice : ('a,rw) t -> ('a array * int * int) (** Vector as an array slice. By doing it we expose the internal array, so diff --git a/src/core/containers.ml b/src/core/containers.ml index b00aeb7b..b31539cc 100644 --- a/src/core/containers.ml +++ b/src/core/containers.ml @@ -62,7 +62,7 @@ module Fun = CCFun module Hash = CCHash module Int = CCInt -(** @since NEXT_RELEASE *) +(** @since 0.14 *) module Hashtbl = struct include (Hashtbl : module type of Hashtbl with type statistics = Hashtbl.statistics diff --git a/src/data/CCPersistentHashtbl.ml b/src/data/CCPersistentHashtbl.ml index 54428bed..798b04f1 100644 --- a/src/data/CCPersistentHashtbl.ml +++ b/src/data/CCPersistentHashtbl.ml @@ -71,7 +71,7 @@ module type S = sig (** Add the binding to the table, returning a new table. The old binding for this key, if it exists, is shadowed and will be restored upon [remove tbl k]. - @since NEXT_RELEASE *) + @since 0.14 *) val replace : 'a t -> key -> 'a -> 'a t (** Add the binding to the table, returning a new table. This erases @@ -138,7 +138,7 @@ module type S = sig val stats : _ t -> Hashtbl.statistics (** Statistics on the internal table. - @since NEXT_RELEASE *) + @since 0.14 *) end (*$inject diff --git a/src/data/CCPersistentHashtbl.mli b/src/data/CCPersistentHashtbl.mli index 712e62ed..cc1438a4 100644 --- a/src/data/CCPersistentHashtbl.mli +++ b/src/data/CCPersistentHashtbl.mli @@ -78,7 +78,7 @@ module type S = sig (** Add the binding to the table, returning a new table. The old binding for this key, if it exists, is shadowed and will be restored upon [remove tbl k]. - @since NEXT_RELEASE *) + @since 0.14 *) val replace : 'a t -> key -> 'a -> 'a t (** Add the binding to the table, returning a new table. This erases @@ -145,7 +145,7 @@ module type S = sig val stats : _ t -> Hashtbl.statistics (** Statistics on the internal table. - @since NEXT_RELEASE *) + @since 0.14 *) end (** {2 Implementation} *) diff --git a/src/iter/CCKList.mli b/src/iter/CCKList.mli index d785ec97..2620181e 100644 --- a/src/iter/CCKList.mli +++ b/src/iter/CCKList.mli @@ -193,7 +193,7 @@ val sort_uniq : ?cmp:'a ord -> 'a t -> 'a t val memoize : 'a t -> 'a t (** Avoid recomputations by caching intermediate results - @since NEXT_RELEASE *) + @since 0.14 *) (** {2 Fair Combinations} *) diff --git a/src/sexp/CCSexpM.mli b/src/sexp/CCSexpM.mli index 704d0bc4..66186e75 100644 --- a/src/sexp/CCSexpM.mli +++ b/src/sexp/CCSexpM.mli @@ -88,11 +88,11 @@ end module ID_MONAD : MONAD (** The monad that just uses blocking calls as bind - @since NEXT_RELEASE *) + @since 0.14 *) module D : module type of MakeDecode(ID_MONAD) (** Decoder that just blocks when input is not available - @since NEXT_RELEASE *) + @since 0.14 *) val parse_string : string -> t or_error (** Parse a string *) diff --git a/src/string/CCLevenshtein.ml b/src/string/CCLevenshtein.ml index 6f3d38ea..8fe8dee8 100644 --- a/src/string/CCLevenshtein.ml +++ b/src/string/CCLevenshtein.ml @@ -202,22 +202,22 @@ module type S = sig (** Extract a list of pairs from an index *) val add_seq : 'a t -> (string_ * 'a) sequence -> 'a t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val of_seq : (string_ * 'a) sequence -> 'a t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val to_seq : 'a t -> (string_ * 'a) sequence - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val add_gen : 'a t -> (string_ * 'a) gen -> 'a t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val of_gen : (string_ * 'a) gen -> 'a t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val to_gen : 'a t -> (string_ * 'a) gen - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val fold : ('a -> string_ -> 'b -> 'a) -> 'a -> 'b t -> 'a (** Fold over the stored pairs string/value *) diff --git a/src/string/CCLevenshtein.mli b/src/string/CCLevenshtein.mli index 96cb3730..d99ef49b 100644 --- a/src/string/CCLevenshtein.mli +++ b/src/string/CCLevenshtein.mli @@ -160,22 +160,22 @@ module type S = sig (** Extract a list of pairs from an index *) val add_seq : 'a t -> (string_ * 'a) sequence -> 'a t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val of_seq : (string_ * 'a) sequence -> 'a t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val to_seq : 'a t -> (string_ * 'a) sequence - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val add_gen : 'a t -> (string_ * 'a) gen -> 'a t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val of_gen : (string_ * 'a) gen -> 'a t - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val to_gen : 'a t -> (string_ * 'a) gen - (** @since NEXT_RELEASE *) + (** @since 0.14 *) val fold : ('a -> string_ -> 'b -> 'a) -> 'a -> 'b t -> 'a (** Fold over the stored pairs string/value *) diff --git a/src/string/CCParse.mli b/src/string/CCParse.mli index 6b30148f..29be44d8 100644 --- a/src/string/CCParse.mli +++ b/src/string/CCParse.mli @@ -132,7 +132,7 @@ type 'a t = input -> ok:('a -> unit) -> err:(exn -> unit) -> unit {- [ok] to call with the result when it's done} {- [err] to call when the parser met an error} } - The type definition changed since NEXT_RELEASE to avoid stack overflows + The type definition changed since 0.14 to avoid stack overflows @raise ParseError in case of failure *) val return : 'a -> 'a t @@ -263,7 +263,7 @@ val fix_memo : ('a t -> 'a t) -> 'a t (** {2 Parse} - Those functions have a label [~p] on the parser, since NEXT_RELEASE. + Those functions have a label [~p] on the parser, since 0.14. *) val parse : input:input -> p:'a t -> 'a or_error @@ -312,11 +312,11 @@ module U : sig 'a t -> 'b t -> ('a * 'b) t (** Parse a pair using OCaml whitespace conventions. The default is "(a, b)". - @since NEXT_RELEASE *) + @since 0.14 *) val triple : ?start:string -> ?stop:string -> ?sep:string -> 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t (** Parse a triple using OCaml whitespace conventions. The default is "(a, b, c)". - @since NEXT_RELEASE *) + @since 0.14 *) end