diff --git a/.merlin b/.merlin index 998a48f5..7cf051e1 100644 --- a/.merlin +++ b/.merlin @@ -4,6 +4,7 @@ S src/iter/ S src/sexp/ S src/threads/ S src/string +S src/monomorphic S benchs S examples S tests @@ -19,3 +20,4 @@ PKG threads.posix PKG lwt PKG qcheck FLG -w +a-4-44-48-60@8 +FLG -open CCMonomorphic diff --git a/_oasis b/_oasis index fbf34b65..432d9828 100644 --- a/_oasis +++ b/_oasis @@ -44,20 +44,26 @@ Library "containers" CCInt64, CCChar, CCResult, CCParse, CCArray_slice, CCListLabels, CCArrayLabels, CCEqual, Containers - BuildDepends: bytes, result + BuildDepends: bytes, result, containers.monomorphic # BuildDepends: bytes, bisect_ppx +Library "containers_monomorphic" + Path: src/monomorphic + Modules: CCMonomorphic + FindlibParent: containers + FindlibName: monomorphic + Library "containers_unix" Path: src/unix Modules: CCUnix - BuildDepends: bytes, result, unix + BuildDepends: bytes, result, unix, containers.monomorphic FindlibParent: containers FindlibName: unix Library "containers_sexp" Path: src/sexp Modules: CCSexp, CCSexp_lex - BuildDepends: bytes, result + BuildDepends: bytes, result, containers.monomorphic FindlibParent: containers FindlibName: sexp @@ -69,7 +75,7 @@ Library "containers_data" CCMixset, CCGraph, CCHashSet, CCBitField, CCHashTrie, CCWBTree, CCRAL, CCSimple_queue, CCImmutArray, CCHet, CCZipper - BuildDepends: bytes + BuildDepends: bytes, containers.monomorphic # BuildDepends: bytes, bisect_ppx FindlibParent: containers FindlibName: data @@ -77,6 +83,7 @@ Library "containers_data" Library "containers_iter" Path: src/iter Modules: CCKTree, CCKList, CCLazy_list + BuildDepends: containers.monomorphic FindlibParent: containers FindlibName: iter @@ -120,6 +127,7 @@ Executable run_benchs MainIs: run_benchs.ml BuildDepends: containers, qcheck, containers.data, containers.iter, containers.thread, + containers.monomorphic, sequence, gen, benchmark Executable run_bench_hash diff --git a/_tags b/_tags index 51eb014f..1f3db001 100644 --- a/_tags +++ b/_tags @@ -161,3 +161,4 @@ true: annot, bin_annot and not : warn(+a-4-44-58-60@8) true: no_alias_deps, safe_string, short_paths, color(always) : nolabels +not ( or ): open(CCMonomorphic) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index 8e10fc0d..4448b6a9 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -280,7 +280,7 @@ module Arr = struct let a2 = Array.copy a1 in sort_std a1; quicksort ~limit:10 a2; - assert (a1 = a2)) + assert (CCArray.equal CCInt.equal a1 a2)) [ 10; 100; 1000] let bench_sort ?(time=2) n = @@ -366,16 +366,16 @@ module Cache = struct let bench_fib n = let l = - [ "replacing_fib (128)", make_fib (C.replacing 128), n - ; "LRU_fib (128)", make_fib (C.lru 128), n - ; "replacing_fib (16)", make_fib (C.replacing 16), n - ; "LRU_fib (16)", make_fib (C.lru 16), n - ; "unbounded", make_fib (C.unbounded 32), n + [ "replacing_fib (128)", make_fib (C.replacing ~eq:CCInt.equal 128), n + ; "LRU_fib (128)", make_fib (C.lru ~eq:CCInt.equal 128), n + ; "replacing_fib (16)", make_fib (C.replacing ~eq:CCInt.equal 16), n + ; "LRU_fib (16)", make_fib (C.lru ~eq:CCInt.equal 16), n + ; "unbounded", make_fib (C.unbounded ~eq:CCInt.equal 32), n ] in let l = if n <= 20 - then [ "linear_fib (5)", make_fib (C.linear 5), n - ; "linear_fib (32)", make_fib (C.linear 32), n + then [ "linear_fib (5)", make_fib (C.linear ~eq:CCInt.equal 5), n + ; "linear_fib (32)", make_fib (C.linear ~eq:CCInt.equal 32), n ; "dummy_fib", make_fib C.dummy, n ] @ l else l @@ -862,7 +862,7 @@ module Deque = struct let take_back d = match !d with | None -> raise Empty - | Some first when first == first.prev -> + | Some first when Pervasives.(==) first first.prev -> (* only one element *) d := None; first.content @@ -875,7 +875,7 @@ module Deque = struct let take_front d = match !d with | None -> raise Empty - | Some first when first == first.prev -> + | Some first when Pervasives.(==) first first.prev -> (* only one element *) d := None; first.content @@ -1045,7 +1045,7 @@ module Graph = struct let dfs_event n () = let tbl = CCGraph.mk_table ~eq:CCInt.equal ~hash:CCInt.hash (n+10) in - CCGraph.Traverse.Event.dfs ~tbl ~graph:div_graph_ + CCGraph.Traverse.Event.dfs ~tbl ~eq:CCInt.equal ~graph:div_graph_ (Sequence.return n) |> Sequence.fold (fun acc -> function @@ -1154,7 +1154,7 @@ module Str = struct and mk_current () = CCString.find_all_l ~sub:needle haystack and mk_current_compiled = let f = CCString.find_all_l ~start:0 ~sub:needle in fun () -> f haystack in - assert (mk_naive () = mk_current ()); + assert (CCList.equal CCInt.equal (mk_naive ()) (mk_current ())); B.throughputN 3 ~repeat [ "naive", mk_naive, () ; "current", mk_current, () @@ -1168,7 +1168,7 @@ module Str = struct pp_pb needle haystack; let mk_naive () = find_all_l ~sub:needle haystack and mk_current () = CCString.find_all_l ~sub:needle haystack in - assert (mk_naive () = mk_current ()); + assert (CCList.equal CCInt.equal (mk_naive ()) (mk_current ())); B.throughputN 3 ~repeat [ "naive", mk_naive, () ; "current", mk_current, () @@ -1182,7 +1182,7 @@ module Str = struct let rec same s1 s2 i = if i = String.length s1 then true else ( - String.unsafe_get s1 i = String.unsafe_get s2 i && same s1 s2 (i+1) + CCChar.equal (String.unsafe_get s1 i) (String.unsafe_get s2 i) && same s1 s2 (i+1) ) in String.length pre <= String.length s && @@ -1193,7 +1193,7 @@ module Str = struct begin let i = ref 0 in while !i < String.length pre && - String.unsafe_get s !i = String.unsafe_get pre !i + CCChar.equal (String.unsafe_get s !i) (String.unsafe_get pre !i) do incr i done; !i = String.length pre end @@ -1225,7 +1225,7 @@ module Str = struct else let rec loop str p i = if i = len then true - else if String.unsafe_get str i <> String.unsafe_get p i then false + else if not (CCChar.equal (String.unsafe_get str i) (String.unsafe_get p i)) then false else loop str p (i + 1) in loop str p 0 @@ -1256,7 +1256,7 @@ module Str = struct Array.iteri (fun i (pre, y) -> let res = f ~pre y in - assert (res = output.(i))) + assert (CCBool.equal res output.(i))) input in Benchmark.throughputN 3 diff --git a/opam b/opam index a82de59b..f930cfba 100644 --- a/opam +++ b/opam @@ -39,6 +39,6 @@ conflicts: [ tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ] homepage: "https://github.com/c-cube/ocaml-containers/" doc: "http://cedeela.fr/~simon/software/containers/" -available: [ocaml-version >= "4.01.0"] +available: [ocaml-version >= "4.02.0"] dev-repo: "https://github.com/c-cube/ocaml-containers.git" bug-reports: "https://github.com/c-cube/ocaml-containers/issues/" diff --git a/src/core/CCArray.ml b/src/core/CCArray.ml index 3daf1e7e..4fa0a86f 100644 --- a/src/core/CCArray.ml +++ b/src/core/CCArray.ml @@ -176,8 +176,7 @@ let sort_indices cmp a = *) let sort_ranking cmp a = - let cmp_int : int -> int -> int = Pervasives.compare in - sort_indices cmp_int (sort_indices cmp a) + sort_indices compare (sort_indices cmp a) (*$= & ~cmp:(=) ~printer:Q.Print.(array int) [||] (sort_ranking Pervasives.compare [||]) @@ -297,24 +296,24 @@ let _lookup_exn ~cmp k a i j = | n when n<0 -> _lookup_rec ~cmp k a (i+1) (j-1) | _ -> raise Not_found (* too high *) -let lookup_exn ?(cmp=Pervasives.compare) k a = +let lookup_exn ~cmp k a = _lookup_exn ~cmp k a 0 (Array.length a-1) -let lookup ?(cmp=Pervasives.compare) k a = +let lookup ~cmp k a = try Some (_lookup_exn ~cmp k a 0 (Array.length a-1)) with Not_found -> None (*$T - lookup 2 [|0;1;2;3;4;5|] = Some 2 - lookup 4 [|0;1;2;3;4;5|] = Some 4 - lookup 0 [|1;2;3;4;5|] = None - lookup 6 [|1;2;3;4;5|] = None - lookup 3 [| |] = None - lookup 1 [| 1 |] = Some 0 - lookup 2 [| 1 |] = None + lookup ~cmp:CCInt.compare 2 [|0;1;2;3;4;5|] = Some 2 + lookup ~cmp:CCInt.compare 4 [|0;1;2;3;4;5|] = Some 4 + lookup ~cmp:CCInt.compare 0 [|1;2;3;4;5|] = None + lookup ~cmp:CCInt.compare 6 [|1;2;3;4;5|] = None + lookup ~cmp:CCInt.compare 3 [| |] = None + lookup ~cmp:CCInt.compare 1 [| 1 |] = Some 0 + lookup ~cmp:CCInt.compare 2 [| 1 |] = None *) -let bsearch ?(cmp=Pervasives.compare) k a = +let bsearch ~cmp k a = let rec aux i j = if i > j then `Just_after j @@ -333,13 +332,13 @@ let bsearch ?(cmp=Pervasives.compare) k a = | _ -> aux 0 (n-1) (*$T bsearch - bsearch 3 [|1; 2; 2; 3; 4; 10|] = `At 3 - bsearch 5 [|1; 2; 2; 3; 4; 10|] = `Just_after 4 - bsearch 1 [|1; 2; 5; 5; 11; 12|] = `At 0 - bsearch 12 [|1; 2; 5; 5; 11; 12|] = `At 5 - bsearch 10 [|1; 2; 2; 3; 4; 9|] = `All_lower - bsearch 0 [|1; 2; 2; 3; 4; 9|] = `All_bigger - bsearch 3 [| |] = `Empty + bsearch ~cmp:CCInt.compare 3 [|1; 2; 2; 3; 4; 10|] = `At 3 + bsearch ~cmp:CCInt.compare 5 [|1; 2; 2; 3; 4; 10|] = `Just_after 4 + bsearch ~cmp:CCInt.compare 1 [|1; 2; 5; 5; 11; 12|] = `At 0 + bsearch ~cmp:CCInt.compare 12 [|1; 2; 5; 5; 11; 12|] = `At 5 + bsearch ~cmp:CCInt.compare 10 [|1; 2; 2; 3; 4; 9|] = `All_lower + bsearch ~cmp:CCInt.compare 0 [|1; 2; 2; 3; 4; 9|] = `All_bigger + bsearch ~cmp:CCInt.compare 3 [| |] = `Empty *) let (>>=) a f = flat_map f a @@ -664,7 +663,7 @@ end let sort_generic (type arr)(type elt) (module A : MONO_ARRAY with type t = arr and type elt = elt) - ?(cmp=Pervasives.compare) a + ~cmp a = let module S = SortGeneric(A) in S.sort ~cmp a diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index c0a99efe..d6da8cde 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -119,18 +119,18 @@ val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option and [p x] holds. Otherwise returns [None] @since 0.3.4 *) -val lookup : ?cmp:'a ord -> 'a -> 'a t -> int option +val lookup : cmp:'a ord -> 'a -> 'a t -> int option (** Lookup the index of some value in a sorted array. Undefined behavior if the array is not sorted wrt [cmp]. Complexity: [O(log (n))] (dichotomic search). @return [None] if the key is not present, or [Some i] ([i] the index of the key) otherwise *) -val lookup_exn : ?cmp:'a ord -> 'a -> 'a t -> int +val lookup_exn : cmp:'a ord -> 'a -> 'a t -> int (** Same as {!lookup}, but @raise Not_found if the key is not present *) -val bsearch : ?cmp:('a -> 'a -> int) -> 'a -> 'a t -> +val bsearch : cmp:('a -> 'a -> int) -> 'a -> 'a t -> [ `All_lower | `All_bigger | `Just_after of int | `Empty | `At of int ] (** [bsearch ?cmp x arr] finds the index of the object [x] in the array [arr], provided [arr] is {b sorted} using [cmp]. If the array is not sorted, @@ -256,7 +256,7 @@ end val sort_generic : (module MONO_ARRAY with type t = 'arr and type elt = 'elt) -> - ?cmp:('elt -> 'elt -> int) -> 'arr -> unit + cmp:('elt -> 'elt -> int) -> 'arr -> unit (** Sort the array, without allocating (eats stack space though). Performance might be lower than {!Array.sort}. @since 0.14 *) diff --git a/src/core/CCArrayLabels.mli b/src/core/CCArrayLabels.mli index fdf3784b..e2d5afa0 100644 --- a/src/core/CCArrayLabels.mli +++ b/src/core/CCArrayLabels.mli @@ -90,16 +90,16 @@ val find_idx : f:('a -> bool) -> 'a t -> (int * 'a) option and [p x] holds. Otherwise returns [None] @since 0.3.4 *) -val lookup : ?cmp:'a ord -> key:'a -> 'a t -> int option +val lookup : cmp:'a ord -> key:'a -> 'a t -> int option (** Lookup the index of some value in a sorted array. @return [None] if the key is not present, or [Some i] ([i] the index of the key) otherwise *) -val lookup_exn : ?cmp:'a ord -> key:'a -> 'a t -> int +val lookup_exn : cmp:'a ord -> key:'a -> 'a t -> int (** Same as {!lookup_exn}, but @raise Not_found if the key is not present *) -val bsearch : ?cmp:('a -> 'a -> int) -> key:'a -> 'a t -> +val bsearch : cmp:('a -> 'a -> int) -> key:'a -> 'a t -> [ `All_lower | `All_bigger | `Just_after of int | `Empty | `At of int ] (** [bsearch ?cmp key arr] finds the index of the object [key] in the array [arr], provided [arr] is {b sorted} using [cmp]. If the array is not sorted, @@ -225,7 +225,7 @@ end val sort_generic : (module MONO_ARRAY with type t = 'arr and type elt = 'elt) -> - ?cmp:('elt -> 'elt -> int) -> 'arr -> unit + cmp:('elt -> 'elt -> int) -> 'arr -> unit (** Sort the array, without allocating (eats stack space though). Performance might be lower than {!Array.sort}. @since 0.14 *) diff --git a/src/core/CCArray_slice.ml b/src/core/CCArray_slice.ml index fcbe1204..9e96841b 100644 --- a/src/core/CCArray_slice.ml +++ b/src/core/CCArray_slice.ml @@ -85,6 +85,7 @@ let rec _compare cmp a1 i1 j1 a2 i2 j2 = let equal eq a b = length a = length b && _equal eq a.arr a.i a.j b.arr b.i b.j +let compare_int (a : int) b = Pervasives.compare a b let compare cmp a b = _compare cmp a.arr a.i a.j b.arr b.i b.j @@ -292,9 +293,8 @@ let sorted cmp a = _sorted cmp a.arr a.i a.j let sort_ranking cmp a = let idx = _sort_indices cmp a.arr a.i a.j in - let cmp_int : int -> int -> int = Pervasives.compare in let sort_indices cmp a = _sort_indices cmp a 0 (Array.length a) in - sort_indices cmp_int idx + sort_indices compare_int idx (*$= & ~cmp:(=) ~printer:Q.Print.(array int) [||] \ @@ -345,18 +345,18 @@ let find_idx p a = (Some (1,"c")) (find_idx ((=) "c") (make [| "a"; "b"; "c" |] 1 2)) *) -let lookup_exn ?(cmp=Pervasives.compare) k a = +let lookup_exn ~cmp k a = _lookup_exn ~cmp k a.arr a.i (a.j-1) - a.i -let lookup ?(cmp=Pervasives.compare) k a = +let lookup ~cmp k a = try Some (_lookup_exn ~cmp k a.arr a.i (a.j-1) - a.i) with Not_found -> None (*$= - (Some 1) (lookup "c" (make [| "a"; "b"; "c" |] 1 2)) + (Some 1) (lookup ~cmp:CCString.compare "c" (make [| "a"; "b"; "c" |] 1 2)) *) -let bsearch ?(cmp=Pervasives.compare) k a = +let bsearch ~cmp k a = match bsearch_ ~cmp k a.arr a.i (a.j - 1) with | `At m -> `At (m - a.i) | `Just_after m -> `Just_after (m - a.i) diff --git a/src/core/CCArray_slice.mli b/src/core/CCArray_slice.mli index 1a5989bc..e72dd00f 100644 --- a/src/core/CCArray_slice.mli +++ b/src/core/CCArray_slice.mli @@ -86,10 +86,10 @@ val sorted : ('a -> 'a -> int) -> 'a t -> 'a array val sort_indices : ('a -> 'a -> int) -> 'a t -> int array (** [sort_indices cmp a] returns a new array [b], with the same length as [a], - such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a] + such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a] appears in [a]. [a] is not modified. - In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a]. + In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a]. [sort_indices] yields the inverse permutation of {!sort_ranking}. @since 1.0 *) @@ -99,7 +99,7 @@ val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array such that [b.(i)] is the index at which the [i]-the element of [a] appears in [sorted cmp a]. [a] is not modified. - In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a]. + In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a]. [sort_ranking] yields the inverse permutation of {!sort_indices}. In the absence of duplicate elements in [a], we also have @@ -119,16 +119,16 @@ val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option and [p x] holds. Otherwise returns [None] @since 0.3.4 *) -val lookup : ?cmp:'a ord -> 'a -> 'a t -> int option +val lookup : cmp:'a ord -> 'a -> 'a t -> int option (** Lookup the index of some value in a sorted array. @return [None] if the key is not present, or [Some i] ([i] the index of the key) otherwise *) -val lookup_exn : ?cmp:'a ord -> 'a -> 'a t -> int +val lookup_exn : cmp:'a ord -> 'a -> 'a t -> int (** Same as {!lookup}, but @raise Not_found if the key is not present *) -val bsearch : ?cmp:('a -> 'a -> int) -> 'a -> 'a t -> +val bsearch : cmp:('a -> 'a -> int) -> 'a -> 'a t -> [ `All_lower | `All_bigger | `Just_after of int | `Empty | `At of int ] (** [bsearch ?cmp x arr] finds the index of the object [x] in the array [arr], provided [arr] is {b sorted} using [cmp]. If the array is not sorted, diff --git a/src/core/CCBool.ml b/src/core/CCBool.ml index 087d0101..89a6a9e5 100644 --- a/src/core/CCBool.ml +++ b/src/core/CCBool.ml @@ -3,7 +3,7 @@ type t = bool -let equal (a:bool) b = a=b +let equal (a:bool) b = Pervasives.(=) a b let compare (a:bool) b = Pervasives.compare a b diff --git a/src/core/CCChar.ml b/src/core/CCChar.ml index 55900bd6..68d45cad 100644 --- a/src/core/CCChar.ml +++ b/src/core/CCChar.ml @@ -6,7 +6,7 @@ include Char -let equal (a:char) b = a=b +let equal (a:char) b = Pervasives.(=) a b let pp = Buffer.add_char let print = Format.pp_print_char @@ -15,12 +15,10 @@ let of_int_exn = Char.chr let of_int c = try Some (of_int_exn c) with _ -> None let to_int = Char.code -let lowercase_ascii c = - if c >= 'A' && c <= 'Z' - then Char.unsafe_chr (Char. code c + 32) - else c +let lowercase_ascii = function + | 'A'..'Z' as c -> Char.unsafe_chr (Char.code c + 32) + | c -> c -let uppercase_ascii c = - if c >= 'a' && c <= 'z' - then Char.unsafe_chr (Char.code c - 32) - else c +let uppercase_ascii = function + | 'a'..'z' as c -> Char.unsafe_chr (Char.code c - 32) + | c -> c diff --git a/src/core/CCEqual.ml b/src/core/CCEqual.ml index f879bd05..13ee4d79 100644 --- a/src/core/CCEqual.ml +++ b/src/core/CCEqual.ml @@ -5,12 +5,13 @@ type 'a t = 'a -> 'a -> bool -let poly = (=) +let poly = Pervasives.(=) +let physical = Pervasives.(==) let int : int t = (=) -let string : string t = (=) -let bool : bool t = (=) -let float : float t = (=) +let string : string t = Pervasives.(=) +let bool : bool t = Pervasives.(=) +let float : float t = Pervasives.(=) let unit () () = true let rec list f l1 l2 = match l1, l2 with diff --git a/src/core/CCEqual.mli b/src/core/CCEqual.mli index 94230bfa..efcbc3ea 100644 --- a/src/core/CCEqual.mli +++ b/src/core/CCEqual.mli @@ -11,6 +11,10 @@ type 'a t = 'a -> 'a -> bool val poly : 'a t (** Standard polymorphic equality *) +val physical : 'a t +(** Standard physical equality + @since NEXT_RELEASE *) + val int : int t val string : string t val bool : bool t diff --git a/src/core/CCFloat.ml b/src/core/CCFloat.ml index 2e7fcc41..cb4062b9 100644 --- a/src/core/CCFloat.ml +++ b/src/core/CCFloat.ml @@ -9,6 +9,16 @@ type fpclass = Pervasives.fpclass = | FP_infinite | FP_nan +module Infix = struct + let (=) = Pervasives.(=) + let (<>) = Pervasives.(<>) + let (<) = Pervasives.(<) + let (>) = Pervasives.(>) + let (<=) = Pervasives.(<=) + let (>=) = Pervasives.(>=) +end +include Infix + let nan = Pervasives.nan let infinity = Pervasives.infinity @@ -84,13 +94,3 @@ let random_range i j st = i +. random (j-.i) st let equal_precision ~epsilon a b = abs_float (a-.b) < epsilon let classify = Pervasives.classify_float - -module Infix = struct - let (=) = Pervasives.(=) - let (<>) = Pervasives.(<>) - let (<) = Pervasives.(<) - let (>) = Pervasives.(>) - let (<=) = Pervasives.(<=) - let (>=) = Pervasives.(>=) -end -include Infix diff --git a/src/core/CCInt.ml b/src/core/CCInt.ml index eb37fccc..cc87f080 100644 --- a/src/core/CCInt.ml +++ b/src/core/CCInt.ml @@ -5,7 +5,7 @@ type t = int let equal (a:int) b = a=b -let compare (a:int) b = Pervasives.compare a b +let compare a b = compare a b let hash i = i land max_int @@ -75,9 +75,11 @@ let floor_div a n = (fun (n, m) -> floor_div n (-m) = int_of_float @@ floor (float n /. float (-m))) *) +let bool_neq (a : bool) b = Pervasives.(<>) a b + let rem a n = let y = a mod n in - if (y < 0) <> (n < 0) && y <> 0 then + if bool_neq (y < 0) (n < 0) && y <> 0 then y + n else y @@ -245,12 +247,12 @@ let range' i j yield = module Infix = struct - let (=) = Pervasives.(=) - let (<>) = Pervasives.(<>) - let (<) = Pervasives.(<) - let (>) = Pervasives.(>) - let (<=) = Pervasives.(<=) - let (>=) = Pervasives.(>=) + let (=) = (=) + let (<>) = (<>) + let (<) = (<) + let (>) = (>) + let (<=) = (<=) + let (>=) = (>=) let (--) = range let (--^) = range' end diff --git a/src/core/CCInt64.ml b/src/core/CCInt64.ml index f9ab3841..9ac33506 100644 --- a/src/core/CCInt64.ml +++ b/src/core/CCInt64.ml @@ -28,7 +28,7 @@ let (lsr) = shift_right_logical let (asr) = shift_right -let equal (x:t) y = x=y +let equal (x:t) y = Pervasives.(=) x y let hash x = Pervasives.abs (to_int x) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 601fb06d..ec33ae71 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -557,7 +557,7 @@ let map_product_l f l = cmp_lii_unord (cartesian_product l) (map_product_l CCFun.id l)) *) -let sorted_merge ?(cmp=Pervasives.compare) l1 l2 = +let sorted_merge ~cmp l1 l2 = let rec recurse cmp acc l1 l2 = match l1,l2 with | [], _ -> List.rev_append acc l2 | _, [] -> List.rev_append acc l1 @@ -572,15 +572,15 @@ let sorted_merge ?(cmp=Pervasives.compare) l1 l2 = (*$T List.sort Pervasives.compare ([(( * )2); ((+)1)] <*> [10;100]) \ = [11; 20; 101; 200] - sorted_merge [1;1;2] [1;2;3] = [1;1;1;2;2;3] + sorted_merge ~cmp:CCInt.compare [1;1;2] [1;2;3] = [1;1;1;2;2;3] *) (*$Q Q.(pair (list int) (list int)) (fun (l1,l2) -> \ - List.length (sorted_merge l1 l2) = List.length l1 + List.length l2) + List.length (sorted_merge ~cmp:CCInt.compare l1 l2) = List.length l1 + List.length l2) *) -let sort_uniq (type elt) ?(cmp=Pervasives.compare) l = +let sort_uniq (type elt) ~cmp l = let module S = Set.Make(struct type t = elt let compare = cmp @@ -589,12 +589,12 @@ let sort_uniq (type elt) ?(cmp=Pervasives.compare) l = S.elements set (*$T - sort_uniq [1;2;5;3;6;1;4;2;3] = [1;2;3;4;5;6] - sort_uniq [] = [] - sort_uniq [10;10;10;10;1;10] = [1;10] + sort_uniq ~cmp:CCInt.compare [1;2;5;3;6;1;4;2;3] = [1;2;3;4;5;6] + sort_uniq ~cmp:CCInt.compare [] = [] + sort_uniq ~cmp:CCInt.compare [10;10;10;10;1;10] = [1;10] *) -let is_sorted ?(cmp=Pervasives.compare) l = +let is_sorted ~cmp l = let rec aux cmp = function | [] | [_] -> true | x :: ((y :: _) as tail) -> cmp x y <= 0 && aux cmp tail @@ -603,10 +603,10 @@ let is_sorted ?(cmp=Pervasives.compare) l = (*$Q Q.(list small_int) (fun l -> \ - is_sorted (List.sort Pervasives.compare l)) + is_sorted ~cmp:CCInt.compare (List.sort Pervasives.compare l)) *) -let sorted_insert ?(cmp=Pervasives.compare) ?(uniq=false) x l = +let sorted_insert ~cmp ?(uniq=false) x l = let rec aux cmp uniq x left l = match l with | [] -> List.rev_append left [x] | y :: tail -> @@ -622,20 +622,20 @@ let sorted_insert ?(cmp=Pervasives.compare) ?(uniq=false) x l = (*$Q Q.(pair small_int (list small_int)) (fun (x,l) -> \ let l = List.sort Pervasives.compare l in \ - is_sorted (sorted_insert ~uniq:true x l)) + is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare ~uniq:true x l)) Q.(pair small_int (list small_int)) (fun (x,l) -> \ let l = List.sort Pervasives.compare l in \ - is_sorted (sorted_insert ~uniq:false x l)) + is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare ~uniq:false x l)) Q.(pair small_int (list small_int)) (fun (x,l) -> \ let l = List.sort Pervasives.compare l in \ - let l' = sorted_insert ~uniq:false x l in \ + let l' = sorted_insert ~cmp:CCInt.compare ~uniq:false x l in \ List.length l' = List.length l + 1) Q.(pair small_int (list small_int)) (fun (x,l) -> \ let l = List.sort Pervasives.compare l in \ - List.mem x (sorted_insert x l)) + List.mem x (sorted_insert ~cmp:CCInt.compare x l)) *) -let uniq_succ ?(eq=(=)) l = +let uniq_succ ~eq l = let rec f acc l = match l with | [] -> List.rev acc | [x] -> List.rev (x::acc) @@ -645,10 +645,10 @@ let uniq_succ ?(eq=(=)) l = f [] l (*$T - uniq_succ [1;1;2;3;1;6;6;4;6;1] = [1;2;3;1;6;4;6;1] + uniq_succ ~eq:CCInt.equal [1;1;2;3;1;6;6;4;6;1] = [1;2;3;1;6;4;6;1] *) -let group_succ ?(eq=(=)) l = +let group_succ ~eq l = let rec f ~eq acc cur l = match cur, l with | [], [] -> List.rev acc | _::_, [] -> List.rev (List.rev cur :: acc) @@ -659,15 +659,15 @@ let group_succ ?(eq=(=)) l = f ~eq [] [] l (*$T - group_succ [1;2;3;1;1;2;4] = [[1]; [2]; [3]; [1;1]; [2]; [4]] - group_succ [] = [] - group_succ [1;1;1] = [[1;1;1]] - group_succ [1;2;2;2] = [[1]; [2;2;2]] + group_succ ~eq:CCInt.equal [1;2;3;1;1;2;4] = [[1]; [2]; [3]; [1;1]; [2]; [4]] + group_succ ~eq:CCInt.equal [] = [] + group_succ ~eq:CCInt.equal [1;1;1] = [[1;1;1]] + group_succ ~eq:CCInt.equal [1;2;2;2] = [[1]; [2;2;2]] group_succ ~eq:(fun (x,_)(y,_)-> x=y) [1, 1; 1, 2; 1, 3; 2, 0] \ = [[1, 1; 1, 2; 1, 3]; [2, 0]] *) -let sorted_merge_uniq ?(cmp=Pervasives.compare) l1 l2 = +let sorted_merge_uniq ~cmp l1 l2 = let push ~cmp acc x = match acc with | [] -> [x] | y :: _ when cmp x y > 0 -> x :: acc @@ -687,21 +687,21 @@ let sorted_merge_uniq ?(cmp=Pervasives.compare) l1 l2 = recurse ~cmp [] l1 l2 (*$T - sorted_merge_uniq [1; 1; 2; 3; 5; 8] [1; 2; 3; 4; 6; 8; 9; 9] = [1;2;3;4;5;6;8;9] + sorted_merge_uniq ~cmp:CCInt.compare [1; 1; 2; 3; 5; 8] [1; 2; 3; 4; 6; 8; 9; 9] = [1;2;3;4;5;6;8;9] *) (*$Q Q.(list int) (fun l -> \ let l = List.sort Pervasives.compare l in \ - sorted_merge_uniq l [] = uniq_succ l) + sorted_merge_uniq ~cmp:CCInt.compare l [] = uniq_succ ~eq:CCInt.equal l) Q.(list int) (fun l -> \ let l = List.sort Pervasives.compare l in \ - sorted_merge_uniq [] l = uniq_succ l) + sorted_merge_uniq ~cmp:CCInt.compare [] l = uniq_succ ~eq:CCInt.equal l) Q.(pair (list int) (list int)) (fun (l1, l2) -> \ let l1 = List.sort Pervasives.compare l1 \ and l2 = List.sort Pervasives.compare l2 in \ - let l3 = sorted_merge_uniq l1 l2 in \ - uniq_succ l3 = l3) + let l3 = sorted_merge_uniq ~cmp:CCInt.compare l1 l2 in \ + uniq_succ ~eq:CCInt.equal l3 = l3) *) let take n l = @@ -766,7 +766,7 @@ let sublists_of_len ?(last=fun _ -> None) ?offset n l = (* add sub-lists of [l] to [acc] *) let rec aux acc l = let group = take n l in - if group=[] then acc (* this was the last group, we are done *) + if is_empty group then acc (* this was the last group, we are done *) else if List.length group < n (* last group, with missing elements *) then match last group with | None -> acc @@ -900,7 +900,7 @@ let find_idx p l = find_mapi (fun i x -> if p x then Some (i, x) else None) l find_map (fun x -> if x=3 then Some "a" else None) [1;2;4;5] = None *) -let remove ?(eq=(=)) ~x l = +let remove ~eq ~x l = let rec remove' eq x acc l = match l with | [] -> List.rev acc | y :: tail when eq x y -> remove' eq x acc tail @@ -909,8 +909,8 @@ let remove ?(eq=(=)) ~x l = remove' eq x [] l (*$T - remove ~x:1 [2;1;3;3;2;1] = [2;3;3;2] - remove ~x:10 [1;2;3] = [1;2;3] + remove ~eq:CCInt.equal ~x:1 [2;1;3;3;2;1] = [2;3;3;2] + remove ~eq:CCInt.equal ~x:10 [1;2;3] = [1;2;3] *) let filter_map f l = @@ -972,16 +972,16 @@ let all_ok l = (Error "e2") (all_ok [Ok 1; Error "e2"; Error "e3"; Ok 4]) *) -let mem ?(eq=(=)) x l = +let mem ~eq x l = let rec search eq x l = match l with | [] -> false | y::l' -> eq x y || search eq x l' in search eq x l -let add_nodup ?(eq=(=)) x l = +let add_nodup ~eq x l = if mem ~eq x l then l else x::l -let remove_one ?(eq=(=)) x l = +let remove_one ~eq x l = let rec remove_one ~eq x acc l = match l with | [] -> assert false | y :: tl when eq x y -> List.rev_append acc tl @@ -991,19 +991,19 @@ let remove_one ?(eq=(=)) x l = (*$Q Q.(pair int (list int)) (fun (x,l) -> \ - remove_one x (add_nodup x l) = l) + remove_one ~eq:CCInt.equal x (add_nodup ~eq:CCInt.equal x l) = l) Q.(pair int (list int)) (fun (x,l) -> \ - mem x l || List.length (add_nodup x l) = List.length l + 1) + mem ~eq:CCInt.equal x l || List.length (add_nodup ~eq:CCInt.equal x l) = List.length l + 1) Q.(pair int (list int)) (fun (x,l) -> \ - not (mem x l) || List.length (remove_one x l) = List.length l - 1) + not (mem ~eq:CCInt.equal x l) || List.length (remove_one ~eq:CCInt.equal x l) = List.length l - 1) *) -let subset ?(eq=(=)) l1 l2 = +let subset ~eq l1 l2 = List.for_all (fun t -> mem ~eq t l2) l1 -let uniq ?(eq=(=)) l = +let uniq ~eq l = let rec uniq eq acc l = match l with | [] -> List.rev acc | x::xs when List.exists (eq x) xs -> uniq eq acc xs @@ -1011,15 +1011,15 @@ let uniq ?(eq=(=)) l = in uniq eq [] l (*$T - uniq [1;1;2;2;3;4;4;2;4;1;5] |> List.sort Pervasives.compare = [1;2;3;4;5] + uniq ~eq:CCInt.equal [1;1;2;2;3;4;4;2;4;1;5] |> List.sort Pervasives.compare = [1;2;3;4;5] *) (*$Q Q.(small_list small_int) (fun l -> \ - sort_uniq l = (uniq l |> sort Pervasives.compare)) + sort_uniq ~cmp:CCInt.compare l = (uniq ~eq:CCInt.equal l |> sort Pervasives.compare)) *) -let union ?(eq=(=)) l1 l2 = +let union ~eq l1 l2 = let rec union eq acc l1 l2 = match l1 with | [] -> List.rev_append acc l2 | x::xs when mem ~eq x l2 -> union eq acc xs l2 @@ -1027,10 +1027,10 @@ let union ?(eq=(=)) l1 l2 = in union eq [] l1 l2 (*$T - union [1;2;4] [2;3;4;5] = [1;2;3;4;5] + union ~eq:CCInt.equal [1;2;4] [2;3;4;5] = [1;2;3;4;5] *) -let inter ?(eq=(=)) l1 l2 = +let inter ~eq l1 l2 = let rec inter eq acc l1 l2 = match l1 with | [] -> List.rev acc | x::xs when mem ~eq x l2 -> inter eq (x::acc) xs l2 @@ -1038,7 +1038,7 @@ let inter ?(eq=(=)) l1 l2 = in inter eq [] l1 l2 (*$T - inter [1;2;4] [2;3;4;5] = [2;4] + inter ~eq:CCInt.equal [1;2;4] [2;3;4;5] = [2;4] *) let mapi f l = @@ -1236,17 +1236,17 @@ module Assoc = struct | (y,z)::l' -> if eq x y then z else search_exn eq l' x - let get_exn ?(eq=(=)) x l = search_exn eq l x + let get_exn ~eq x l = search_exn eq l x - let get ?(eq=(=)) x l = + let get ~eq x l = try Some (search_exn eq l x) with Not_found -> None (*$T - Assoc.get 1 [1, "1"; 2, "2"] = Some "1" - Assoc.get 2 [1, "1"; 2, "2"] = Some "2" - Assoc.get 3 [1, "1"; 2, "2"] = None - Assoc.get 42 [] = None + Assoc.get ~eq:CCInt.equal 1 [1, "1"; 2, "2"] = Some "1" + Assoc.get ~eq:CCInt.equal 2 [1, "1"; 2, "2"] = Some "2" + Assoc.get ~eq:CCInt.equal 3 [1, "1"; 2, "2"] = None + Assoc.get ~eq:CCInt.equal 42 [] = None *) (* search for a binding for [x] in [l], and calls [f x (Some v) rest] @@ -1259,27 +1259,27 @@ module Assoc = struct then f x (Some y') (List.rev_append acc l') else search_set eq ((x',y')::acc) l' x ~f - let set ?(eq=(=)) x y l = + let set ~eq x y l = search_set eq [] l x ~f:(fun x _ l -> (x,y)::l) (*$T - Assoc.set 2 "two" [1,"1"; 2, "2"] |> List.sort Pervasives.compare \ + Assoc.set ~eq:CCInt.equal 2 "two" [1,"1"; 2, "2"] |> List.sort Pervasives.compare \ = [1, "1"; 2, "two"] - Assoc.set 3 "3" [1,"1"; 2, "2"] |> List.sort Pervasives.compare \ + Assoc.set ~eq:CCInt.equal 3 "3" [1,"1"; 2, "2"] |> List.sort Pervasives.compare \ = [1, "1"; 2, "2"; 3, "3"] *) - let mem ?(eq=(=)) x l = + let mem ~eq x l = try ignore (search_exn eq l x); true with Not_found -> false (*$T - Assoc.mem 1 [1,"1"; 2,"2"; 3, "3"] - not (Assoc.mem 4 [1,"1"; 2,"2"; 3, "3"]) + Assoc.mem ~eq:CCInt.equal 1 [1,"1"; 2,"2"; 3, "3"] + not (Assoc.mem ~eq:CCInt.equal 4 [1,"1"; 2,"2"; 3, "3"]) *) - let update ?(eq=(=)) ~f x l = + let update ~eq ~f x l = search_set eq [] l x ~f:(fun x opt_y rest -> match f opt_y with @@ -1287,17 +1287,17 @@ module Assoc = struct | Some y' -> (x,y') :: rest) (*$= [1,"1"; 2,"22"] \ - (Assoc.update 2 [1,"1"; 2,"2"] \ + (Assoc.update ~eq:CCInt.equal 2 [1,"1"; 2,"2"] \ ~f:(function Some "2" -> Some "22" | _ -> assert false) |> lsort) [1,"1"; 3,"3"] \ - (Assoc.update 2 [1,"1"; 2,"2"; 3,"3"] \ + (Assoc.update ~eq:CCInt.equal 2 [1,"1"; 2,"2"; 3,"3"] \ ~f:(function Some "2" -> None | _ -> assert false) |> lsort) [1,"1"; 2,"2"; 3,"3"] \ - (Assoc.update 3 [1,"1"; 2,"2"] \ + (Assoc.update ~eq:CCInt.equal 3 [1,"1"; 2,"2"] \ ~f:(function None -> Some "3" | _ -> assert false) |> lsort) *) - let remove ?(eq=(=)) x l = + let remove ~eq x l = search_set eq [] l x ~f:(fun _ opt_y rest -> match opt_y with | None -> l (* keep as is *) @@ -1305,14 +1305,19 @@ module Assoc = struct (*$= [1,"1"] \ - (Assoc.remove 2 [1,"1"; 2,"2"] |> lsort) + (Assoc.remove ~eq:CCInt.equal 2 [1,"1"; 2,"2"] |> lsort) [1,"1"; 3,"3"] \ - (Assoc.remove 2 [1,"1"; 2,"2"; 3,"3"] |> lsort) + (Assoc.remove ~eq:CCInt.equal 2 [1,"1"; 2,"2"; 3,"3"] |> lsort) [1,"1"; 2,"2"] \ - (Assoc.remove 3 [1,"1"; 2,"2"] |> lsort) + (Assoc.remove ~eq:CCInt.equal 3 [1,"1"; 2,"2"] |> lsort) *) end +let assoc = Assoc.get_exn +let assoc_opt = Assoc.get +let mem_assoc = Assoc.mem +let remove_assoc = Assoc.remove + (** {2 References on Lists} *) module Ref = struct diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 17391f76..08e6b1a5 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -260,7 +260,7 @@ val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option (** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l], and [p x] holds. Otherwise returns [None] *) -val remove : ?eq:('a -> 'a -> bool) -> x:'a -> 'a t -> 'a t +val remove : eq:('a -> 'a -> bool) -> x:'a -> 'a t -> 'a t (** [remove ~x l] removes every instance of [x] from [l]. Tailrec. @param eq equality function @since 0.11 *) @@ -287,23 +287,23 @@ val all_ok : ('a, 'err) Result.result t -> ('a t, 'err) Result.result or [Error e] otherwise (with the first error met). @since 1.3 *) -val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list +val sorted_merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list (** Merges elements from both sorted list *) -val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list +val sort_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list (** Sort the list and remove duplicate elements *) -val sorted_merge_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list +val sorted_merge_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list (** [sorted_merge_uniq l1 l2] merges the sorted lists [l1] and [l2] and removes duplicates @since 0.10 *) -val is_sorted : ?cmp:('a -> 'a -> int) -> 'a list -> bool +val is_sorted : cmp:('a -> 'a -> int) -> 'a list -> bool (** [is_sorted l] returns [true] iff [l] is sorted (according to given order) @param cmp the comparison function (default [Pervasives.compare]) @since 0.17 *) -val sorted_insert : ?cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list +val sorted_insert : cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list (** [sorted_insert x l] inserts [x] into [l] such that, if [l] was sorted, then [sorted_insert x l] is sorted too. @param uniq if true and [x] is already in sorted position in [l], then @@ -313,17 +313,17 @@ val sorted_insert : ?cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a (*$Q Q.(pair small_int (list small_int)) (fun (x,l) -> \ let l = List.sort Pervasives.compare l in \ - is_sorted (sorted_insert x l)) + is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare x l)) *) -val uniq_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list +val uniq_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list (** [uniq_succ l] removes duplicate elements that occur one next to the other. Examples: [uniq_succ [1;2;1] = [1;2;1]] [uniq_succ [1;1;2] = [1;2]] @since 0.10 *) -val group_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list list +val group_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list list (** [group_succ ~eq l] groups together consecutive elements that are equal according to [eq] @since 0.11 *) @@ -376,30 +376,30 @@ val remove_at_idx : int -> 'a t -> 'a t Those operations maintain the invariant that the list does not contain duplicates (if it already satisfies it) *) -val add_nodup : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t +val add_nodup : eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t (** [add_nodup x set] adds [x] to [set] if it was not already present. Linear time. @since 0.11 *) -val remove_one : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t +val remove_one : eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t (** [remove_one x set] removes one occurrence of [x] from [set]. Linear time. @since 0.11 *) -val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool +val mem : eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool (** Membership to the list. Linear time *) -val subset : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool +val subset : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool (** Test for inclusion *) -val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t +val uniq : eq:('a -> 'a -> bool) -> 'a t -> 'a t (** Remove duplicates w.r.t the equality predicate. Complexity is quadratic in the length of the list, but the order of elements is preserved. If you wish for a faster de-duplication but do not care about the order, use {!sort_uniq}*) -val union : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t +val union : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t (** List union. Complexity is product of length of inputs. *) -val inter : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t +val inter : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t (** List intersection. Complexity is product of length of inputs. *) (** {2 Other Constructors} *) @@ -437,40 +437,52 @@ val repeat : int -> 'a t -> 'a t module Assoc : sig type ('a, 'b) t = ('a*'b) list - val get : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b option + val get : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b option (** Find the element *) - val get_exn : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b + val get_exn : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b (** Same as [get], but unsafe @raise Not_found if the element is not present *) - val set : ?eq:('a->'a->bool) -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t + val set : eq:('a->'a->bool) -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t (** Add the binding into the list (erase it if already present) *) - val mem : ?eq:('a->'a->bool) -> 'a -> ('a,_) t -> bool + val mem : eq:('a->'a->bool) -> 'a -> ('a,_) t -> bool (** [mem x l] returns [true] iff [x] is a key in [l] @since 0.16 *) val update : - ?eq:('a->'a->bool) -> f:('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t + eq:('a->'a->bool) -> f:('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t (** [update k ~f l] updates [l] on the key [k], by calling [f (get l k)] and removing [k] if it returns [None], mapping [k] to [v'] if it returns [Some v'] @since 0.16 *) - val remove : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> ('a,'b) t + val remove : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> ('a,'b) t (** [remove x l] removes the first occurrence of [k] from [l]. @since 0.17 *) end -val assoc_opt : 'a -> ('a * 'b) t -> 'b option -(** Safe version of {!assoc} +val assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b +(** Same as [Assoc.get_exn] + @since NEXT_RELEASE *) + +val assoc_opt : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b option +(** Same as [Assoc.get] @since 1.5 *) val assq_opt : 'a -> ('a * 'b) t -> 'b option (** Safe version of {!assq} @since 1.5 *) +val mem_assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * _) t -> bool +(** Same as [Assoc.mem] + @since NEXT_RELEASE *) + +val remove_assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> ('a * 'b) t +(** Same as [Assoc.remove] + @since NEXT_RELEASE *) + (** {2 References on Lists} @since 0.3.3 *) diff --git a/src/core/CCListLabels.mli b/src/core/CCListLabels.mli index 4bc67737..ffa3d94b 100644 --- a/src/core/CCListLabels.mli +++ b/src/core/CCListLabels.mli @@ -178,7 +178,7 @@ val find_idx : f:('a -> bool) -> 'a t -> (int * 'a) option (** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l], and [p x] holds. Otherwise returns [None] *) -val remove : ?eq:('a -> 'a -> bool) -> key:'a -> 'a t -> 'a t +val remove : eq:('a -> 'a -> bool) -> key:'a -> 'a t -> 'a t (** [remove ~key l] removes every instance of [key] from [l]. Tailrec. @param eq equality function @since 0.11 *) @@ -186,23 +186,23 @@ val remove : ?eq:('a -> 'a -> bool) -> key:'a -> 'a t -> 'a t val filter_map : f:('a -> 'b option) -> 'a t -> 'b t (** Map and remove elements at the same time *) -val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list +val sorted_merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list (** Merges elements from both sorted list *) -val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list +val sort_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list (** Sort the list and remove duplicate elements *) -val sorted_merge_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list +val sorted_merge_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list (** [sorted_merge_uniq l1 l2] merges the sorted lists [l1] and [l2] and removes duplicates @since 0.10 *) -val is_sorted : ?cmp:('a -> 'a -> int) -> 'a list -> bool +val is_sorted : cmp:('a -> 'a -> int) -> 'a list -> bool (** [is_sorted l] returns [true] iff [l] is sorted (according to given order) @param cmp the comparison function (default [Pervasives.compare]) @since 0.17 *) -val sorted_insert : ?cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list +val sorted_insert : cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list (** [sorted_insert x l] inserts [x] into [l] such that, if [l] was sorted, then [sorted_insert x l] is sorted too. @param uniq if true and [x] is already in sorted position in [l], then @@ -215,14 +215,14 @@ val sorted_insert : ?cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a is_sorted (sorted_insert x l)) *) -val uniq_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list +val uniq_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list (** [uniq_succ l] removes duplicate elements that occur one next to the other. Examples: [uniq_succ [1;2;1] = [1;2;1]] [uniq_succ [1;1;2] = [1;2]] @since 0.10 *) -val group_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list list +val group_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list list (** [group_succ ~eq l] groups together consecutive elements that are equal according to [eq] @since 0.11 *) @@ -259,30 +259,30 @@ val remove_at_idx : int -> 'a t -> 'a t Those operations maintain the invariant that the list does not contain duplicates (if it already satisfies it) *) -val add_nodup : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t +val add_nodup : eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t (** [add_nodup x set] adds [x] to [set] if it was not already present. Linear time. @since 0.11 *) -val remove_one : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t +val remove_one : eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t (** [remove_one x set] removes one occurrence of [x] from [set]. Linear time. @since 0.11 *) -val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool +val mem : eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool (** Membership to the list. Linear time *) -val subset : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool +val subset : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool (** Test for inclusion *) -val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t +val uniq : eq:('a -> 'a -> bool) -> 'a t -> 'a t (** Remove duplicates w.r.t the equality predicate. Complexity is quadratic in the length of the list, but the order of elements is preserved. If you wish for a faster de-duplication but do not care about the order, use {!sort_uniq}*) -val union : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t +val union : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t (** List union. Complexity is product of length of inputs. *) -val inter : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t +val inter : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t (** List intersection. Complexity is product of length of inputs. *) (** {2 Other Constructors} *) @@ -320,32 +320,52 @@ val repeat : int -> 'a t -> 'a t module Assoc : sig type ('a, 'b) t = ('a*'b) list - val get : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b option + val get : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b option (** Find the element *) - val get_exn : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b + val get_exn : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b (** Same as [get], but unsafe @raise Not_found if the element is not present *) - val set : ?eq:('a->'a->bool) -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t + val set : eq:('a->'a->bool) -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t (** Add the binding into the list (erase it if already present) *) - val mem : ?eq:('a->'a->bool) -> 'a -> ('a,_) t -> bool + val mem : eq:('a->'a->bool) -> 'a -> ('a,_) t -> bool (** [mem x l] returns [true] iff [x] is a key in [l] @since 0.16 *) val update : - ?eq:('a->'a->bool) -> f:('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t + eq:('a->'a->bool) -> f:('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t (** [update k ~f l] updates [l] on the key [k], by calling [f (get l k)] and removing [k] if it returns [None], mapping [k] to [v'] if it returns [Some v'] @since 0.16 *) - val remove : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> ('a,'b) t + val remove : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> ('a,'b) t (** [remove x l] removes the first occurrence of [k] from [l]. @since 0.17 *) end +val assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b +(** Same as [Assoc.get_exn] + @since NEXT_RELEASE *) + +val assoc_opt : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b option +(** Same as [Assoc.get] + @since NEXT_RELEASE *) + +val assq_opt : 'a -> ('a * 'b) t -> 'b option +(** Safe version of {!assq} + @since NEXT_RELEASE *) + +val mem_assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * _) t -> bool +(** Same as [Assoc.mem] + @since NEXT_RELEASE *) + +val remove_assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> ('a * 'b) t +(** Same as [Assoc.remove] + @since NEXT_RELEASE *) + (** {2 References on Lists} @since 0.3.3 *) diff --git a/src/core/CCParse.ml b/src/core/CCParse.ml index f581784a..229895f0 100644 --- a/src/core/CCParse.ml +++ b/src/core/CCParse.ml @@ -43,6 +43,9 @@ type state = { exception ParseError of parse_branch * (unit -> string) +let char_equal (a : char) b = Pervasives.(=) a b +let string_equal (a : string) b = Pervasives.(=) a b + let rec string_of_branch l = let pp_s () = function | None -> "" @@ -87,7 +90,7 @@ let next st ~ok ~err = else ( let c = st.str.[st.i] in st.i <- st.i + 1; - if c='\n' + if char_equal c '\n' then (st.lnum <- st.lnum + 1; st.cnum <- 1) else st.cnum <- st.cnum + 1; ok c @@ -146,7 +149,7 @@ let char c = let msg = Printf.sprintf "expected '%c'" c in fun st ~ok ~err -> next st ~err - ~ok:(fun c' -> if c=c' then ok c else fail_ ~err st (const_ msg)) + ~ok:(fun c' -> if char_equal c c' then ok c else fail_ ~err st (const_ msg)) let char_if p st ~ok ~err = next st ~err @@ -164,7 +167,7 @@ let chars_if p st ~ok ~err:_ = let chars1_if p st ~ok ~err = chars_if p st ~err ~ok:(fun s -> - if s = "" + if string_equal s "" then fail_ ~err st (const_ "unexpected sequence of chars") else ok s) @@ -231,7 +234,7 @@ let string s st ~ok ~err = else next st ~err ~ok:(fun c -> - if c = s.[i] + if char_equal c s.[i] then check (i+1) else fail_ ~err st (fun () -> Printf.sprintf "expected \"%s\"" s)) in @@ -386,7 +389,7 @@ module U = struct skip_white <* string stop let int = - chars1_if (fun c -> is_num c || c='-') + chars1_if (fun c -> is_num c || char_equal c '-') >>= fun s -> try return (int_of_string s) with Failure _ -> fail "expected an int" diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index bcc83111..fc3d7d93 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -77,7 +77,7 @@ let replicate n g st = in aux [] n (* Sample without replacement using rejection sampling. *) -let sample_without_replacement (type elt) ?(compare=compare) k (rng:elt t) st= +let sample_without_replacement (type elt) ~compare k (rng:elt t) st= let module S = Set.Make(struct type t=elt let compare = compare end) in let rec aux s k = if k <= 0 then @@ -118,7 +118,7 @@ let _diff_list ~last l = let split_list i ~len st = if len <= 1 then invalid_arg "Random.split_list"; if i >= len then - let xs = sample_without_replacement (len-1) (int_range 1 (i-1)) st in + let xs = sample_without_replacement ~compare (len-1) (int_range 1 (i-1)) st in _diff_list ( 0::xs ) ~last:i else None @@ -221,6 +221,7 @@ let uniformity_test ?(size_hint=10) k rng st = let confidence = 4. in let std = confidence *. (sqrt (kf *. variance)) in let predicate _key n acc = + let (<) (a : float) b = Pervasives.(<) a b in acc && abs_float (average -. float_of_int n) < std in Hashtbl.fold predicate histogram true diff --git a/src/core/CCRandom.mli b/src/core/CCRandom.mli index ffb32cfb..de76e90d 100644 --- a/src/core/CCRandom.mli +++ b/src/core/CCRandom.mli @@ -56,7 +56,7 @@ val replicate : int -> 'a t -> 'a list t randomly using [g] *) val sample_without_replacement: - ?compare:('a -> 'a -> int) -> int -> 'a t -> 'a list t + compare:('a -> 'a -> int) -> int -> 'a t -> 'a list t (** [sample_without_replacement n g] makes a list of [n] elements which are all generated randomly using [g] with the added constraint that none of the generated random values are equal diff --git a/src/core/CCResult.ml b/src/core/CCResult.ml index 271c4823..362d7b4d 100644 --- a/src/core/CCResult.ml +++ b/src/core/CCResult.ml @@ -109,12 +109,12 @@ let (>|=) e f = map f e let (>>=) e f = flat_map f e -let equal ?(err=Pervasives.(=)) eq a b = match a, b with +let equal ~err eq a b = match a, b with | Ok x, Ok y -> eq x y | Error s, Error s' -> err s s' | _ -> false -let compare ?(err=Pervasives.compare) cmp a b = match a, b with +let compare ~err cmp a b = match a, b with | Ok x, Ok y -> cmp x y | Ok _, _ -> 1 | _, Ok _ -> -1 diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index a494081a..15e4d53a 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -96,9 +96,9 @@ val (>|=) : ('a, 'err) t -> ('a -> 'b) -> ('b, 'err) t val (>>=) : ('a, 'err) t -> ('a -> ('b, 'err) t) -> ('b, 'err) t -val equal : ?err:'err equal -> 'a equal -> ('a, 'err) t equal +val equal : err:'err equal -> 'a equal -> ('a, 'err) t equal -val compare : ?err:'err ord -> 'a ord -> ('a, 'err) t ord +val compare : err:'err ord -> 'a ord -> ('a, 'err) t ord val fold : ok:('a -> 'b) -> error:('err -> 'b) -> ('a, 'err) t -> 'b (** [fold ~ok ~error e] opens [e] and, if [e = Ok x], returns diff --git a/src/core/CCString.ml b/src/core/CCString.ml index 9654760d..6e66c732 100644 --- a/src/core/CCString.ml +++ b/src/core/CCString.ml @@ -56,8 +56,9 @@ module type S = sig val print : Format.formatter -> t -> unit end -let equal (a:string) b = a=b +let equal (a:string) b = Pervasives.(=) a b +let compare_int (a : int) b = Pervasives.compare a b let compare = String.compare let hash s = Hashtbl.hash s @@ -78,7 +79,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 CCChar.equal sub.[i+k] s.[j+k] && check (k+1) in j+len <= String.length s && check 0 @@ -126,7 +127,7 @@ module Find = struct let j = ref 0 in while !i < len do match !j with - | _ when get str (!i-1) = get str !j -> + | _ when CCChar.equal (get str (!i-1)) (get str !j) -> (* substring starting at !j continues matching current char *) incr j; failure.(!i) <- !j; @@ -158,7 +159,7 @@ module Find = struct while !j < pat_len && !i + !j < len do let c = String.get s (!i + !j) in let expected = String.get pattern.str !j in - if c = expected + if CCChar.equal c expected then ( (* char matches *) incr j; @@ -193,7 +194,7 @@ module Find = struct while !j < pat_len && !i + !j < len do let c = String.get s (len - !i - !j - 1) in let expected = String.get pattern.str (String.length pattern.str - !j - 1) in - if c = expected + if CCChar.equal c expected then ( (* char matches *) incr j; @@ -292,7 +293,7 @@ let replace_at_ ~pos ~len ~by s = Buffer.contents b let replace ?(which=`All) ~sub ~by s = - if sub="" then invalid_arg "CCString.replace"; + if is_empty sub then invalid_arg "CCString.replace"; match which with | `Left -> let i = find ~sub s ~start:0 in @@ -442,7 +443,7 @@ let compare_versions a b = | Some _, None -> 1 | None, Some _ -> -1 | Some x, Some y -> - let c = Pervasives.compare x y in + let c = compare_int x y in if c<>0 then c else cmp_rec a b in cmp_rec (Split.gen_cpy ~by:"." a) (Split.gen_cpy ~by:"." b) @@ -480,7 +481,7 @@ let compare_natural a b = | NC_int _, NC_char _ -> 1 | NC_char _, NC_int _ -> -1 | NC_int x, NC_int y -> - let c = Pervasives.compare x y in + let c = compare_int x y in if c<>0 then c else cmp_rec a b in cmp_rec (chunks a) (chunks b) @@ -490,7 +491,7 @@ let edit_distance s1 s2 = then length s2 else if length s2 = 0 then length s1 - else if s1 = s2 + else if equal s1 s2 then 0 else begin (* distance vectors (v0=previous, v1=current) *) @@ -777,14 +778,9 @@ let exists2 p s1 s2 = (** {2 Ascii functions} *) let equal_caseless s1 s2: bool = - let char_lower c = - if c >= 'A' && c <= 'Z' - then Char.unsafe_chr (Char. code c + 32) - else c - in String.length s1 = String.length s2 && for_all2 - (fun c1 c2 -> char_lower c1 = char_lower c2) + (fun c1 c2 -> CCChar.equal (CCChar.lowercase_ascii c1) (CCChar.lowercase_ascii c2)) s1 s2 let pp buf s = diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 13586ae7..32d4bb33 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -297,7 +297,7 @@ let compare cmp v1 v2 = let n = min v1.size v2.size in let rec check i = if i = n - then Pervasives.compare v1.size v2.size + then compare v1.size v2.size else let c = cmp (get v1 i) (get v2 i) in if c = 0 then check (i+1) else c @@ -513,7 +513,7 @@ let for_all p v = else p v.vec.(i) && check (i+1) in check 0 -let member ?(eq=(=)) x v = +let member ~eq x v = exists (eq x) v let find_exn p v = diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index edb60897..b570905e 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -118,7 +118,7 @@ val shrink : ('a, rw) t -> int -> unit (** Shrink to the given size (remove elements above this size). Does nothing if the parameter is bigger than the current size. *) -val member : ?eq:('a -> 'a -> bool) -> 'a -> ('a, _) t -> bool +val member : eq:('a -> 'a -> bool) -> 'a -> ('a, _) t -> bool (** Is the element a member of the vector? *) val sort : ('a -> 'a -> int) -> ('a, _) t -> ('a, 'mut) t diff --git a/src/core/containers.ml b/src/core/containers.ml index cb3f4814..6db033eb 100644 --- a/src/core/containers.ml +++ b/src/core/containers.ml @@ -42,3 +42,6 @@ module Result = CCResult module Set = CCSet module String = CCString module Vector = CCVector +module Monomorphic = CCMonomorphic + +include Monomorphic diff --git a/src/data/CCCache.ml b/src/data/CCCache.ml index ec956458..e8cf3426 100644 --- a/src/data/CCCache.ml +++ b/src/data/CCCache.ml @@ -6,7 +6,6 @@ type 'a equal = 'a -> 'a -> bool type 'a hash = 'a -> int -let default_eq_ = Pervasives.(=) let default_hash_ = Hashtbl.hash (** {2 Value interface} *) @@ -57,7 +56,7 @@ let with_cache_rec ?(cb=default_callback_) c f = f' (*$R - let c = unbounded 256 in + let c = unbounded ~eq:CCInt.equal 256 in let fib = with_cache_rec c (fun self n -> match n with | 1 | 2 -> 1 @@ -124,7 +123,7 @@ module Linear = struct !r end -let linear ?(eq=default_eq_) size = +let linear ~eq size = let size = max size 1 in let arr = Linear.make eq size in { get=(fun x -> Linear.get arr x); @@ -161,9 +160,13 @@ module Replacing = struct | Pair _ | Empty -> raise Not_found + let is_empty = function + | Empty -> true + | Pair _ -> false + let set c x y = let i = c.hash x mod Array.length c.arr in - if c.arr.(i) = Empty then c.c_size <- c.c_size + 1; + if is_empty c.arr.(i) then c.c_size <- c.c_size + 1; c.arr.(i) <- Pair (x,y) let iter c f = @@ -172,7 +175,7 @@ module Replacing = struct let size c () = c.c_size end -let replacing ?(eq=default_eq_) ?(hash=default_hash_) size = +let replacing ~eq ?(hash=default_hash_) size = let c = Replacing.make eq hash size in { get=(fun x -> Replacing.get c x); set=(fun x y -> Replacing.set c x y); @@ -219,7 +222,7 @@ module LRU(X:HASH) = struct (* take first from queue *) let take_ c = match c.first with - | Some n when n.next == n -> + | Some n when Pervasives.(==) n.next n -> (* last element *) c.first <- None; n @@ -238,7 +241,7 @@ module LRU(X:HASH) = struct n.next <- n; n.prev <- n; c.first <- Some n - | Some n1 when n1==n -> () + | Some n1 when Pervasives.(==) n1 n -> () | Some n1 -> n.prev <- n1.prev; n.next <- n1; @@ -294,7 +297,7 @@ module LRU(X:HASH) = struct H.iter (fun x node -> f x node.value) c.table end -let lru (type a) ?(eq=default_eq_) ?(hash=default_hash_) size = +let lru (type a) ~eq ?(hash=default_hash_) size = let module L = LRU(struct type t = a let equal = eq @@ -318,7 +321,7 @@ let lru (type a) ?(eq=default_eq_) ?(hash=default_hash_) size = (*$T let f = (let r = ref 0 in fun _ -> incr r; !r) in \ - let c = lru 2 in \ + let c = lru ~eq:CCInt.equal 2 in \ let res1 = with_cache c f 1 in \ let res2 = with_cache c f 2 in \ let res3 = with_cache c f 3 in \ @@ -328,7 +331,7 @@ let lru (type a) ?(eq=default_eq_) ?(hash=default_hash_) size = (*$R let f = (let r = ref 0 in fun _ -> incr r; !r) in - let c = lru 2 in + let c = lru ~eq:CCEqual.unit 2 in let x = with_cache c f () in assert_equal 1 x; assert_equal 1 (size c); @@ -356,7 +359,7 @@ module UNBOUNDED(X:HASH) = struct let iter c f = H.iter f c end -let unbounded (type a) ?(eq=default_eq_) ?(hash=default_hash_) size = +let unbounded (type a) ~eq ?(hash=default_hash_) size = let module C = UNBOUNDED(struct type t = a let equal = eq diff --git a/src/data/CCCache.mli b/src/data/CCCache.mli index 28c287b2..4d1121b5 100644 --- a/src/data/CCCache.mli +++ b/src/data/CCCache.mli @@ -79,13 +79,13 @@ val add : ('a, 'b) t -> 'a -> 'b -> bool val dummy : ('a,'b) t (** Dummy cache, never stores any value *) -val linear : ?eq:'a equal -> int -> ('a, 'b) t +val linear : eq:'a equal -> int -> ('a, 'b) t (** Linear cache with the given size. It stores key/value pairs in an array and does linear search at every call, so it should only be used with small size. @param eq optional equality predicate for keys *) -val replacing : ?eq:'a equal -> ?hash:'a hash -> +val replacing : eq:'a equal -> ?hash:'a hash -> int -> ('a,'b) t (** Replacing cache of the given size. Equality and hash functions can be parametrized. It's a hash table that handles collisions by replacing @@ -93,12 +93,12 @@ val replacing : ?eq:'a equal -> ?hash:'a hash -> entry with the same hash (modulo size) is added). Never grows wider than the given size. *) -val lru : ?eq:'a equal -> ?hash:'a hash -> +val lru : eq:'a equal -> ?hash:'a hash -> int -> ('a,'b) t (** LRU cache of the given size ("Least Recently Used": keys that have not been used recently are deleted first). Never grows wider than the given size. *) -val unbounded : ?eq:'a equal -> ?hash:'a hash -> +val unbounded : eq:'a equal -> ?hash:'a hash -> int -> ('a,'b) t (** Unbounded cache, backed by a Hash table. Will grow forever unless {!clear} is called manually. *) diff --git a/src/data/CCDeque.ml b/src/data/CCDeque.ml index 9453e464..7a91f4c7 100644 --- a/src/data/CCDeque.ml +++ b/src/data/CCDeque.ml @@ -74,9 +74,11 @@ let is_zero_ n = match n.cell with | Two _ | Three _ -> false +let bool_eq (a : bool) b = Pervasives.(=) a b + let is_empty d = let res = d.size = 0 in - assert (res = is_zero_ d.cur); + assert (bool_eq res (is_zero_ d.cur)); res let push_front d x = @@ -161,7 +163,7 @@ let take_back_node_ n = match n.cell with let take_back d = if is_empty d then raise Empty - else if d.cur == d.cur.prev + else if Pervasives.(==) d.cur d.cur.prev then ( (* only one cell *) decr_size_ d; @@ -194,7 +196,7 @@ let take_front_node_ n = match n.cell with let take_front d = if is_empty d then raise Empty - else if d.cur.prev == d.cur + else if Pervasives.(==) d.cur.prev d.cur then ( (* only one cell *) decr_size_ d; @@ -253,7 +255,7 @@ let fold f acc d = | Two (x,y) -> f (f acc x) y | Three (x,y,z) -> f (f (f acc x) y) z in - if n.next == first then acc else aux ~first f acc n.next + if Pervasives.(==) n.next first then acc else aux ~first f acc n.next in aux ~first:d.cur f acc d.cur @@ -335,7 +337,7 @@ let to_gen q = let cell = ref q.cur.cell in let cur = ref q.cur in let rec next () = match !cell with - | Zero when (!cur).next == first -> None + | Zero when Pervasives.(==) (!cur).next first -> None | Zero -> (* go to next node *) let n = !cur in @@ -367,7 +369,7 @@ let copy d = let q = of_list [1;2;3;4] in assert_equal 4 (length q); let q' = copy q in - let cmp = equal ?eq:None in + let cmp = equal ~eq:CCInt.equal in assert_equal 4 (length q'); assert_equal ~cmp q q'; push_front q 0; @@ -377,7 +379,7 @@ let copy d = assert_equal ~cmp q q' *) -let equal ?(eq=(=)) a b = +let equal ~eq a b = let rec aux eq a b = match a() , b() with | None, None -> true | None, Some _ @@ -385,7 +387,7 @@ let equal ?(eq=(=)) a b = | Some x, Some y -> eq x y && aux eq a b in aux eq (to_gen a) (to_gen b) -let compare ?(cmp=Pervasives.compare) a b = +let compare ~cmp a b = let rec aux cmp a b = match a() , b() with | None, None -> 0 | None, Some _ -> -1 @@ -397,7 +399,7 @@ let compare ?(cmp=Pervasives.compare) a b = (*$Q Q.(pair (list int) (list int)) (fun (l1,l2) -> \ - CCOrd.equiv (compare (of_list l1) (of_list l2)) \ + CCOrd.equiv (compare ~cmp:Pervasives.compare (of_list l1) (of_list l2)) \ (CCList.compare Pervasives.compare l1 l2)) *) @@ -412,4 +414,3 @@ let print pp_x out d = pp_x out x ) d; Format.fprintf out "}@]" - diff --git a/src/data/CCDeque.mli b/src/data/CCDeque.mli index c0bde886..4571f63a 100644 --- a/src/data/CCDeque.mli +++ b/src/data/CCDeque.mli @@ -21,13 +21,13 @@ val clear : _ t -> unit val is_empty : 'a t -> bool (** Is the deque empty? *) -val equal : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool +val equal : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool (** [equal a b] checks whether [a] and [b] contain the same sequence of elements. @param eq comparison function for elements @since 0.13 *) -val compare : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int +val compare : cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int (** [compare a b] compares lexicographically [a] and [b] @param cmp comparison function for elements @since 0.13 *) diff --git a/src/data/CCFQueue.ml b/src/data/CCFQueue.ml index de6848f1..44b0662f 100644 --- a/src/data/CCFQueue.ml +++ b/src/data/CCFQueue.ml @@ -34,10 +34,14 @@ let empty = Shallow Zero exception Empty +let is_not_zero = function + | Zero -> false + | One _ | Two _ | Three _ -> true + let _single x = Shallow (One x) let _double x y = Shallow (Two (x,y)) let _deep n hd middle tl = - assert (hd<>Zero && tl<>Zero); + assert (is_not_zero hd && is_not_zero tl); Deep (n, hd, middle, tl) let is_empty = function diff --git a/src/data/CCGraph.ml b/src/data/CCGraph.ml index 067f9c3d..63c889fb 100644 --- a/src/data/CCGraph.ml +++ b/src/data/CCGraph.ml @@ -56,7 +56,7 @@ type ('k, 'a) table = { (** Mutable set *) type 'a set = ('a, unit) table -let mk_table (type k) ?(eq=(=)) ?(hash=Hashtbl.hash) size = +let mk_table (type k) ~eq ?(hash=Hashtbl.hash) size = let module H = Hashtbl.Make(struct type t = k let equal = eq @@ -68,7 +68,7 @@ let mk_table (type k) ?(eq=(=)) ?(hash=Hashtbl.hash) size = ; add=(fun k v -> H.replace tbl k v) } -let mk_map (type k) ?(cmp=Pervasives.compare) () = +let mk_map (type k) ~cmp () = let module M = Map.Make(struct type t = k let compare = cmp @@ -160,15 +160,15 @@ module Traverse = struct ) done - let generic ?(tbl=mk_table 128) ~bag ~graph seq = + let generic ~tbl ~bag ~graph seq = let tags = { get_tag=tbl.mem; set_tag=(fun v -> tbl.add v ()); } in generic_tag ~tags ~bag ~graph seq - let bfs ?tbl ~graph seq = - generic ?tbl ~bag:(mk_queue ()) ~graph seq + let bfs ~tbl ~graph seq = + generic ~tbl ~bag:(mk_queue ()) ~graph seq let bfs_tag ~tags ~graph seq = generic_tag ~tags ~bag:(mk_queue()) ~graph seq @@ -186,15 +186,15 @@ module Traverse = struct let bag = mk_heap ~leq:(fun (_,d1,_) (_,d2,_) -> d1 <= d2) in generic_tag ~tags:tags' ~bag ~graph:graph' seq' - let dijkstra ?(tbl=mk_table 128) ?dist ~graph seq = + let dijkstra ~tbl ?dist ~graph seq = let tags = { get_tag=tbl.mem; set_tag=(fun v -> tbl.add v ()); } in dijkstra_tag ~tags ?dist ~graph seq - let dfs ?tbl ~graph seq = - generic ?tbl ~bag:(mk_stack ()) ~graph seq + let dfs ~tbl ~graph seq = + generic ~tbl ~bag:(mk_stack ()) ~graph seq let dfs_tag ~tags ~graph seq = generic_tag ~tags ~bag:(mk_stack()) ~graph seq @@ -240,7 +240,7 @@ module Traverse = struct | (v1,_,_) :: path' -> eq v v1 || list_mem_ ~eq ~graph v path' - let dfs_tag ?(eq=(=)) ~tags ~graph seq = + let dfs_tag ~eq ~tags ~graph seq = let first = ref true in fun k -> if !first then first := false else raise Sequence_once; @@ -279,17 +279,18 @@ module Traverse = struct done ) seq - let dfs ?(tbl=mk_table 128) ?eq ~graph seq = + let dfs ~tbl ~eq ~graph seq = let tags = { set_tag=(fun v -> tbl.add v ()); get_tag=tbl.mem; } in - dfs_tag ?eq ~tags ~graph seq + dfs_tag ~eq ~tags ~graph seq end (*$R let l = - Traverse.Event.dfs ~graph:divisors_graph (Sequence.return 345614) + let tbl = mk_table ~eq:CCInt.equal 128 in + Traverse.Event.dfs ~tbl ~eq:CCInt.equal ~graph:divisors_graph (Sequence.return 345614) |> Sequence.to_list in let expected = [`Enter (345614, 0, []); `Edge (345614, (), 172807, `Forward); @@ -305,8 +306,8 @@ end (** {2 Cycles} *) -let is_dag ?(tbl=mk_table 128) ~graph vs = - Traverse.Event.dfs ~tbl ~graph vs +let is_dag ~tbl ~eq ~graph vs = + Traverse.Event.dfs ~tbl ~eq ~graph vs |> Seq.exists_ (function | `Edge (_, _, _, `Back) -> true @@ -316,7 +317,7 @@ let is_dag ?(tbl=mk_table 128) ~graph vs = exception Has_cycle -let topo_sort_tag ?(eq=(=)) ?(rev=false) ~tags ~graph seq = +let topo_sort_tag ~eq ?(rev=false) ~tags ~graph seq = (* use DFS *) let l = Traverse.Event.dfs_tag ~eq ~tags ~graph seq @@ -331,21 +332,23 @@ let topo_sort_tag ?(eq=(=)) ?(rev=false) ~tags ~graph seq = in if rev then List.rev l else l -let topo_sort ?eq ?rev ?(tbl=mk_table 128) ~graph seq = +let topo_sort ~eq ?rev ~tbl ~graph seq = let tags = { get_tag=tbl.mem; set_tag=(fun v -> tbl.add v ()); } in - topo_sort_tag ?eq ?rev ~tags ~graph seq + topo_sort_tag ~eq ?rev ~tags ~graph seq (*$T - let l = topo_sort ~graph:divisors_graph (Seq.return 42) in \ + let tbl = mk_table ~eq:CCInt.equal 128 in \ + let l = topo_sort ~tbl ~eq:CCInt.equal ~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] - let l = topo_sort ~rev:true ~graph:divisors_graph (Seq.return 42) in \ + let tbl = mk_table ~eq:CCInt.equal 128 in \ + let l = topo_sort ~tbl ~eq:CCInt.equal ~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 \ @@ -393,7 +396,7 @@ let spanning_tree_tag ~tags ~graph v = in mk_node v -let spanning_tree ?(tbl=mk_table 128) ~graph v = +let spanning_tree ~tbl ~graph v = let tags = { get_tag=tbl.mem; set_tag=(fun v -> tbl.add v ()); @@ -482,12 +485,12 @@ end type 'v scc_state = 'v SCC.state -let scc ?(tbl=mk_table 128) ~graph seq = SCC.explore ~tbl ~graph seq +let scc ~tbl ~graph seq = SCC.explore ~tbl ~graph seq (* example from https://en.wikipedia.org/wiki/Strongly_connected_component *) (*$R let set_eq ?(eq=(=)) l1 l2 = CCList.subset ~eq l1 l2 && CCList.subset ~eq l2 l1 in - let graph = of_list + let graph = of_list ~eq:CCString.equal [ "a", "b" ; "b", "e" ; "e", "a" @@ -503,7 +506,8 @@ let scc ?(tbl=mk_table 128) ~graph seq = SCC.explore ~tbl ~graph seq ; "h", "d" ; "h", "g" ] in - let res = scc ~graph (Seq.return "a") |> Seq.to_list in + let tbl = mk_table ~eq:CCString.equal 128 in + let res = scc ~tbl ~graph (Seq.return "a") |> Seq.to_list in assert_bool "scc" (set_eq ~eq:(set_eq ?eq:None) res [ [ "a"; "b"; "e" ] @@ -541,8 +545,8 @@ module Dot = struct (** Print an enum of Full.traverse_event *) let pp_seq - ?(tbl=mk_table 128) - ?(eq=(=)) + ~tbl + ~eq ?(attrs_v=fun _ -> []) ?(attrs_e=fun _ -> []) ?(name="graph") @@ -598,8 +602,8 @@ module Dot = struct Format.fprintf out "}@]@;@?"; () - let pp ?tbl ?eq ?attrs_v ?attrs_e ?name ~graph fmt v = - pp_seq ?tbl ?eq ?attrs_v ?attrs_e ?name ~graph fmt (Seq.return v) + let pp ~tbl ~eq ?attrs_v ?attrs_e ?name ~graph fmt v = + pp_seq ~tbl ~eq ?attrs_v ?attrs_e ?name ~graph fmt (Seq.return v) let with_out filename f = let oc = open_out filename in @@ -622,7 +626,7 @@ type ('v, 'e) mut_graph = { remove : 'v -> unit; } -let mk_mut_tbl (type k) ?(eq=(=)) ?(hash=Hashtbl.hash) size = +let mk_mut_tbl (type k) ~eq ?(hash=Hashtbl.hash) size = let module Tbl = Hashtbl.Make(struct type t = k let hash = hash @@ -757,7 +761,7 @@ end (** {2 Misc} *) -let of_list ?(eq=(=)) l = +let of_list ~eq l = (fun v yield -> List.iter (fun (a,b) -> if eq a v then yield ((),b)) l) let of_fun f = diff --git a/src/data/CCGraph.mli b/src/data/CCGraph.mli index 9daa6223..18a34bc6 100644 --- a/src/data/CCGraph.mli +++ b/src/data/CCGraph.mli @@ -77,10 +77,10 @@ type ('k, 'a) table = { (** Mutable set *) type 'a set = ('a, unit) table -val mk_table: ?eq:('k -> 'k -> bool) -> ?hash:('k -> int) -> int -> ('k, 'a) table +val mk_table: eq:('k -> 'k -> bool) -> ?hash:('k -> int) -> int -> ('k, 'a) table (** Default implementation for {!table}: a {!Hashtbl.t} *) -val mk_map: ?cmp:('k -> 'k -> int) -> unit -> ('k, 'a) table +val mk_map: cmp:('k -> 'k -> int) -> unit -> ('k, 'a) table (** Use a {!Map.S} underneath *) (** {2 Bags of vertices} *) @@ -104,7 +104,7 @@ val mk_heap: leq:('a -> 'a -> bool) -> 'a bag module Traverse : sig type ('v, 'e) path = ('v * 'e * 'v) list - val generic: ?tbl:'v set -> + val generic: tbl:'v set -> bag:'v bag -> graph:('v, 'e) t -> 'v sequence -> @@ -120,7 +120,7 @@ module Traverse : sig 'v sequence_once (** One-shot traversal of the graph using a tag set and the given bag *) - val dfs: ?tbl:'v set -> + val dfs: tbl:'v set -> graph:('v, 'e) t -> 'v sequence -> 'v sequence_once @@ -130,7 +130,7 @@ module Traverse : sig 'v sequence -> 'v sequence_once - val bfs: ?tbl:'v set -> + val bfs: tbl:'v set -> graph:('v, 'e) t -> 'v sequence -> 'v sequence_once @@ -140,7 +140,7 @@ module Traverse : sig 'v sequence -> 'v sequence_once - val dijkstra : ?tbl:'v set -> + val dijkstra : tbl:'v set -> ?dist:('e -> int) -> graph:('v, 'e) t -> 'v sequence -> @@ -174,15 +174,15 @@ module Traverse : sig val get_edge : ('v, 'e) t -> ('v * 'e * 'v) option val get_edge_kind : ('v, 'e) t -> ('v * 'e * 'v * edge_kind) option - val dfs: ?tbl:'v set -> - ?eq:('v -> 'v -> bool) -> + val dfs: tbl:'v set -> + eq:('v -> 'v -> bool) -> graph:('v, 'e) graph -> 'v sequence -> ('v,'e) t sequence_once (** Full version of DFS. @param eq equality predicate on vertices *) - val dfs_tag: ?eq:('v -> 'v -> bool) -> + val dfs_tag: eq:('v -> 'v -> bool) -> tags:'v tag_set -> graph:('v, 'e) graph -> 'v sequence -> @@ -195,7 +195,8 @@ end (** {2 Cycles} *) val is_dag : - ?tbl:'v set -> + tbl:'v set -> + eq:('v -> 'v -> bool) -> graph:('v, _) t -> 'v sequence -> bool @@ -207,9 +208,9 @@ val is_dag : exception Has_cycle -val topo_sort : ?eq:('v -> 'v -> bool) -> +val topo_sort : eq:('v -> 'v -> bool) -> ?rev:bool -> - ?tbl:'v set -> + tbl:'v set -> graph:('v, 'e) t -> 'v sequence -> 'v list @@ -224,7 +225,7 @@ val topo_sort : ?eq:('v -> 'v -> bool) -> [v'] occurs before [v]) @raise Has_cycle if the graph is not a DAG *) -val topo_sort_tag : ?eq:('v -> 'v -> bool) -> +val topo_sort_tag : eq:('v -> 'v -> bool) -> ?rev:bool -> tags:'v tag_set -> graph:('v, 'e) t -> @@ -245,7 +246,7 @@ module Lazy_tree : sig val fold_v : ('acc -> 'v -> 'acc) -> 'acc -> ('v, _) t -> 'acc end -val spanning_tree : ?tbl:'v set -> +val spanning_tree : tbl:'v set -> graph:('v, 'e) t -> 'v -> ('v, 'e) Lazy_tree.t @@ -262,7 +263,7 @@ val spanning_tree_tag : tags:'v tag_set -> type 'v scc_state (** Hidden state for {!scc} *) -val scc : ?tbl:('v, 'v scc_state) table -> +val scc : tbl:('v, 'v scc_state) table -> graph:('v, 'e) t -> 'v sequence -> 'v list sequence_once @@ -304,8 +305,8 @@ module Dot : sig type vertex_state (** Hidden state associated to a vertex *) - val pp : ?tbl:('v,vertex_state) table -> - ?eq:('v -> 'v -> bool) -> + val pp : tbl:('v,vertex_state) table -> + eq:('v -> 'v -> bool) -> ?attrs_v:('v -> attribute list) -> ?attrs_e:('e -> attribute list) -> ?name:string -> @@ -318,8 +319,8 @@ module Dot : sig @param attrs_e attributes for edges @param name name of the graph *) - val pp_seq : ?tbl:('v,vertex_state) table -> - ?eq:('v -> 'v -> bool) -> + val pp_seq : tbl:('v,vertex_state) table -> + eq:('v -> 'v -> bool) -> ?attrs_v:('v -> attribute list) -> ?attrs_e:('e -> attribute list) -> ?name:string -> @@ -340,7 +341,7 @@ type ('v, 'e) mut_graph = { remove : 'v -> unit; } -val mk_mut_tbl : ?eq:('v -> 'v -> bool) -> +val mk_mut_tbl : eq:('v -> 'v -> bool) -> ?hash:('v -> int) -> int -> ('v, 'a) mut_graph @@ -397,7 +398,7 @@ module Map(O : Map.OrderedType) : MAP with type vertex = O.t (** {2 Misc} *) -val of_list : ?eq:('v -> 'v -> bool) -> ('v * 'v) list -> ('v, unit) t +val of_list : eq:('v -> 'v -> bool) -> ('v * 'v) list -> ('v, unit) t (** [of_list l] makes a graph from a list of pairs of vertices. Each pair [(a,b)] is an edge from [a] to [b]. @param eq equality used to compare vertices *) diff --git a/src/data/CCHashTrie.ml b/src/data/CCHashTrie.ml index 926d13c8..8d5c93a0 100644 --- a/src/data/CCHashTrie.ml +++ b/src/data/CCHashTrie.ml @@ -24,7 +24,7 @@ module Transient = struct type state = { mutable frozen: bool } type t = Nil | St of state let empty = Nil - let equal a b = a==b + let equal a b = Pervasives.(==) a b let create () = St {frozen=false} let active = function Nil -> false | St st -> not st.frozen let frozen = function Nil -> true | St st -> st.frozen @@ -292,13 +292,15 @@ module Make(Key : KEY) val make : Key.t -> t val zero : t (* special "hash" *) val is_0 : t -> bool + val equal : t -> t -> bool val rem : t -> int (* [A.length_log] last bits *) val quotient : t -> t (* remove [A.length_log] last bits *) end = struct type t = int let make = Key.hash let zero = 0 - let is_0 h = h==0 + let is_0 h = h = 0 + let equal (a : int) b = Pervasives.(=) a b let rem h = h land (A.length - 1) let quotient h = h lsr A.length_log end @@ -407,14 +409,14 @@ module Make(Key : KEY) let rec add_ ~id k v ~h m = match m with | E -> S (h, k, v) | S (h', k', v') -> - if h=h' + if Hash.equal h h' then if Key.equal k k' then S (h, k, v) (* replace *) else L (h, Cons (k, v, Cons (k', v', Nil))) else make_array_ ~id ~leaf:(Cons (k', v', Nil)) ~h_leaf:h' k v ~h | L (h', l) -> - if h=h' + if Hash.equal h h' then L (h, add_list_ k v l) else (* split into N *) make_array_ ~id ~leaf:l ~h_leaf:h' k v ~h diff --git a/src/data/CCIntMap.ml b/src/data/CCIntMap.ml index cf2e6f82..52b45527 100644 --- a/src/data/CCIntMap.ml +++ b/src/data/CCIntMap.ml @@ -11,6 +11,7 @@ module Bit : sig type t = private int val highest : int -> t val min_int : t + val equal : t -> t -> bool val is_0 : bit:t -> int -> bool val is_1 : bit:t -> int -> bool val mask : mask:t -> int -> int (* zeroes the bit, puts all lower bits to 1 *) @@ -21,6 +22,8 @@ end = struct let min_int = min_int + let equal = (=) + let rec highest_bit_naive x m = if x=m then m else highest_bit_naive (x land (lnot m)) (2*m) @@ -237,11 +240,11 @@ let update k f t = let doubleton k1 v1 k2 v2 = add k1 v1 (singleton k2 v2) -let rec equal ~eq a b = a==b || match a, b with +let rec equal ~eq a b = Pervasives.(==) a b || match a, b with | E, E -> true | L (ka, va), L (kb, vb) -> ka = kb && eq va vb | N (pa, sa, la, ra), N (pb, sb, lb, rb) -> - pa=pb && sa=sb && equal ~eq la lb && equal ~eq ra rb + pa=pb && Bit.equal sa sb && equal ~eq la lb && equal ~eq ra rb | E, _ | N _, _ | L _, _ -> false @@ -287,7 +290,7 @@ let choose t = with Not_found -> None let rec union f t1 t2 = - if t1==t2 then t1 + if Pervasives.(==) t1 t2 then t1 else match t1, t2 with | E, o | o, E -> o | L (k, v), o @@ -295,7 +298,7 @@ let rec union f t1 t2 = (* insert k, v into o *) insert_ (fun ~old v -> f k old v) k v o | N (p1, m1, l1, r1), N (p2, m2, l2, r2) -> - if p1 = p2 && m1 = m2 + if p1 = p2 && Bit.equal m1 m2 then mk_node_ p1 m1 (union f l1 l2) (union f r1 r2) else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1 then if Bit.is_0 p2 ~bit:m1 @@ -342,7 +345,7 @@ let rec union f t1 t2 = *) let rec inter f a b = - if a==b then a + if Pervasives.(==) a b then a else match a, b with | E, _ | _, E -> E | L (k, v), o @@ -353,7 +356,7 @@ let rec inter f a b = with Not_found -> E end | N (p1, m1, l1, r1), N (p2, m2, l2, r2) -> - if p1 = p2 && m1 = m2 + if p1 = p2 && Bit.equal m1 m2 then mk_node_ p1 m1 (inter f l1 l2) (inter f r1 r2) else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1 then if Bit.is_0 p2 ~bit:m1 @@ -466,7 +469,7 @@ let compare ~cmp a b = then let c = cmp va vb in if c=0 then cmp_gen cmp a b else c - else Pervasives.compare ka kb + else compare ka kb in cmp_gen cmp (to_gen a) (to_gen b) diff --git a/src/data/CCMixmap.ml b/src/data/CCMixmap.ml index 8c162a36..616aca2b 100644 --- a/src/data/CCMixmap.ml +++ b/src/data/CCMixmap.ml @@ -123,9 +123,13 @@ module Make(X : ORD) : S with type key = X.t = struct let remove = M.remove + let is_some = function + | None -> false + | Some _ -> true + let mem ~inj x map = try - inj.get (M.find x map) <> None + is_some (inj.get (M.find x map)) with Not_found -> false let iter_keys ~f map = diff --git a/src/data/CCMixtbl.ml b/src/data/CCMixtbl.ml index 8d1d9f73..e697a72e 100644 --- a/src/data/CCMixtbl.ml +++ b/src/data/CCMixtbl.ml @@ -84,9 +84,13 @@ let remove tbl x = Hashtbl.remove tbl x let copy tbl = Hashtbl.copy tbl +let is_some = function + | None -> false + | Some _ -> true + let mem ~inj tbl x = try - inj.get (Hashtbl.find tbl x) <> None + is_some (inj.get (Hashtbl.find tbl x)) with Not_found -> false (*$R diff --git a/src/data/CCMultiSet.ml b/src/data/CCMultiSet.ml index 39d13019..9e9a01cb 100644 --- a/src/data/CCMultiSet.ml +++ b/src/data/CCMultiSet.ml @@ -5,6 +5,9 @@ type 'a sequence = ('a -> unit) -> unit +let max_int = max +let min_int = min + module type S = sig type elt type t @@ -172,7 +175,7 @@ module Make(O : Set.OrderedType) = struct (fun _ n1 n2 -> match n1, n2 with | None, None -> assert false | Some n, None | None, Some n -> Some n - | Some n1, Some n2 -> Some (Pervasives.max n1 n2)) + | Some n1, Some n2 -> Some (max_int n1 n2)) m1 m2 let intersection m1 m2 = @@ -181,7 +184,7 @@ module Make(O : Set.OrderedType) = struct | None, None -> assert false | Some _, None | None, Some _ -> None - | Some n1, Some n2 -> Some (Pervasives.min n1 n2)) + | Some n1, Some n2 -> Some (min_int n1 n2)) m1 m2 let diff m1 m2 = diff --git a/src/data/CCRAL.ml b/src/data/CCRAL.ml index 5d9aa245..e540b755 100644 --- a/src/data/CCRAL.ml +++ b/src/data/CCRAL.ml @@ -96,7 +96,7 @@ let tl l = match l with (*$Q Q.(list_of_size Gen.(1--100) int) (fun l -> \ let l' = of_list l in \ - (not (is_empty l')) ==> (equal l' (cons (hd l') (tl l'))) ) + (not (is_empty l')) ==> (equal ~eq:CCInt.equal l' (cons (hd l') (tl l'))) ) *) let front l = match l with @@ -371,7 +371,7 @@ let drop_while ~f l = let take_drop n l = take n l, drop n l -let equal ?(eq=(=)) l1 l2 = +let equal ~eq l1 l2 = let rec aux ~eq l1 l2 = match l1, l2 with | Nil, Nil -> true | Cons (size1, t1, l1'), Cons (size2, t2, l2') -> @@ -389,7 +389,7 @@ let equal ?(eq=(=)) l1 l2 = (*$Q Q.(pair (list int)(list int)) (fun (l1,l2) -> \ - equal (of_list l1) (of_list l2) = (l1=l2)) + equal ~eq:CCInt.equal (of_list l1) (of_list l2) = (l1=l2)) *) (** {2 Utils} *) @@ -543,7 +543,7 @@ let rec of_list_map ~f l = match l with let y = f x in cons y (of_list_map ~f l') -let compare ?(cmp=Pervasives.compare) l1 l2 = +let compare ~cmp l1 l2 = let rec cmp_gen ~cmp g1 g2 = match g1(), g2() with | None, None -> 0 | Some _, None -> 1 @@ -556,7 +556,7 @@ let compare ?(cmp=Pervasives.compare) l1 l2 = (*$Q Q.(pair (list int)(list int)) (fun (l1,l2) -> \ - compare (of_list l1) (of_list l2) = (Pervasives.compare l1 l2)) + compare ~cmp:CCInt.compare (of_list l1) (of_list l2) = (Pervasives.compare l1 l2)) *) (** {2 Infix} *) diff --git a/src/data/CCRAL.mli b/src/data/CCRAL.mli index 0e76eca3..70f7f12b 100644 --- a/src/data/CCRAL.mli +++ b/src/data/CCRAL.mli @@ -109,9 +109,9 @@ val rev_map : f:('a -> 'b) -> 'a t -> 'b t val rev : 'a t -> 'a t (** Reverse the list *) -val equal : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool +val equal : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool -val compare : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int +val compare : cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int (** Lexicographic comparison *) (** {2 Utils} *) diff --git a/src/data/CCSimple_queue.ml b/src/data/CCSimple_queue.ml index ed9b639c..1eea0162 100644 --- a/src/data/CCSimple_queue.ml +++ b/src/data/CCSimple_queue.ml @@ -23,7 +23,11 @@ let make_ hd tl = match hd with | [] -> {hd=List.rev tl; tl=[] } | _::_ -> {hd; tl; } -let is_empty q = q.hd = [] +let list_is_empty = function + | [] -> true + | _::_ -> false + +let is_empty q = list_is_empty q.hd let push x q = make_ q.hd (x :: q.tl) @@ -31,7 +35,7 @@ let snoc q x = push x q let peek_exn q = match q.hd with - | [] -> assert (q.tl = []); invalid_arg "Queue.peek" + | [] -> assert (list_is_empty q.tl); invalid_arg "Queue.peek" | x::_ -> x let peek q = match q.hd with @@ -40,7 +44,7 @@ let peek q = match q.hd with let pop_exn q = match q.hd with - | [] -> assert (q.tl = []); invalid_arg "Queue.peek" + | [] -> assert (list_is_empty q.tl); invalid_arg "Queue.peek" | x::hd' -> let q' = make_ hd' q.tl in x, q' diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml index d7f8b9f7..c5beeae7 100644 --- a/src/data/CCTrie.ml +++ b/src/data/CCTrie.ml @@ -527,7 +527,7 @@ module Make(W : WORD) | Empty -> 0 | Cons (_, t') -> size t' | Node (v, map) -> - let s = if v=None then 0 else 1 in + let s = match v with None -> 0 | Some _ -> 1 in M.fold (fun _ t' acc -> size t' + acc) map s diff --git a/src/iter/CCKList.ml b/src/iter/CCKList.ml index 13b0ae44..28be96a6 100644 --- a/src/iter/CCKList.ml +++ b/src/iter/CCKList.ml @@ -422,11 +422,11 @@ let of_gen g = assert_equal [11;12] (drop 10 l |> take 2 |> to_list); *) -let sort ?(cmp=Pervasives.compare) l = +let sort ~cmp l = let l = to_list l in of_list (List.sort cmp l) -let sort_uniq ?(cmp=Pervasives.compare) l = +let sort_uniq ~cmp l = let l = to_list l in uniq (fun x y -> cmp x y = 0) (of_list (List.sort cmp l)) diff --git a/src/iter/CCKList.mli b/src/iter/CCKList.mli index e304138d..8c027470 100644 --- a/src/iter/CCKList.mli +++ b/src/iter/CCKList.mli @@ -164,12 +164,12 @@ val unzip : ('a * 'b) t -> 'a t * 'b t (** {2 Misc} *) -val sort : ?cmp:'a ord -> 'a t -> 'a t +val sort : cmp:'a ord -> 'a t -> 'a t (** Eager sort. Requires the iterator to be finite. O(n ln(n)) time and space. @since 0.3.3 *) -val sort_uniq : ?cmp:'a ord -> 'a t -> 'a t +val sort_uniq : cmp:'a ord -> 'a t -> 'a t (** Eager sort that removes duplicate values. Requires the iterator to be finite. O(n ln(n)) time and space. @since 0.3.3 *) diff --git a/src/iter/CCKTree.ml b/src/iter/CCKTree.ml index eae5a29c..2e041847 100644 --- a/src/iter/CCKTree.ml +++ b/src/iter/CCKTree.ml @@ -91,7 +91,7 @@ class type ['a] pset = object method mem : 'a -> bool end -let set_of_cmp (type elt) ?(cmp=Pervasives.compare) () = +let set_of_cmp (type elt) ~cmp () = let module S = Set.Make(struct type t = elt let compare = cmp @@ -105,7 +105,7 @@ let set_of_cmp (type elt) ?(cmp=Pervasives.compare) () = let _nil () = `Nil let _cons x l = `Cons (x, l) -let dfs ?(pset=set_of_cmp ()) t = +let dfs ~pset t = let rec dfs pset stack () = match stack with | [] -> `Nil | `Explore t :: stack' -> @@ -141,19 +141,23 @@ module FQ = struct let empty = _make [] [] - let is_empty q = q.hd = [] + let list_is_empty = function + | [] -> true + | _::_ -> false + + let is_empty q = list_is_empty q.hd let push q x = _make q.hd (x::q.tl) let pop_exn q = match q.hd with - | [] -> assert (q.tl = []); raise Empty + | [] -> assert (list_is_empty q.tl); raise Empty | x::hd' -> let q' = _make hd' q.tl in x, q' end -let bfs ?(pset=set_of_cmp ()) t = +let bfs ~pset t = let rec bfs pset q () = if FQ.is_empty q then `Nil else @@ -173,7 +177,7 @@ let rec force t : ([`Nil | `Node of 'a * 'b list] as 'b) = match t() with | `Nil -> `Nil | `Node (x, l) -> `Node (x, List.map force l) -let find ?pset f t = +let find ~pset f t = let rec _find_kl f l = match l() with | `Nil -> None | `Cons (x, l') -> @@ -181,7 +185,7 @@ let find ?pset f t = | None -> _find_kl f l' | Some _ as res -> res in - _find_kl f (bfs ?pset t) + _find_kl f (bfs ~pset t) (** {2 Pretty-printing} *) diff --git a/src/iter/CCKTree.mli b/src/iter/CCKTree.mli index fadf711c..9ef94fdd 100644 --- a/src/iter/CCKTree.mli +++ b/src/iter/CCKTree.mli @@ -80,13 +80,13 @@ class type ['a] pset = object method mem : 'a -> bool end -val set_of_cmp : ?cmp:('a -> 'a -> int) -> unit -> 'a pset +val set_of_cmp : cmp:('a -> 'a -> int) -> unit -> 'a pset (** Build a set structure given a total ordering *) -val dfs : ?pset:'a pset -> 'a t -> [ `Enter of 'a | `Exit of 'a ] klist +val dfs : pset:'a pset -> 'a t -> [ `Enter of 'a | `Exit of 'a ] klist (** Depth-first traversal of the tree *) -val bfs : ?pset:'a pset -> 'a t -> 'a klist +val bfs : pset:'a pset -> 'a t -> 'a klist (** Breadth-first traversal of the tree *) val force : 'a t -> ([ `Nil | `Node of 'a * 'b list ] as 'b) @@ -94,7 +94,7 @@ val force : 'a t -> ([ `Nil | `Node of 'a * 'b list ] as 'b) structure @since 0.13 *) -val find : ?pset:'a pset -> ('a -> 'b option) -> 'a t -> 'b option +val find : pset:'a pset -> ('a -> 'b option) -> 'a t -> 'b option (** Look for an element that maps to [Some _] *) (** {2 Pretty-printing} diff --git a/src/monomorphic/CCMonomorphic.ml b/src/monomorphic/CCMonomorphic.ml new file mode 100644 index 00000000..3817b80a --- /dev/null +++ b/src/monomorphic/CCMonomorphic.ml @@ -0,0 +1,6 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +include Pervasives + +let (==) = `Consider_using_CCEqual_physical diff --git a/src/monomorphic/CCMonomorphic.mli b/src/monomorphic/CCMonomorphic.mli new file mode 100644 index 00000000..d11e1514 --- /dev/null +++ b/src/monomorphic/CCMonomorphic.mli @@ -0,0 +1,19 @@ + +(* This file is free software, part of containers. See file "license" for more details. *) + +(** {1 Shadow unsafe functions and operators from Pervasives} *) +(** @since NEXT_RELEASE *) + +val (=) : int -> int -> bool +val (<>) : int -> int -> bool +val (<) : int -> int -> bool +val (>) : int -> int -> bool +val (<=) : int -> int -> bool +val (>=) : int -> int -> bool + +val compare : int -> int -> int +val min : int -> int -> int +val max : int -> int -> int + +val (==) : [`Consider_using_CCEqual_physical] +[@@ocaml.deprecated "Please use CCEqual.physical or Pervasives.(==) instead."] diff --git a/src/sexp/CCSexp.ml b/src/sexp/CCSexp.ml index 6e5d96a0..25857c31 100644 --- a/src/sexp/CCSexp.ml +++ b/src/sexp/CCSexp.ml @@ -13,9 +13,32 @@ type t = [ ] type sexp = t -let equal a b = a = b +let equal_string (a : string) b = Pervasives.(=) a b -let compare a b = Pervasives.compare a b +let rec equal a b = match a, b with + | `Atom s1, `Atom s2 -> + equal_string s1 s2 + | `List l1, `List l2 -> + begin try List.for_all2 equal l1 l2 with Invalid_argument _ -> false end + | `Atom _, _ | `List _, _ -> false + +let compare_string (a : string) b = Pervasives.compare a b + +let rec compare_list a b = match a, b with + | [], [] -> 0 + | [], _::_ -> -1 + | _::_, [] -> 1 + | x::xs, y::ys -> + begin match compare x y with + | 0 -> compare_list xs ys + | c -> c + end + +and compare a b = match a, b with + | `Atom s1, `Atom s2 -> compare_string s1 s2 + | `List l1, `List l2 -> compare_list l1 l2 + | `Atom _, _ -> -1 + | `List _, _ -> 1 let hash a = Hashtbl.hash a diff --git a/src/sexp/CCSexp_lex.mll b/src/sexp/CCSexp_lex.mll index c67e66eb..024d0a6b 100644 --- a/src/sexp/CCSexp_lex.mll +++ b/src/sexp/CCSexp_lex.mll @@ -20,9 +20,11 @@ | Escaped_int_1 of int | Escaped_int_2 of int + let char_equal (a : char) b = Pervasives.(=) a b + (* remove quotes + unescape *) let remove_quotes lexbuf s = - assert (s.[0] = '"' && s.[String.length s - 1] = '"'); + assert (char_equal s.[0] '"' && char_equal s.[String.length s - 1] '"'); let buf = Buffer.create (String.length s) in let st = ref Not_escaped in for i = 1 to String.length s-2 do @@ -72,4 +74,3 @@ rule token = parse | string { ATOM (remove_quotes lexbuf (Lexing.lexeme lexbuf)) } | _ as c { error lexbuf (Printf.sprintf "lexing failed on char `%c`" c) } - diff --git a/src/threads/CCPool.ml b/src/threads/CCPool.ml index 914461cc..af8ab6ba 100644 --- a/src/threads/CCPool.ml +++ b/src/threads/CCPool.ml @@ -314,11 +314,15 @@ module Make(P : PARAM) = struct | Run cell -> with_lock_ cell (fun cell -> cell.state) + let is_not_waiting = function + | Waiting -> false + | Failed _ | Done _ -> true + let is_done = function | Return _ | FailNow _ -> true | Run cell -> - with_lock_ cell (fun c -> c.state <> Waiting) + with_lock_ cell (fun c -> is_not_waiting c.state) (** {2 Combinators *) diff --git a/src/threads/CCTimer.ml b/src/threads/CCTimer.ml index f2c37cb8..9ad6e2c4 100644 --- a/src/threads/CCTimer.ml +++ b/src/threads/CCTimer.ml @@ -6,6 +6,11 @@ type job = | Job : float * (unit -> 'a) -> job +let (<=) (a : float) b = Pervasives.(<=) a b +let (>=) (a : float) b = Pervasives.(>=) a b +let (<) (a : float) b = Pervasives.(<) a b +let (>) (a : float) b = Pervasives.(>) a b + module TaskHeap = CCHeap.Make(struct type t = job let leq (Job(f1,_)) (Job (f2,_)) = f1 <= f2