Merge pull request #169 from jpdeplaix/CCMonomorphic

Add `CCMonomorphic`, make most optional arguments that rely on poly operators mandatory.
This commit is contained in:
Simon Cruanes 2018-01-14 17:34:53 -06:00 committed by GitHub
commit 2c9a1d70c9
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
55 changed files with 509 additions and 359 deletions

View file

@ -4,6 +4,7 @@ S src/iter/
S src/sexp/ S src/sexp/
S src/threads/ S src/threads/
S src/string S src/string
S src/monomorphic
S benchs S benchs
S examples S examples
S tests S tests
@ -19,3 +20,4 @@ PKG threads.posix
PKG lwt PKG lwt
PKG qcheck PKG qcheck
FLG -w +a-4-44-48-60@8 FLG -w +a-4-44-48-60@8
FLG -open CCMonomorphic

16
_oasis
View file

@ -44,20 +44,26 @@ Library "containers"
CCInt64, CCChar, CCResult, CCParse, CCArray_slice, CCInt64, CCChar, CCResult, CCParse, CCArray_slice,
CCListLabels, CCArrayLabels, CCEqual, CCListLabels, CCArrayLabels, CCEqual,
Containers Containers
BuildDepends: bytes, result BuildDepends: bytes, result, containers.monomorphic
# BuildDepends: bytes, bisect_ppx # BuildDepends: bytes, bisect_ppx
Library "containers_monomorphic"
Path: src/monomorphic
Modules: CCMonomorphic
FindlibParent: containers
FindlibName: monomorphic
Library "containers_unix" Library "containers_unix"
Path: src/unix Path: src/unix
Modules: CCUnix Modules: CCUnix
BuildDepends: bytes, result, unix BuildDepends: bytes, result, unix, containers.monomorphic
FindlibParent: containers FindlibParent: containers
FindlibName: unix FindlibName: unix
Library "containers_sexp" Library "containers_sexp"
Path: src/sexp Path: src/sexp
Modules: CCSexp, CCSexp_lex Modules: CCSexp, CCSexp_lex
BuildDepends: bytes, result BuildDepends: bytes, result, containers.monomorphic
FindlibParent: containers FindlibParent: containers
FindlibName: sexp FindlibName: sexp
@ -69,7 +75,7 @@ Library "containers_data"
CCMixset, CCGraph, CCHashSet, CCBitField, CCMixset, CCGraph, CCHashSet, CCBitField,
CCHashTrie, CCWBTree, CCRAL, CCSimple_queue, CCHashTrie, CCWBTree, CCRAL, CCSimple_queue,
CCImmutArray, CCHet, CCZipper CCImmutArray, CCHet, CCZipper
BuildDepends: bytes BuildDepends: bytes, containers.monomorphic
# BuildDepends: bytes, bisect_ppx # BuildDepends: bytes, bisect_ppx
FindlibParent: containers FindlibParent: containers
FindlibName: data FindlibName: data
@ -77,6 +83,7 @@ Library "containers_data"
Library "containers_iter" Library "containers_iter"
Path: src/iter Path: src/iter
Modules: CCKTree, CCKList, CCLazy_list Modules: CCKTree, CCKList, CCLazy_list
BuildDepends: containers.monomorphic
FindlibParent: containers FindlibParent: containers
FindlibName: iter FindlibName: iter
@ -120,6 +127,7 @@ Executable run_benchs
MainIs: run_benchs.ml MainIs: run_benchs.ml
BuildDepends: containers, qcheck, BuildDepends: containers, qcheck,
containers.data, containers.iter, containers.thread, containers.data, containers.iter, containers.thread,
containers.monomorphic,
sequence, gen, benchmark sequence, gen, benchmark
Executable run_bench_hash Executable run_bench_hash

1
_tags
View file

@ -161,3 +161,4 @@ true: annot, bin_annot
<src/**/*.ml> and not <src/misc/*.ml>: warn(+a-4-44-58-60@8) <src/**/*.ml> and not <src/misc/*.ml>: warn(+a-4-44-58-60@8)
true: no_alias_deps, safe_string, short_paths, color(always) true: no_alias_deps, safe_string, short_paths, color(always)
<src/**/*Labels.cm*>: nolabels <src/**/*Labels.cm*>: nolabels
not (<src/monomorphic/CCMonomorphic.*> or <qtest/*>): open(CCMonomorphic)

View file

@ -280,7 +280,7 @@ module Arr = struct
let a2 = Array.copy a1 in let a2 = Array.copy a1 in
sort_std a1; sort_std a1;
quicksort ~limit:10 a2; quicksort ~limit:10 a2;
assert (a1 = a2)) assert (CCArray.equal CCInt.equal a1 a2))
[ 10; 100; 1000] [ 10; 100; 1000]
let bench_sort ?(time=2) n = let bench_sort ?(time=2) n =
@ -366,16 +366,16 @@ module Cache = struct
let bench_fib n = let bench_fib n =
let l = let l =
[ "replacing_fib (128)", make_fib (C.replacing 128), n [ "replacing_fib (128)", make_fib (C.replacing ~eq:CCInt.equal 128), n
; "LRU_fib (128)", make_fib (C.lru 128), n ; "LRU_fib (128)", make_fib (C.lru ~eq:CCInt.equal 128), n
; "replacing_fib (16)", make_fib (C.replacing 16), n ; "replacing_fib (16)", make_fib (C.replacing ~eq:CCInt.equal 16), n
; "LRU_fib (16)", make_fib (C.lru 16), n ; "LRU_fib (16)", make_fib (C.lru ~eq:CCInt.equal 16), n
; "unbounded", make_fib (C.unbounded 32), n ; "unbounded", make_fib (C.unbounded ~eq:CCInt.equal 32), n
] ]
in in
let l = if n <= 20 let l = if n <= 20
then [ "linear_fib (5)", make_fib (C.linear 5), n then [ "linear_fib (5)", make_fib (C.linear ~eq:CCInt.equal 5), n
; "linear_fib (32)", make_fib (C.linear 32), n ; "linear_fib (32)", make_fib (C.linear ~eq:CCInt.equal 32), n
; "dummy_fib", make_fib C.dummy, n ; "dummy_fib", make_fib C.dummy, n
] @ l ] @ l
else l else l
@ -862,7 +862,7 @@ module Deque = struct
let take_back d = let take_back d =
match !d with match !d with
| None -> raise Empty | None -> raise Empty
| Some first when first == first.prev -> | Some first when Pervasives.(==) first first.prev ->
(* only one element *) (* only one element *)
d := None; d := None;
first.content first.content
@ -875,7 +875,7 @@ module Deque = struct
let take_front d = let take_front d =
match !d with match !d with
| None -> raise Empty | None -> raise Empty
| Some first when first == first.prev -> | Some first when Pervasives.(==) first first.prev ->
(* only one element *) (* only one element *)
d := None; d := None;
first.content first.content
@ -1045,7 +1045,7 @@ module Graph = struct
let dfs_event n () = let dfs_event n () =
let tbl = CCGraph.mk_table ~eq:CCInt.equal ~hash:CCInt.hash (n+10) in 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.return n)
|> Sequence.fold |> Sequence.fold
(fun acc -> function (fun acc -> function
@ -1154,7 +1154,7 @@ module Str = struct
and mk_current () = CCString.find_all_l ~sub:needle haystack and mk_current () = CCString.find_all_l ~sub:needle haystack
and mk_current_compiled = and mk_current_compiled =
let f = CCString.find_all_l ~start:0 ~sub:needle in fun () -> f haystack in 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 B.throughputN 3 ~repeat
[ "naive", mk_naive, () [ "naive", mk_naive, ()
; "current", mk_current, () ; "current", mk_current, ()
@ -1168,7 +1168,7 @@ module Str = struct
pp_pb needle haystack; pp_pb needle haystack;
let mk_naive () = find_all_l ~sub:needle haystack let mk_naive () = find_all_l ~sub:needle haystack
and mk_current () = CCString.find_all_l ~sub:needle haystack in and mk_current () = CCString.find_all_l ~sub:needle haystack in
assert (mk_naive () = mk_current ()); assert (CCList.equal CCInt.equal (mk_naive ()) (mk_current ()));
B.throughputN 3 ~repeat B.throughputN 3 ~repeat
[ "naive", mk_naive, () [ "naive", mk_naive, ()
; "current", mk_current, () ; "current", mk_current, ()
@ -1182,7 +1182,7 @@ module Str = struct
let rec same s1 s2 i = let rec same s1 s2 i =
if i = String.length s1 then true if i = String.length s1 then true
else ( 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 in
String.length pre <= String.length s && String.length pre <= String.length s &&
@ -1193,7 +1193,7 @@ module Str = struct
begin begin
let i = ref 0 in let i = ref 0 in
while !i < String.length pre && 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; do incr i done;
!i = String.length pre !i = String.length pre
end end
@ -1225,7 +1225,7 @@ module Str = struct
else else
let rec loop str p i = let rec loop str p i =
if i = len then true 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) else loop str p (i + 1)
in loop str p 0 in loop str p 0
@ -1256,7 +1256,7 @@ module Str = struct
Array.iteri Array.iteri
(fun i (pre, y) -> (fun i (pre, y) ->
let res = f ~pre y in let res = f ~pre y in
assert (res = output.(i))) assert (CCBool.equal res output.(i)))
input input
in in
Benchmark.throughputN 3 Benchmark.throughputN 3

2
opam
View file

@ -39,6 +39,6 @@ conflicts: [
tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ] tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ]
homepage: "https://github.com/c-cube/ocaml-containers/" homepage: "https://github.com/c-cube/ocaml-containers/"
doc: "http://cedeela.fr/~simon/software/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" dev-repo: "https://github.com/c-cube/ocaml-containers.git"
bug-reports: "https://github.com/c-cube/ocaml-containers/issues/" bug-reports: "https://github.com/c-cube/ocaml-containers/issues/"

View file

@ -176,8 +176,7 @@ let sort_indices cmp a =
*) *)
let sort_ranking cmp a = let sort_ranking cmp a =
let cmp_int : int -> int -> int = Pervasives.compare in sort_indices compare (sort_indices cmp a)
sort_indices cmp_int (sort_indices cmp a)
(*$= & ~cmp:(=) ~printer:Q.Print.(array int) (*$= & ~cmp:(=) ~printer:Q.Print.(array int)
[||] (sort_ranking Pervasives.compare [||]) [||] (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) | n when n<0 -> _lookup_rec ~cmp k a (i+1) (j-1)
| _ -> raise Not_found (* too high *) | _ -> 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) _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)) try Some (_lookup_exn ~cmp k a 0 (Array.length a-1))
with Not_found -> None with Not_found -> None
(*$T (*$T
lookup 2 [|0;1;2;3;4;5|] = Some 2 lookup ~cmp:CCInt.compare 2 [|0;1;2;3;4;5|] = Some 2
lookup 4 [|0;1;2;3;4;5|] = Some 4 lookup ~cmp:CCInt.compare 4 [|0;1;2;3;4;5|] = Some 4
lookup 0 [|1;2;3;4;5|] = None lookup ~cmp:CCInt.compare 0 [|1;2;3;4;5|] = None
lookup 6 [|1;2;3;4;5|] = None lookup ~cmp:CCInt.compare 6 [|1;2;3;4;5|] = None
lookup 3 [| |] = None lookup ~cmp:CCInt.compare 3 [| |] = None
lookup 1 [| 1 |] = Some 0 lookup ~cmp:CCInt.compare 1 [| 1 |] = Some 0
lookup 2 [| 1 |] = None lookup ~cmp:CCInt.compare 2 [| 1 |] = None
*) *)
let bsearch ?(cmp=Pervasives.compare) k a = let bsearch ~cmp k a =
let rec aux i j = let rec aux i j =
if i > j if i > j
then `Just_after j then `Just_after j
@ -333,13 +332,13 @@ let bsearch ?(cmp=Pervasives.compare) k a =
| _ -> aux 0 (n-1) | _ -> aux 0 (n-1)
(*$T bsearch (*$T bsearch
bsearch 3 [|1; 2; 2; 3; 4; 10|] = `At 3 bsearch ~cmp:CCInt.compare 3 [|1; 2; 2; 3; 4; 10|] = `At 3
bsearch 5 [|1; 2; 2; 3; 4; 10|] = `Just_after 4 bsearch ~cmp:CCInt.compare 5 [|1; 2; 2; 3; 4; 10|] = `Just_after 4
bsearch 1 [|1; 2; 5; 5; 11; 12|] = `At 0 bsearch ~cmp:CCInt.compare 1 [|1; 2; 5; 5; 11; 12|] = `At 0
bsearch 12 [|1; 2; 5; 5; 11; 12|] = `At 5 bsearch ~cmp:CCInt.compare 12 [|1; 2; 5; 5; 11; 12|] = `At 5
bsearch 10 [|1; 2; 2; 3; 4; 9|] = `All_lower bsearch ~cmp:CCInt.compare 10 [|1; 2; 2; 3; 4; 9|] = `All_lower
bsearch 0 [|1; 2; 2; 3; 4; 9|] = `All_bigger bsearch ~cmp:CCInt.compare 0 [|1; 2; 2; 3; 4; 9|] = `All_bigger
bsearch 3 [| |] = `Empty bsearch ~cmp:CCInt.compare 3 [| |] = `Empty
*) *)
let (>>=) a f = flat_map f a let (>>=) a f = flat_map f a
@ -664,7 +663,7 @@ end
let sort_generic (type arr)(type elt) let sort_generic (type arr)(type elt)
(module A : MONO_ARRAY with type t = arr and type elt = 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 let module S = SortGeneric(A) in
S.sort ~cmp a S.sort ~cmp a

View file

@ -119,18 +119,18 @@ val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option
and [p x] holds. Otherwise returns [None] and [p x] holds. Otherwise returns [None]
@since 0.3.4 *) @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. (** Lookup the index of some value in a sorted array.
Undefined behavior if the array is not sorted wrt [cmp]. Undefined behavior if the array is not sorted wrt [cmp].
Complexity: [O(log (n))] (dichotomic search). Complexity: [O(log (n))] (dichotomic search).
@return [None] if the key is not present, or @return [None] if the key is not present, or
[Some i] ([i] the index of the key) otherwise *) [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 (** Same as {!lookup}, but
@raise Not_found if the key is not present *) @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 ] [ `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], (** [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, provided [arr] is {b sorted} using [cmp]. If the array is not sorted,
@ -256,7 +256,7 @@ end
val sort_generic : val sort_generic :
(module MONO_ARRAY with type t = 'arr and type elt = 'elt) -> (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 (** Sort the array, without allocating (eats stack space though). Performance
might be lower than {!Array.sort}. might be lower than {!Array.sort}.
@since 0.14 *) @since 0.14 *)

View file

@ -90,16 +90,16 @@ val find_idx : f:('a -> bool) -> 'a t -> (int * 'a) option
and [p x] holds. Otherwise returns [None] and [p x] holds. Otherwise returns [None]
@since 0.3.4 *) @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. (** Lookup the index of some value in a sorted array.
@return [None] if the key is not present, or @return [None] if the key is not present, or
[Some i] ([i] the index of the key) otherwise *) [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 (** Same as {!lookup_exn}, but
@raise Not_found if the key is not present *) @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 ] [ `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], (** [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, provided [arr] is {b sorted} using [cmp]. If the array is not sorted,
@ -225,7 +225,7 @@ end
val sort_generic : val sort_generic :
(module MONO_ARRAY with type t = 'arr and type elt = 'elt) -> (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 (** Sort the array, without allocating (eats stack space though). Performance
might be lower than {!Array.sort}. might be lower than {!Array.sort}.
@since 0.14 *) @since 0.14 *)

View file

@ -85,6 +85,7 @@ let rec _compare cmp a1 i1 j1 a2 i2 j2 =
let equal eq a b = let equal eq a b =
length a = length b && _equal eq a.arr a.i a.j b.arr b.i b.j 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 = let compare cmp a b =
_compare cmp a.arr a.i a.j b.arr b.i b.j _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 sort_ranking cmp a =
let idx = _sort_indices cmp a.arr a.i a.j in 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 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) (*$= & ~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)) (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 _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) try Some (_lookup_exn ~cmp k a.arr a.i (a.j-1) - a.i)
with Not_found -> None 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 match bsearch_ ~cmp k a.arr a.i (a.j - 1) with
| `At m -> `At (m - a.i) | `At m -> `At (m - a.i)
| `Just_after m -> `Just_after (m - a.i) | `Just_after m -> `Just_after (m - a.i)

View file

@ -86,10 +86,10 @@ val sorted : ('a -> 'a -> int) -> 'a t -> 'a array
val sort_indices : ('a -> 'a -> int) -> 'a t -> int 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], (** [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. 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}. [sort_indices] yields the inverse permutation of {!sort_ranking}.
@since 1.0 *) @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 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 [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}. [sort_ranking] yields the inverse permutation of {!sort_indices}.
In the absence of duplicate elements in [a], we also have 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] and [p x] holds. Otherwise returns [None]
@since 0.3.4 *) @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. (** Lookup the index of some value in a sorted array.
@return [None] if the key is not present, or @return [None] if the key is not present, or
[Some i] ([i] the index of the key) otherwise *) [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 (** Same as {!lookup}, but
@raise Not_found if the key is not present *) @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 ] [ `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], (** [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, provided [arr] is {b sorted} using [cmp]. If the array is not sorted,

View file

@ -3,7 +3,7 @@
type t = bool 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 let compare (a:bool) b = Pervasives.compare a b

View file

@ -6,7 +6,7 @@
include Char include Char
let equal (a:char) b = a=b let equal (a:char) b = Pervasives.(=) a b
let pp = Buffer.add_char let pp = Buffer.add_char
let print = Format.pp_print_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 of_int c = try Some (of_int_exn c) with _ -> None
let to_int = Char.code let to_int = Char.code
let lowercase_ascii c = let lowercase_ascii = function
if c >= 'A' && c <= 'Z' | 'A'..'Z' as c -> Char.unsafe_chr (Char.code c + 32)
then Char.unsafe_chr (Char. code c + 32) | c -> c
else c
let uppercase_ascii c = let uppercase_ascii = function
if c >= 'a' && c <= 'z' | 'a'..'z' as c -> Char.unsafe_chr (Char.code c - 32)
then Char.unsafe_chr (Char.code c - 32) | c -> c
else c

View file

@ -5,12 +5,13 @@
type 'a t = 'a -> 'a -> bool type 'a t = 'a -> 'a -> bool
let poly = (=) let poly = Pervasives.(=)
let physical = Pervasives.(==)
let int : int t = (=) let int : int t = (=)
let string : string t = (=) let string : string t = Pervasives.(=)
let bool : bool t = (=) let bool : bool t = Pervasives.(=)
let float : float t = (=) let float : float t = Pervasives.(=)
let unit () () = true let unit () () = true
let rec list f l1 l2 = match l1, l2 with let rec list f l1 l2 = match l1, l2 with

View file

@ -11,6 +11,10 @@ type 'a t = 'a -> 'a -> bool
val poly : 'a t val poly : 'a t
(** Standard polymorphic equality *) (** Standard polymorphic equality *)
val physical : 'a t
(** Standard physical equality
@since NEXT_RELEASE *)
val int : int t val int : int t
val string : string t val string : string t
val bool : bool t val bool : bool t

View file

@ -9,6 +9,16 @@ type fpclass = Pervasives.fpclass =
| FP_infinite | FP_infinite
| FP_nan | 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 nan = Pervasives.nan
let infinity = Pervasives.infinity 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 equal_precision ~epsilon a b = abs_float (a-.b) < epsilon
let classify = Pervasives.classify_float let classify = Pervasives.classify_float
module Infix = struct
let (=) = Pervasives.(=)
let (<>) = Pervasives.(<>)
let (<) = Pervasives.(<)
let (>) = Pervasives.(>)
let (<=) = Pervasives.(<=)
let (>=) = Pervasives.(>=)
end
include Infix

View file

@ -5,7 +5,7 @@ type t = int
let equal (a:int) b = a=b 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 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))) (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 rem a n =
let y = a mod n in 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 y + n
else else
y y
@ -245,12 +247,12 @@ let range' i j yield =
module Infix = struct module Infix = struct
let (=) = Pervasives.(=) let (=) = (=)
let (<>) = Pervasives.(<>) let (<>) = (<>)
let (<) = Pervasives.(<) let (<) = (<)
let (>) = Pervasives.(>) let (>) = (>)
let (<=) = Pervasives.(<=) let (<=) = (<=)
let (>=) = Pervasives.(>=) let (>=) = (>=)
let (--) = range let (--) = range
let (--^) = range' let (--^) = range'
end end

View file

@ -28,7 +28,7 @@ let (lsr) = shift_right_logical
let (asr) = shift_right 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) let hash x = Pervasives.abs (to_int x)

View file

@ -557,7 +557,7 @@ let map_product_l f l =
cmp_lii_unord (cartesian_product l) (map_product_l CCFun.id 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 let rec recurse cmp acc l1 l2 = match l1,l2 with
| [], _ -> List.rev_append acc l2 | [], _ -> List.rev_append acc l2
| _, [] -> List.rev_append acc l1 | _, [] -> List.rev_append acc l1
@ -572,15 +572,15 @@ let sorted_merge ?(cmp=Pervasives.compare) l1 l2 =
(*$T (*$T
List.sort Pervasives.compare ([(( * )2); ((+)1)] <*> [10;100]) \ List.sort Pervasives.compare ([(( * )2); ((+)1)] <*> [10;100]) \
= [11; 20; 101; 200] = [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
Q.(pair (list int) (list int)) (fun (l1,l2) -> \ 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 let module S = Set.Make(struct
type t = elt type t = elt
let compare = cmp let compare = cmp
@ -589,12 +589,12 @@ let sort_uniq (type elt) ?(cmp=Pervasives.compare) l =
S.elements set S.elements set
(*$T (*$T
sort_uniq [1;2;5;3;6;1;4;2;3] = [1;2;3;4;5;6] sort_uniq ~cmp:CCInt.compare [1;2;5;3;6;1;4;2;3] = [1;2;3;4;5;6]
sort_uniq [] = [] sort_uniq ~cmp:CCInt.compare [] = []
sort_uniq [10;10;10;10;1;10] = [1;10] 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 let rec aux cmp = function
| [] | [_] -> true | [] | [_] -> true
| x :: ((y :: _) as tail) -> cmp x y <= 0 && aux cmp tail | x :: ((y :: _) as tail) -> cmp x y <= 0 && aux cmp tail
@ -603,10 +603,10 @@ let is_sorted ?(cmp=Pervasives.compare) l =
(*$Q (*$Q
Q.(list small_int) (fun l -> \ 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 let rec aux cmp uniq x left l = match l with
| [] -> List.rev_append left [x] | [] -> List.rev_append left [x]
| y :: tail -> | y :: tail ->
@ -622,20 +622,20 @@ let sorted_insert ?(cmp=Pervasives.compare) ?(uniq=false) x l =
(*$Q (*$Q
Q.(pair small_int (list small_int)) (fun (x,l) -> \ Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \ 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) -> \ Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \ 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) -> \ Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \ 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) List.length l' = List.length l + 1)
Q.(pair small_int (list small_int)) (fun (x,l) -> \ Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \ 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 let rec f acc l = match l with
| [] -> List.rev acc | [] -> List.rev acc
| [x] -> List.rev (x::acc) | [x] -> List.rev (x::acc)
@ -645,10 +645,10 @@ let uniq_succ ?(eq=(=)) l =
f [] l f [] l
(*$T (*$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 let rec f ~eq acc cur l = match cur, l with
| [], [] -> List.rev acc | [], [] -> List.rev acc
| _::_, [] -> List.rev (List.rev cur :: acc) | _::_, [] -> List.rev (List.rev cur :: acc)
@ -659,15 +659,15 @@ let group_succ ?(eq=(=)) l =
f ~eq [] [] l f ~eq [] [] l
(*$T (*$T
group_succ [1;2;3;1;1;2;4] = [[1]; [2]; [3]; [1;1]; [2]; [4]] group_succ ~eq:CCInt.equal [1;2;3;1;1;2;4] = [[1]; [2]; [3]; [1;1]; [2]; [4]]
group_succ [] = [] group_succ ~eq:CCInt.equal [] = []
group_succ [1;1;1] = [[1;1;1]] group_succ ~eq:CCInt.equal [1;1;1] = [[1;1;1]]
group_succ [1;2;2;2] = [[1]; [2;2;2]] 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] \ group_succ ~eq:(fun (x,_)(y,_)-> x=y) [1, 1; 1, 2; 1, 3; 2, 0] \
= [[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 let push ~cmp acc x = match acc with
| [] -> [x] | [] -> [x]
| y :: _ when cmp x y > 0 -> x :: acc | 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 recurse ~cmp [] l1 l2
(*$T (*$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
Q.(list int) (fun l -> \ Q.(list int) (fun l -> \
let l = List.sort Pervasives.compare l in \ 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 -> \ Q.(list int) (fun l -> \
let l = List.sort Pervasives.compare l in \ 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) -> \ Q.(pair (list int) (list int)) (fun (l1, l2) -> \
let l1 = List.sort Pervasives.compare l1 \ let l1 = List.sort Pervasives.compare l1 \
and l2 = List.sort Pervasives.compare l2 in \ and l2 = List.sort Pervasives.compare l2 in \
let l3 = sorted_merge_uniq l1 l2 in \ let l3 = sorted_merge_uniq ~cmp:CCInt.compare l1 l2 in \
uniq_succ l3 = l3) uniq_succ ~eq:CCInt.equal l3 = l3)
*) *)
let take n l = 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] *) (* add sub-lists of [l] to [acc] *)
let rec aux acc l = let rec aux acc l =
let group = take n l in 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 *) else if List.length group < n (* last group, with missing elements *)
then match last group with then match last group with
| None -> acc | 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 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 let rec remove' eq x acc l = match l with
| [] -> List.rev acc | [] -> List.rev acc
| y :: tail when eq x y -> remove' eq x acc tail | y :: tail when eq x y -> remove' eq x acc tail
@ -909,8 +909,8 @@ let remove ?(eq=(=)) ~x l =
remove' eq x [] l remove' eq x [] l
(*$T (*$T
remove ~x:1 [2;1;3;3;2;1] = [2;3;3;2] remove ~eq:CCInt.equal ~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:10 [1;2;3] = [1;2;3]
*) *)
let filter_map f l = 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]) (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 let rec search eq x l = match l with
| [] -> false | [] -> false
| y::l' -> eq x y || search eq x l' | y::l' -> eq x y || search eq x l'
in 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 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 let rec remove_one ~eq x acc l = match l with
| [] -> assert false | [] -> assert false
| y :: tl when eq x y -> List.rev_append acc tl | y :: tl when eq x y -> List.rev_append acc tl
@ -991,19 +991,19 @@ let remove_one ?(eq=(=)) x l =
(*$Q (*$Q
Q.(pair int (list int)) (fun (x,l) -> \ 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) -> \ 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) -> \ 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 List.for_all
(fun t -> mem ~eq t l2) (fun t -> mem ~eq t l2)
l1 l1
let uniq ?(eq=(=)) l = let uniq ~eq l =
let rec uniq eq acc l = match l with let rec uniq eq acc l = match l with
| [] -> List.rev acc | [] -> List.rev acc
| x::xs when List.exists (eq x) xs -> uniq eq acc xs | x::xs when List.exists (eq x) xs -> uniq eq acc xs
@ -1011,15 +1011,15 @@ let uniq ?(eq=(=)) l =
in uniq eq [] l in uniq eq [] l
(*$T (*$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
Q.(small_list small_int) (fun l -> \ 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 let rec union eq acc l1 l2 = match l1 with
| [] -> List.rev_append acc l2 | [] -> List.rev_append acc l2
| x::xs when mem ~eq x l2 -> union eq acc xs 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 in union eq [] l1 l2
(*$T (*$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 let rec inter eq acc l1 l2 = match l1 with
| [] -> List.rev acc | [] -> List.rev acc
| x::xs when mem ~eq x l2 -> inter eq (x::acc) xs l2 | 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 in inter eq [] l1 l2
(*$T (*$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 = let mapi f l =
@ -1236,17 +1236,17 @@ module Assoc = struct
| (y,z)::l' -> | (y,z)::l' ->
if eq x y then z else search_exn eq l' x 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) try Some (search_exn eq l x)
with Not_found -> None with Not_found -> None
(*$T (*$T
Assoc.get 1 [1, "1"; 2, "2"] = Some "1" Assoc.get ~eq:CCInt.equal 1 [1, "1"; 2, "2"] = Some "1"
Assoc.get 2 [1, "1"; 2, "2"] = Some "2" Assoc.get ~eq:CCInt.equal 2 [1, "1"; 2, "2"] = Some "2"
Assoc.get 3 [1, "1"; 2, "2"] = None Assoc.get ~eq:CCInt.equal 3 [1, "1"; 2, "2"] = None
Assoc.get 42 [] = None Assoc.get ~eq:CCInt.equal 42 [] = None
*) *)
(* search for a binding for [x] in [l], and calls [f x (Some v) rest] (* 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') then f x (Some y') (List.rev_append acc l')
else search_set eq ((x',y')::acc) l' x ~f 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 search_set eq [] l x
~f:(fun x _ l -> (x,y)::l) ~f:(fun x _ l -> (x,y)::l)
(*$T (*$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"] = [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"] = [1, "1"; 2, "2"; 3, "3"]
*) *)
let mem ?(eq=(=)) x l = let mem ~eq x l =
try ignore (search_exn eq l x); true try ignore (search_exn eq l x); true
with Not_found -> false with Not_found -> false
(*$T (*$T
Assoc.mem 1 [1,"1"; 2,"2"; 3, "3"] Assoc.mem ~eq:CCInt.equal 1 [1,"1"; 2,"2"; 3, "3"]
not (Assoc.mem 4 [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 search_set eq [] l x
~f:(fun x opt_y rest -> ~f:(fun x opt_y rest ->
match f opt_y with match f opt_y with
@ -1287,17 +1287,17 @@ module Assoc = struct
| Some y' -> (x,y') :: rest) | Some y' -> (x,y') :: rest)
(*$= (*$=
[1,"1"; 2,"22"] \ [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) ~f:(function Some "2" -> Some "22" | _ -> assert false) |> lsort)
[1,"1"; 3,"3"] \ [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) ~f:(function Some "2" -> None | _ -> assert false) |> lsort)
[1,"1"; 2,"2"; 3,"3"] \ [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) ~f:(function None -> Some "3" | _ -> assert false) |> lsort)
*) *)
let remove ?(eq=(=)) x l = let remove ~eq x l =
search_set eq [] l x search_set eq [] l x
~f:(fun _ opt_y rest -> match opt_y with ~f:(fun _ opt_y rest -> match opt_y with
| None -> l (* keep as is *) | None -> l (* keep as is *)
@ -1305,14 +1305,19 @@ module Assoc = struct
(*$= (*$=
[1,"1"] \ [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"] \ [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"] \ [1,"1"; 2,"2"] \
(Assoc.remove 3 [1,"1"; 2,"2"] |> lsort) (Assoc.remove ~eq:CCInt.equal 3 [1,"1"; 2,"2"] |> lsort)
*) *)
end 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} *) (** {2 References on Lists} *)
module Ref = struct module Ref = struct

View file

@ -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], (** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
and [p x] holds. Otherwise returns [None] *) 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. (** [remove ~x l] removes every instance of [x] from [l]. Tailrec.
@param eq equality function @param eq equality function
@since 0.11 *) @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). or [Error e] otherwise (with the first error met).
@since 1.3 *) @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 *) (** 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 *) (** 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 (** [sorted_merge_uniq l1 l2] merges the sorted lists [l1] and [l2] and
removes duplicates removes duplicates
@since 0.10 *) @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) (** [is_sorted l] returns [true] iff [l] is sorted (according to given order)
@param cmp the comparison function (default [Pervasives.compare]) @param cmp the comparison function (default [Pervasives.compare])
@since 0.17 *) @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, (** [sorted_insert x l] inserts [x] into [l] such that, if [l] was sorted,
then [sorted_insert x l] is sorted too. then [sorted_insert x l] is sorted too.
@param uniq if true and [x] is already in sorted position in [l], then @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
Q.(pair small_int (list small_int)) (fun (x,l) -> \ Q.(pair small_int (list small_int)) (fun (x,l) -> \
let l = List.sort Pervasives.compare l in \ 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. (** [uniq_succ l] removes duplicate elements that occur one next to the other.
Examples: Examples:
[uniq_succ [1;2;1] = [1;2;1]] [uniq_succ [1;2;1] = [1;2;1]]
[uniq_succ [1;1;2] = [1;2]] [uniq_succ [1;1;2] = [1;2]]
@since 0.10 *) @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 (** [group_succ ~eq l] groups together consecutive elements that are equal
according to [eq] according to [eq]
@since 0.11 *) @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 Those operations maintain the invariant that the list does not
contain duplicates (if it already satisfies it) *) 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. (** [add_nodup x set] adds [x] to [set] if it was not already present. Linear time.
@since 0.11 *) @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. (** [remove_one x set] removes one occurrence of [x] from [set]. Linear time.
@since 0.11 *) @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 *) (** 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 *) (** 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. (** Remove duplicates w.r.t the equality predicate.
Complexity is quadratic in the length of the list, but the order Complexity is quadratic in the length of the list, but the order
of elements is preserved. If you wish for a faster de-duplication of elements is preserved. If you wish for a faster de-duplication
but do not care about the order, use {!sort_uniq}*) 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. *) (** 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. *) (** List intersection. Complexity is product of length of inputs. *)
(** {2 Other Constructors} *) (** {2 Other Constructors} *)
@ -437,40 +437,52 @@ val repeat : int -> 'a t -> 'a t
module Assoc : sig module Assoc : sig
type ('a, 'b) t = ('a*'b) list 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 *) (** 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 (** Same as [get], but unsafe
@raise Not_found if the element is not present *) @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) *) (** 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] (** [mem x l] returns [true] iff [x] is a key in [l]
@since 0.16 *) @since 0.16 *)
val update : 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)] (** [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 and removing [k] if it returns [None], mapping [k] to [v'] if it
returns [Some v'] returns [Some v']
@since 0.16 *) @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]. (** [remove x l] removes the first occurrence of [k] from [l].
@since 0.17 *) @since 0.17 *)
end end
val assoc_opt : 'a -> ('a * 'b) t -> 'b option val assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b
(** Safe version of {!assoc} (** 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 *) @since 1.5 *)
val assq_opt : 'a -> ('a * 'b) t -> 'b option val assq_opt : 'a -> ('a * 'b) t -> 'b option
(** Safe version of {!assq} (** Safe version of {!assq}
@since 1.5 *) @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} (** {2 References on Lists}
@since 0.3.3 *) @since 0.3.3 *)

View file

@ -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], (** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
and [p x] holds. Otherwise returns [None] *) 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. (** [remove ~key l] removes every instance of [key] from [l]. Tailrec.
@param eq equality function @param eq equality function
@since 0.11 *) @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 val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
(** Map and remove elements at the same time *) (** 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 *) (** 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 *) (** 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 (** [sorted_merge_uniq l1 l2] merges the sorted lists [l1] and [l2] and
removes duplicates removes duplicates
@since 0.10 *) @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) (** [is_sorted l] returns [true] iff [l] is sorted (according to given order)
@param cmp the comparison function (default [Pervasives.compare]) @param cmp the comparison function (default [Pervasives.compare])
@since 0.17 *) @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, (** [sorted_insert x l] inserts [x] into [l] such that, if [l] was sorted,
then [sorted_insert x l] is sorted too. then [sorted_insert x l] is sorted too.
@param uniq if true and [x] is already in sorted position in [l], then @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)) 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. (** [uniq_succ l] removes duplicate elements that occur one next to the other.
Examples: Examples:
[uniq_succ [1;2;1] = [1;2;1]] [uniq_succ [1;2;1] = [1;2;1]]
[uniq_succ [1;1;2] = [1;2]] [uniq_succ [1;1;2] = [1;2]]
@since 0.10 *) @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 (** [group_succ ~eq l] groups together consecutive elements that are equal
according to [eq] according to [eq]
@since 0.11 *) @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 Those operations maintain the invariant that the list does not
contain duplicates (if it already satisfies it) *) 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. (** [add_nodup x set] adds [x] to [set] if it was not already present. Linear time.
@since 0.11 *) @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. (** [remove_one x set] removes one occurrence of [x] from [set]. Linear time.
@since 0.11 *) @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 *) (** 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 *) (** 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. (** Remove duplicates w.r.t the equality predicate.
Complexity is quadratic in the length of the list, but the order Complexity is quadratic in the length of the list, but the order
of elements is preserved. If you wish for a faster de-duplication of elements is preserved. If you wish for a faster de-duplication
but do not care about the order, use {!sort_uniq}*) 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. *) (** 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. *) (** List intersection. Complexity is product of length of inputs. *)
(** {2 Other Constructors} *) (** {2 Other Constructors} *)
@ -320,32 +320,52 @@ val repeat : int -> 'a t -> 'a t
module Assoc : sig module Assoc : sig
type ('a, 'b) t = ('a*'b) list 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 *) (** 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 (** Same as [get], but unsafe
@raise Not_found if the element is not present *) @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) *) (** 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] (** [mem x l] returns [true] iff [x] is a key in [l]
@since 0.16 *) @since 0.16 *)
val update : 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)] (** [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 and removing [k] if it returns [None], mapping [k] to [v'] if it
returns [Some v'] returns [Some v']
@since 0.16 *) @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]. (** [remove x l] removes the first occurrence of [k] from [l].
@since 0.17 *) @since 0.17 *)
end 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} (** {2 References on Lists}
@since 0.3.3 *) @since 0.3.3 *)

View file

@ -43,6 +43,9 @@ type state = {
exception ParseError of parse_branch * (unit -> string) 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 rec string_of_branch l =
let pp_s () = function let pp_s () = function
| None -> "" | None -> ""
@ -87,7 +90,7 @@ let next st ~ok ~err =
else ( else (
let c = st.str.[st.i] in let c = st.str.[st.i] in
st.i <- st.i + 1; st.i <- st.i + 1;
if c='\n' if char_equal c '\n'
then (st.lnum <- st.lnum + 1; st.cnum <- 1) then (st.lnum <- st.lnum + 1; st.cnum <- 1)
else st.cnum <- st.cnum + 1; else st.cnum <- st.cnum + 1;
ok c ok c
@ -146,7 +149,7 @@ let char c =
let msg = Printf.sprintf "expected '%c'" c in let msg = Printf.sprintf "expected '%c'" c in
fun st ~ok ~err -> fun st ~ok ~err ->
next st ~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 = let char_if p st ~ok ~err =
next st ~err next st ~err
@ -164,7 +167,7 @@ let chars_if p st ~ok ~err:_ =
let chars1_if p st ~ok ~err = let chars1_if p st ~ok ~err =
chars_if p st ~err chars_if p st ~err
~ok:(fun s -> ~ok:(fun s ->
if s = "" if string_equal s ""
then fail_ ~err st (const_ "unexpected sequence of chars") then fail_ ~err st (const_ "unexpected sequence of chars")
else ok s) else ok s)
@ -231,7 +234,7 @@ let string s st ~ok ~err =
else else
next st ~err next st ~err
~ok:(fun c -> ~ok:(fun c ->
if c = s.[i] if char_equal c s.[i]
then check (i+1) then check (i+1)
else fail_ ~err st (fun () -> Printf.sprintf "expected \"%s\"" s)) else fail_ ~err st (fun () -> Printf.sprintf "expected \"%s\"" s))
in in
@ -386,7 +389,7 @@ module U = struct
skip_white <* string stop skip_white <* string stop
let int = let int =
chars1_if (fun c -> is_num c || c='-') chars1_if (fun c -> is_num c || char_equal c '-')
>>= fun s -> >>= fun s ->
try return (int_of_string s) try return (int_of_string s)
with Failure _ -> fail "expected an int" with Failure _ -> fail "expected an int"

View file

@ -77,7 +77,7 @@ let replicate n g st =
in aux [] n in aux [] n
(* Sample without replacement using rejection sampling. *) (* 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 module S = Set.Make(struct type t=elt let compare = compare end) in
let rec aux s k = let rec aux s k =
if k <= 0 then if k <= 0 then
@ -118,7 +118,7 @@ let _diff_list ~last l =
let split_list i ~len st = let split_list i ~len st =
if len <= 1 then invalid_arg "Random.split_list"; if len <= 1 then invalid_arg "Random.split_list";
if i >= len then 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 _diff_list ( 0::xs ) ~last:i
else else
None None
@ -221,6 +221,7 @@ let uniformity_test ?(size_hint=10) k rng st =
let confidence = 4. in let confidence = 4. in
let std = confidence *. (sqrt (kf *. variance)) in let std = confidence *. (sqrt (kf *. variance)) in
let predicate _key n acc = let predicate _key n acc =
let (<) (a : float) b = Pervasives.(<) a b in
acc && abs_float (average -. float_of_int n) < std in acc && abs_float (average -. float_of_int n) < std in
Hashtbl.fold predicate histogram true Hashtbl.fold predicate histogram true

View file

@ -56,7 +56,7 @@ val replicate : int -> 'a t -> 'a list t
randomly using [g] *) randomly using [g] *)
val sample_without_replacement: 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 (** [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 generated randomly using [g] with the added constraint that none of the generated
random values are equal random values are equal

View file

@ -109,12 +109,12 @@ let (>|=) e f = map f e
let (>>=) e f = flat_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 | Ok x, Ok y -> eq x y
| Error s, Error s' -> err s s' | Error s, Error s' -> err s s'
| _ -> false | _ -> 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 x, Ok y -> cmp x y
| Ok _, _ -> 1 | Ok _, _ -> 1
| _, Ok _ -> -1 | _, Ok _ -> -1

View file

@ -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 (>>=) : ('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 val fold : ok:('a -> 'b) -> error:('err -> 'b) -> ('a, 'err) t -> 'b
(** [fold ~ok ~error e] opens [e] and, if [e = Ok x], returns (** [fold ~ok ~error e] opens [e] and, if [e = Ok x], returns

View file

@ -56,8 +56,9 @@ module type S = sig
val print : Format.formatter -> t -> unit val print : Format.formatter -> t -> unit
end 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 compare = String.compare
let hash s = Hashtbl.hash s let hash s = Hashtbl.hash s
@ -78,7 +79,7 @@ let _is_sub ~sub i s j ~len =
let rec check k = let rec check k =
if k = len if k = len
then true 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 in
j+len <= String.length s && check 0 j+len <= String.length s && check 0
@ -126,7 +127,7 @@ module Find = struct
let j = ref 0 in let j = ref 0 in
while !i < len do while !i < len do
match !j with 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 *) (* substring starting at !j continues matching current char *)
incr j; incr j;
failure.(!i) <- !j; failure.(!i) <- !j;
@ -158,7 +159,7 @@ module Find = struct
while !j < pat_len && !i + !j < len do while !j < pat_len && !i + !j < len do
let c = String.get s (!i + !j) in let c = String.get s (!i + !j) in
let expected = String.get pattern.str !j in let expected = String.get pattern.str !j in
if c = expected if CCChar.equal c expected
then ( then (
(* char matches *) (* char matches *)
incr j; incr j;
@ -193,7 +194,7 @@ module Find = struct
while !j < pat_len && !i + !j < len do while !j < pat_len && !i + !j < len do
let c = String.get s (len - !i - !j - 1) in let c = String.get s (len - !i - !j - 1) in
let expected = String.get pattern.str (String.length pattern.str - !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 ( then (
(* char matches *) (* char matches *)
incr j; incr j;
@ -292,7 +293,7 @@ let replace_at_ ~pos ~len ~by s =
Buffer.contents b Buffer.contents b
let replace ?(which=`All) ~sub ~by s = 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 match which with
| `Left -> | `Left ->
let i = find ~sub s ~start:0 in let i = find ~sub s ~start:0 in
@ -442,7 +443,7 @@ let compare_versions a b =
| Some _, None -> 1 | Some _, None -> 1
| None, Some _ -> -1 | None, Some _ -> -1
| Some x, Some y -> | 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 if c<>0 then c else cmp_rec a b
in in
cmp_rec (Split.gen_cpy ~by:"." a) (Split.gen_cpy ~by:"." b) 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_int _, NC_char _ -> 1
| NC_char _, NC_int _ -> -1 | NC_char _, NC_int _ -> -1
| NC_int x, NC_int y -> | 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 if c<>0 then c else cmp_rec a b
in in
cmp_rec (chunks a) (chunks b) cmp_rec (chunks a) (chunks b)
@ -490,7 +491,7 @@ let edit_distance s1 s2 =
then length s2 then length s2
else if length s2 = 0 else if length s2 = 0
then length s1 then length s1
else if s1 = s2 else if equal s1 s2
then 0 then 0
else begin else begin
(* distance vectors (v0=previous, v1=current) *) (* distance vectors (v0=previous, v1=current) *)
@ -777,14 +778,9 @@ let exists2 p s1 s2 =
(** {2 Ascii functions} *) (** {2 Ascii functions} *)
let equal_caseless s1 s2: bool = 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 && String.length s1 = String.length s2 &&
for_all2 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 s1 s2
let pp buf s = let pp buf s =

View file

@ -297,7 +297,7 @@ let compare cmp v1 v2 =
let n = min v1.size v2.size in let n = min v1.size v2.size in
let rec check i = let rec check i =
if i = n if i = n
then Pervasives.compare v1.size v2.size then compare v1.size v2.size
else else
let c = cmp (get v1 i) (get v2 i) in let c = cmp (get v1 i) (get v2 i) in
if c = 0 then check (i+1) else c 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) else p v.vec.(i) && check (i+1)
in check 0 in check 0
let member ?(eq=(=)) x v = let member ~eq x v =
exists (eq x) v exists (eq x) v
let find_exn p v = let find_exn p v =

View file

@ -118,7 +118,7 @@ val shrink : ('a, rw) t -> int -> unit
(** Shrink to the given size (remove elements above this size). (** Shrink to the given size (remove elements above this size).
Does nothing if the parameter is bigger than the current 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? *) (** Is the element a member of the vector? *)
val sort : ('a -> 'a -> int) -> ('a, _) t -> ('a, 'mut) t val sort : ('a -> 'a -> int) -> ('a, _) t -> ('a, 'mut) t

View file

@ -42,3 +42,6 @@ module Result = CCResult
module Set = CCSet module Set = CCSet
module String = CCString module String = CCString
module Vector = CCVector module Vector = CCVector
module Monomorphic = CCMonomorphic
include Monomorphic

View file

@ -6,7 +6,6 @@
type 'a equal = 'a -> 'a -> bool type 'a equal = 'a -> 'a -> bool
type 'a hash = 'a -> int type 'a hash = 'a -> int
let default_eq_ = Pervasives.(=)
let default_hash_ = Hashtbl.hash let default_hash_ = Hashtbl.hash
(** {2 Value interface} *) (** {2 Value interface} *)
@ -57,7 +56,7 @@ let with_cache_rec ?(cb=default_callback_) c f =
f' f'
(*$R (*$R
let c = unbounded 256 in let c = unbounded ~eq:CCInt.equal 256 in
let fib = with_cache_rec c let fib = with_cache_rec c
(fun self n -> match n with (fun self n -> match n with
| 1 | 2 -> 1 | 1 | 2 -> 1
@ -124,7 +123,7 @@ module Linear = struct
!r !r
end end
let linear ?(eq=default_eq_) size = let linear ~eq size =
let size = max size 1 in let size = max size 1 in
let arr = Linear.make eq size in let arr = Linear.make eq size in
{ get=(fun x -> Linear.get arr x); { get=(fun x -> Linear.get arr x);
@ -161,9 +160,13 @@ module Replacing = struct
| Pair _ | Pair _
| Empty -> raise Not_found | Empty -> raise Not_found
let is_empty = function
| Empty -> true
| Pair _ -> false
let set c x y = let set c x y =
let i = c.hash x mod Array.length c.arr in 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) c.arr.(i) <- Pair (x,y)
let iter c f = let iter c f =
@ -172,7 +175,7 @@ module Replacing = struct
let size c () = c.c_size let size c () = c.c_size
end 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 let c = Replacing.make eq hash size in
{ get=(fun x -> Replacing.get c x); { get=(fun x -> Replacing.get c x);
set=(fun x y -> Replacing.set c x y); set=(fun x y -> Replacing.set c x y);
@ -219,7 +222,7 @@ module LRU(X:HASH) = struct
(* take first from queue *) (* take first from queue *)
let take_ c = let take_ c =
match c.first with match c.first with
| Some n when n.next == n -> | Some n when Pervasives.(==) n.next n ->
(* last element *) (* last element *)
c.first <- None; c.first <- None;
n n
@ -238,7 +241,7 @@ module LRU(X:HASH) = struct
n.next <- n; n.next <- n;
n.prev <- n; n.prev <- n;
c.first <- Some n c.first <- Some n
| Some n1 when n1==n -> () | Some n1 when Pervasives.(==) n1 n -> ()
| Some n1 -> | Some n1 ->
n.prev <- n1.prev; n.prev <- n1.prev;
n.next <- n1; n.next <- n1;
@ -294,7 +297,7 @@ module LRU(X:HASH) = struct
H.iter (fun x node -> f x node.value) c.table H.iter (fun x node -> f x node.value) c.table
end 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 let module L = LRU(struct
type t = a type t = a
let equal = eq let equal = eq
@ -318,7 +321,7 @@ let lru (type a) ?(eq=default_eq_) ?(hash=default_hash_) size =
(*$T (*$T
let f = (let r = ref 0 in fun _ -> incr r; !r) in \ 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 res1 = with_cache c f 1 in \
let res2 = with_cache c f 2 in \ let res2 = with_cache c f 2 in \
let res3 = with_cache c f 3 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 (*$R
let f = (let r = ref 0 in fun _ -> incr r; !r) in 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 let x = with_cache c f () in
assert_equal 1 x; assert_equal 1 x;
assert_equal 1 (size c); assert_equal 1 (size c);
@ -356,7 +359,7 @@ module UNBOUNDED(X:HASH) = struct
let iter c f = H.iter f c let iter c f = H.iter f c
end 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 let module C = UNBOUNDED(struct
type t = a type t = a
let equal = eq let equal = eq

View file

@ -79,13 +79,13 @@ val add : ('a, 'b) t -> 'a -> 'b -> bool
val dummy : ('a,'b) t val dummy : ('a,'b) t
(** Dummy cache, never stores any value *) (** 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 (** 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 an array and does linear search at every call, so it should only be used
with small size. with small size.
@param eq optional equality predicate for keys *) @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 int -> ('a,'b) t
(** Replacing cache of the given size. Equality and hash functions can be (** Replacing cache of the given size. Equality and hash functions can be
parametrized. It's a hash table that handles collisions by replacing 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). entry with the same hash (modulo size) is added).
Never grows wider than the given size. *) 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 int -> ('a,'b) t
(** LRU cache of the given size ("Least Recently Used": keys that have not been (** 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. *) 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 int -> ('a,'b) t
(** Unbounded cache, backed by a Hash table. Will grow forever (** Unbounded cache, backed by a Hash table. Will grow forever
unless {!clear} is called manually. *) unless {!clear} is called manually. *)

View file

@ -74,9 +74,11 @@ let is_zero_ n = match n.cell with
| Two _ | Two _
| Three _ -> false | Three _ -> false
let bool_eq (a : bool) b = Pervasives.(=) a b
let is_empty d = let is_empty d =
let res = d.size = 0 in let res = d.size = 0 in
assert (res = is_zero_ d.cur); assert (bool_eq res (is_zero_ d.cur));
res res
let push_front d x = let push_front d x =
@ -161,7 +163,7 @@ let take_back_node_ n = match n.cell with
let take_back d = let take_back d =
if is_empty d then raise Empty if is_empty d then raise Empty
else if d.cur == d.cur.prev else if Pervasives.(==) d.cur d.cur.prev
then ( then (
(* only one cell *) (* only one cell *)
decr_size_ d; decr_size_ d;
@ -194,7 +196,7 @@ let take_front_node_ n = match n.cell with
let take_front d = let take_front d =
if is_empty d then raise Empty if is_empty d then raise Empty
else if d.cur.prev == d.cur else if Pervasives.(==) d.cur.prev d.cur
then ( then (
(* only one cell *) (* only one cell *)
decr_size_ d; decr_size_ d;
@ -253,7 +255,7 @@ let fold f acc d =
| Two (x,y) -> f (f acc x) y | Two (x,y) -> f (f acc x) y
| Three (x,y,z) -> f (f (f acc x) y) z | Three (x,y,z) -> f (f (f acc x) y) z
in 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 in
aux ~first:d.cur f acc d.cur aux ~first:d.cur f acc d.cur
@ -335,7 +337,7 @@ let to_gen q =
let cell = ref q.cur.cell in let cell = ref q.cur.cell in
let cur = ref q.cur in let cur = ref q.cur in
let rec next () = match !cell with let rec next () = match !cell with
| Zero when (!cur).next == first -> None | Zero when Pervasives.(==) (!cur).next first -> None
| Zero -> | Zero ->
(* go to next node *) (* go to next node *)
let n = !cur in let n = !cur in
@ -367,7 +369,7 @@ let copy d =
let q = of_list [1;2;3;4] in let q = of_list [1;2;3;4] in
assert_equal 4 (length q); assert_equal 4 (length q);
let q' = copy q in 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 4 (length q');
assert_equal ~cmp q q'; assert_equal ~cmp q q';
push_front q 0; push_front q 0;
@ -377,7 +379,7 @@ let copy d =
assert_equal ~cmp q q' 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 let rec aux eq a b = match a() , b() with
| None, None -> true | None, None -> true
| None, Some _ | None, Some _
@ -385,7 +387,7 @@ let equal ?(eq=(=)) a b =
| Some x, Some y -> eq x y && aux eq a b | Some x, Some y -> eq x y && aux eq a b
in aux eq (to_gen a) (to_gen 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 let rec aux cmp a b = match a() , b() with
| None, None -> 0 | None, None -> 0
| None, Some _ -> -1 | None, Some _ -> -1
@ -397,7 +399,7 @@ let compare ?(cmp=Pervasives.compare) a b =
(*$Q (*$Q
Q.(pair (list int) (list int)) (fun (l1,l2) -> \ 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)) (CCList.compare Pervasives.compare l1 l2))
*) *)
@ -412,4 +414,3 @@ let print pp_x out d =
pp_x out x pp_x out x
) d; ) d;
Format.fprintf out "}@]" Format.fprintf out "}@]"

View file

@ -21,13 +21,13 @@ val clear : _ t -> unit
val is_empty : 'a t -> bool val is_empty : 'a t -> bool
(** Is the deque empty? *) (** 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 (** [equal a b] checks whether [a] and [b] contain the same sequence of
elements. elements.
@param eq comparison function for elements @param eq comparison function for elements
@since 0.13 *) @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] (** [compare a b] compares lexicographically [a] and [b]
@param cmp comparison function for elements @param cmp comparison function for elements
@since 0.13 *) @since 0.13 *)

View file

@ -34,10 +34,14 @@ let empty = Shallow Zero
exception Empty exception Empty
let is_not_zero = function
| Zero -> false
| One _ | Two _ | Three _ -> true
let _single x = Shallow (One x) let _single x = Shallow (One x)
let _double x y = Shallow (Two (x,y)) let _double x y = Shallow (Two (x,y))
let _deep n hd middle tl = 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) Deep (n, hd, middle, tl)
let is_empty = function let is_empty = function

View file

@ -56,7 +56,7 @@ type ('k, 'a) table = {
(** Mutable set *) (** Mutable set *)
type 'a set = ('a, unit) table 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 let module H = Hashtbl.Make(struct
type t = k type t = k
let equal = eq 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) ; 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 let module M = Map.Make(struct
type t = k type t = k
let compare = cmp let compare = cmp
@ -160,15 +160,15 @@ module Traverse = struct
) )
done done
let generic ?(tbl=mk_table 128) ~bag ~graph seq = let generic ~tbl ~bag ~graph seq =
let tags = { let tags = {
get_tag=tbl.mem; get_tag=tbl.mem;
set_tag=(fun v -> tbl.add v ()); set_tag=(fun v -> tbl.add v ());
} in } in
generic_tag ~tags ~bag ~graph seq generic_tag ~tags ~bag ~graph seq
let bfs ?tbl ~graph seq = let bfs ~tbl ~graph seq =
generic ?tbl ~bag:(mk_queue ()) ~graph seq generic ~tbl ~bag:(mk_queue ()) ~graph seq
let bfs_tag ~tags ~graph seq = let bfs_tag ~tags ~graph seq =
generic_tag ~tags ~bag:(mk_queue()) ~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 let bag = mk_heap ~leq:(fun (_,d1,_) (_,d2,_) -> d1 <= d2) in
generic_tag ~tags:tags' ~bag ~graph:graph' seq' 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 = { let tags = {
get_tag=tbl.mem; get_tag=tbl.mem;
set_tag=(fun v -> tbl.add v ()); set_tag=(fun v -> tbl.add v ());
} in } in
dijkstra_tag ~tags ?dist ~graph seq dijkstra_tag ~tags ?dist ~graph seq
let dfs ?tbl ~graph seq = let dfs ~tbl ~graph seq =
generic ?tbl ~bag:(mk_stack ()) ~graph seq generic ~tbl ~bag:(mk_stack ()) ~graph seq
let dfs_tag ~tags ~graph seq = let dfs_tag ~tags ~graph seq =
generic_tag ~tags ~bag:(mk_stack()) ~graph seq generic_tag ~tags ~bag:(mk_stack()) ~graph seq
@ -240,7 +240,7 @@ module Traverse = struct
| (v1,_,_) :: path' -> | (v1,_,_) :: path' ->
eq v v1 || list_mem_ ~eq ~graph v 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 let first = ref true in
fun k -> fun k ->
if !first then first := false else raise Sequence_once; if !first then first := false else raise Sequence_once;
@ -279,17 +279,18 @@ module Traverse = struct
done done
) seq ) seq
let dfs ?(tbl=mk_table 128) ?eq ~graph seq = let dfs ~tbl ~eq ~graph seq =
let tags = { let tags = {
set_tag=(fun v -> tbl.add v ()); set_tag=(fun v -> tbl.add v ());
get_tag=tbl.mem; get_tag=tbl.mem;
} in } in
dfs_tag ?eq ~tags ~graph seq dfs_tag ~eq ~tags ~graph seq
end end
(*$R (*$R
let l = 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 |> Sequence.to_list in
let expected = let expected =
[`Enter (345614, 0, []); `Edge (345614, (), 172807, `Forward); [`Enter (345614, 0, []); `Edge (345614, (), 172807, `Forward);
@ -305,8 +306,8 @@ end
(** {2 Cycles} *) (** {2 Cycles} *)
let is_dag ?(tbl=mk_table 128) ~graph vs = let is_dag ~tbl ~eq ~graph vs =
Traverse.Event.dfs ~tbl ~graph vs Traverse.Event.dfs ~tbl ~eq ~graph vs
|> Seq.exists_ |> Seq.exists_
(function (function
| `Edge (_, _, _, `Back) -> true | `Edge (_, _, _, `Back) -> true
@ -316,7 +317,7 @@ let is_dag ?(tbl=mk_table 128) ~graph vs =
exception Has_cycle 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 *) (* use DFS *)
let l = let l =
Traverse.Event.dfs_tag ~eq ~tags ~graph seq Traverse.Event.dfs_tag ~eq ~tags ~graph seq
@ -331,21 +332,23 @@ let topo_sort_tag ?(eq=(=)) ?(rev=false) ~tags ~graph seq =
in in
if rev then List.rev l else l 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 = { let tags = {
get_tag=tbl.mem; get_tag=tbl.mem;
set_tag=(fun v -> tbl.add v ()); set_tag=(fun v -> tbl.add v ());
} in } in
topo_sort_tag ?eq ?rev ~tags ~graph seq topo_sort_tag ~eq ?rev ~tags ~graph seq
(*$T (*$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) -> \ List.for_all (fun (i,j) -> \
let idx_i = CCList.find_idx ((=)i) l |> CCOpt.get_exn |> fst in \ 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 \ let idx_j = CCList.find_idx ((=)j) l |> CCOpt.get_exn |> fst in \
idx_i < idx_j) \ idx_i < idx_j) \
[ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3] [ 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) -> \ List.for_all (fun (i,j) -> \
let idx_i = CCList.find_idx ((=)i) l |> CCOpt.get_exn |> fst in \ 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 \ 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 in
mk_node v mk_node v
let spanning_tree ?(tbl=mk_table 128) ~graph v = let spanning_tree ~tbl ~graph v =
let tags = { let tags = {
get_tag=tbl.mem; get_tag=tbl.mem;
set_tag=(fun v -> tbl.add v ()); set_tag=(fun v -> tbl.add v ());
@ -482,12 +485,12 @@ end
type 'v scc_state = 'v SCC.state 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 *) (* example from https://en.wikipedia.org/wiki/Strongly_connected_component *)
(*$R (*$R
let set_eq ?(eq=(=)) l1 l2 = CCList.subset ~eq l1 l2 && CCList.subset ~eq l2 l1 in 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" [ "a", "b"
; "b", "e" ; "b", "e"
; "e", "a" ; "e", "a"
@ -503,7 +506,8 @@ let scc ?(tbl=mk_table 128) ~graph seq = SCC.explore ~tbl ~graph seq
; "h", "d" ; "h", "d"
; "h", "g" ; "h", "g"
] in ] 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" assert_bool "scc"
(set_eq ~eq:(set_eq ?eq:None) res (set_eq ~eq:(set_eq ?eq:None) res
[ [ "a"; "b"; "e" ] [ [ "a"; "b"; "e" ]
@ -541,8 +545,8 @@ module Dot = struct
(** Print an enum of Full.traverse_event *) (** Print an enum of Full.traverse_event *)
let pp_seq let pp_seq
?(tbl=mk_table 128) ~tbl
?(eq=(=)) ~eq
?(attrs_v=fun _ -> []) ?(attrs_v=fun _ -> [])
?(attrs_e=fun _ -> []) ?(attrs_e=fun _ -> [])
?(name="graph") ?(name="graph")
@ -598,8 +602,8 @@ module Dot = struct
Format.fprintf out "}@]@;@?"; Format.fprintf out "}@]@;@?";
() ()
let pp ?tbl ?eq ?attrs_v ?attrs_e ?name ~graph fmt 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) pp_seq ~tbl ~eq ?attrs_v ?attrs_e ?name ~graph fmt (Seq.return v)
let with_out filename f = let with_out filename f =
let oc = open_out filename in let oc = open_out filename in
@ -622,7 +626,7 @@ type ('v, 'e) mut_graph = {
remove : 'v -> unit; 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 let module Tbl = Hashtbl.Make(struct
type t = k type t = k
let hash = hash let hash = hash
@ -757,7 +761,7 @@ end
(** {2 Misc} *) (** {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) (fun v yield -> List.iter (fun (a,b) -> if eq a v then yield ((),b)) l)
let of_fun f = let of_fun f =

View file

@ -77,10 +77,10 @@ type ('k, 'a) table = {
(** Mutable set *) (** Mutable set *)
type 'a set = ('a, unit) table 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} *) (** 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 *) (** Use a {!Map.S} underneath *)
(** {2 Bags of vertices} *) (** {2 Bags of vertices} *)
@ -104,7 +104,7 @@ val mk_heap: leq:('a -> 'a -> bool) -> 'a bag
module Traverse : sig module Traverse : sig
type ('v, 'e) path = ('v * 'e * 'v) list type ('v, 'e) path = ('v * 'e * 'v) list
val generic: ?tbl:'v set -> val generic: tbl:'v set ->
bag:'v bag -> bag:'v bag ->
graph:('v, 'e) t -> graph:('v, 'e) t ->
'v sequence -> 'v sequence ->
@ -120,7 +120,7 @@ module Traverse : sig
'v sequence_once 'v sequence_once
(** One-shot traversal of the graph using a tag set and the given bag *) (** 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 -> graph:('v, 'e) t ->
'v sequence -> 'v sequence ->
'v sequence_once 'v sequence_once
@ -130,7 +130,7 @@ module Traverse : sig
'v sequence -> 'v sequence ->
'v sequence_once 'v sequence_once
val bfs: ?tbl:'v set -> val bfs: tbl:'v set ->
graph:('v, 'e) t -> graph:('v, 'e) t ->
'v sequence -> 'v sequence ->
'v sequence_once 'v sequence_once
@ -140,7 +140,7 @@ module Traverse : sig
'v sequence -> 'v sequence ->
'v sequence_once 'v sequence_once
val dijkstra : ?tbl:'v set -> val dijkstra : tbl:'v set ->
?dist:('e -> int) -> ?dist:('e -> int) ->
graph:('v, 'e) t -> graph:('v, 'e) t ->
'v sequence -> 'v sequence ->
@ -174,15 +174,15 @@ module Traverse : sig
val get_edge : ('v, 'e) t -> ('v * 'e * 'v) option val get_edge : ('v, 'e) t -> ('v * 'e * 'v) option
val get_edge_kind : ('v, 'e) t -> ('v * 'e * 'v * edge_kind) option val get_edge_kind : ('v, 'e) t -> ('v * 'e * 'v * edge_kind) option
val dfs: ?tbl:'v set -> val dfs: tbl:'v set ->
?eq:('v -> 'v -> bool) -> eq:('v -> 'v -> bool) ->
graph:('v, 'e) graph -> graph:('v, 'e) graph ->
'v sequence -> 'v sequence ->
('v,'e) t sequence_once ('v,'e) t sequence_once
(** Full version of DFS. (** Full version of DFS.
@param eq equality predicate on vertices *) @param eq equality predicate on vertices *)
val dfs_tag: ?eq:('v -> 'v -> bool) -> val dfs_tag: eq:('v -> 'v -> bool) ->
tags:'v tag_set -> tags:'v tag_set ->
graph:('v, 'e) graph -> graph:('v, 'e) graph ->
'v sequence -> 'v sequence ->
@ -195,7 +195,8 @@ end
(** {2 Cycles} *) (** {2 Cycles} *)
val is_dag : val is_dag :
?tbl:'v set -> tbl:'v set ->
eq:('v -> 'v -> bool) ->
graph:('v, _) t -> graph:('v, _) t ->
'v sequence -> 'v sequence ->
bool bool
@ -207,9 +208,9 @@ val is_dag :
exception Has_cycle exception Has_cycle
val topo_sort : ?eq:('v -> 'v -> bool) -> val topo_sort : eq:('v -> 'v -> bool) ->
?rev:bool -> ?rev:bool ->
?tbl:'v set -> tbl:'v set ->
graph:('v, 'e) t -> graph:('v, 'e) t ->
'v sequence -> 'v sequence ->
'v list 'v list
@ -224,7 +225,7 @@ val topo_sort : ?eq:('v -> 'v -> bool) ->
[v'] occurs before [v]) [v'] occurs before [v])
@raise Has_cycle if the graph is not a DAG *) @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 -> ?rev:bool ->
tags:'v tag_set -> tags:'v tag_set ->
graph:('v, 'e) t -> graph:('v, 'e) t ->
@ -245,7 +246,7 @@ module Lazy_tree : sig
val fold_v : ('acc -> 'v -> 'acc) -> 'acc -> ('v, _) t -> 'acc val fold_v : ('acc -> 'v -> 'acc) -> 'acc -> ('v, _) t -> 'acc
end end
val spanning_tree : ?tbl:'v set -> val spanning_tree : tbl:'v set ->
graph:('v, 'e) t -> graph:('v, 'e) t ->
'v -> 'v ->
('v, 'e) Lazy_tree.t ('v, 'e) Lazy_tree.t
@ -262,7 +263,7 @@ val spanning_tree_tag : tags:'v tag_set ->
type 'v scc_state type 'v scc_state
(** Hidden state for {!scc} *) (** Hidden state for {!scc} *)
val scc : ?tbl:('v, 'v scc_state) table -> val scc : tbl:('v, 'v scc_state) table ->
graph:('v, 'e) t -> graph:('v, 'e) t ->
'v sequence -> 'v sequence ->
'v list sequence_once 'v list sequence_once
@ -304,8 +305,8 @@ module Dot : sig
type vertex_state type vertex_state
(** Hidden state associated to a vertex *) (** Hidden state associated to a vertex *)
val pp : ?tbl:('v,vertex_state) table -> val pp : tbl:('v,vertex_state) table ->
?eq:('v -> 'v -> bool) -> eq:('v -> 'v -> bool) ->
?attrs_v:('v -> attribute list) -> ?attrs_v:('v -> attribute list) ->
?attrs_e:('e -> attribute list) -> ?attrs_e:('e -> attribute list) ->
?name:string -> ?name:string ->
@ -318,8 +319,8 @@ module Dot : sig
@param attrs_e attributes for edges @param attrs_e attributes for edges
@param name name of the graph *) @param name name of the graph *)
val pp_seq : ?tbl:('v,vertex_state) table -> val pp_seq : tbl:('v,vertex_state) table ->
?eq:('v -> 'v -> bool) -> eq:('v -> 'v -> bool) ->
?attrs_v:('v -> attribute list) -> ?attrs_v:('v -> attribute list) ->
?attrs_e:('e -> attribute list) -> ?attrs_e:('e -> attribute list) ->
?name:string -> ?name:string ->
@ -340,7 +341,7 @@ type ('v, 'e) mut_graph = {
remove : 'v -> unit; remove : 'v -> unit;
} }
val mk_mut_tbl : ?eq:('v -> 'v -> bool) -> val mk_mut_tbl : eq:('v -> 'v -> bool) ->
?hash:('v -> int) -> ?hash:('v -> int) ->
int -> int ->
('v, 'a) mut_graph ('v, 'a) mut_graph
@ -397,7 +398,7 @@ module Map(O : Map.OrderedType) : MAP with type vertex = O.t
(** {2 Misc} *) (** {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. (** [of_list l] makes a graph from a list of pairs of vertices.
Each pair [(a,b)] is an edge from [a] to [b]. Each pair [(a,b)] is an edge from [a] to [b].
@param eq equality used to compare vertices *) @param eq equality used to compare vertices *)

View file

@ -24,7 +24,7 @@ module Transient = struct
type state = { mutable frozen: bool } type state = { mutable frozen: bool }
type t = Nil | St of state type t = Nil | St of state
let empty = Nil let empty = Nil
let equal a b = a==b let equal a b = Pervasives.(==) a b
let create () = St {frozen=false} let create () = St {frozen=false}
let active = function Nil -> false | St st -> not st.frozen let active = function Nil -> false | St st -> not st.frozen
let frozen = function Nil -> true | St st -> 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 make : Key.t -> t
val zero : t (* special "hash" *) val zero : t (* special "hash" *)
val is_0 : t -> bool val is_0 : t -> bool
val equal : t -> t -> bool
val rem : t -> int (* [A.length_log] last bits *) val rem : t -> int (* [A.length_log] last bits *)
val quotient : t -> t (* remove [A.length_log] last bits *) val quotient : t -> t (* remove [A.length_log] last bits *)
end = struct end = struct
type t = int type t = int
let make = Key.hash let make = Key.hash
let zero = 0 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 rem h = h land (A.length - 1)
let quotient h = h lsr A.length_log let quotient h = h lsr A.length_log
end end
@ -407,14 +409,14 @@ module Make(Key : KEY)
let rec add_ ~id k v ~h m = match m with let rec add_ ~id k v ~h m = match m with
| E -> S (h, k, v) | E -> S (h, k, v)
| S (h', k', v') -> | S (h', k', v') ->
if h=h' if Hash.equal h h'
then if Key.equal k k' then if Key.equal k k'
then S (h, k, v) (* replace *) then S (h, k, v) (* replace *)
else L (h, Cons (k, v, Cons (k', v', Nil))) else L (h, Cons (k, v, Cons (k', v', Nil)))
else else
make_array_ ~id ~leaf:(Cons (k', v', Nil)) ~h_leaf:h' k v ~h make_array_ ~id ~leaf:(Cons (k', v', Nil)) ~h_leaf:h' k v ~h
| L (h', l) -> | L (h', l) ->
if h=h' if Hash.equal h h'
then L (h, add_list_ k v l) then L (h, add_list_ k v l)
else (* split into N *) else (* split into N *)
make_array_ ~id ~leaf:l ~h_leaf:h' k v ~h make_array_ ~id ~leaf:l ~h_leaf:h' k v ~h

View file

@ -11,6 +11,7 @@ module Bit : sig
type t = private int type t = private int
val highest : int -> t val highest : int -> t
val min_int : t val min_int : t
val equal : t -> t -> bool
val is_0 : bit:t -> int -> bool val is_0 : bit:t -> int -> bool
val is_1 : 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 *) 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 min_int = min_int
let equal = (=)
let rec highest_bit_naive x m = let rec highest_bit_naive x m =
if x=m then m if x=m then m
else highest_bit_naive (x land (lnot m)) (2*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 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 | E, E -> true
| L (ka, va), L (kb, vb) -> ka = kb && eq va vb | L (ka, va), L (kb, vb) -> ka = kb && eq va vb
| N (pa, sa, la, ra), N (pb, sb, lb, rb) -> | 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, _ | E, _
| N _, _ | N _, _
| L _, _ -> false | L _, _ -> false
@ -287,7 +290,7 @@ let choose t =
with Not_found -> None with Not_found -> None
let rec union f t1 t2 = let rec union f t1 t2 =
if t1==t2 then t1 if Pervasives.(==) t1 t2 then t1
else match t1, t2 with else match t1, t2 with
| E, o | o, E -> o | E, o | o, E -> o
| L (k, v), o | L (k, v), o
@ -295,7 +298,7 @@ let rec union f t1 t2 =
(* insert k, v into o *) (* insert k, v into o *)
insert_ (fun ~old v -> f k old v) k v o insert_ (fun ~old v -> f k old v) k v o
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) -> | 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) 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 else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
then if Bit.is_0 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 = let rec inter f a b =
if a==b then a if Pervasives.(==) a b then a
else match a, b with else match a, b with
| E, _ | _, E -> E | E, _ | _, E -> E
| L (k, v), o | L (k, v), o
@ -353,7 +356,7 @@ let rec inter f a b =
with Not_found -> E with Not_found -> E
end end
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) -> | 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) 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 else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
then if Bit.is_0 p2 ~bit:m1 then if Bit.is_0 p2 ~bit:m1
@ -466,7 +469,7 @@ let compare ~cmp a b =
then then
let c = cmp va vb in let c = cmp va vb in
if c=0 then cmp_gen cmp a b else c if c=0 then cmp_gen cmp a b else c
else Pervasives.compare ka kb else compare ka kb
in in
cmp_gen cmp (to_gen a) (to_gen b) cmp_gen cmp (to_gen a) (to_gen b)

View file

@ -123,9 +123,13 @@ module Make(X : ORD) : S with type key = X.t = struct
let remove = M.remove let remove = M.remove
let is_some = function
| None -> false
| Some _ -> true
let mem ~inj x map = let mem ~inj x map =
try try
inj.get (M.find x map) <> None is_some (inj.get (M.find x map))
with Not_found -> false with Not_found -> false
let iter_keys ~f map = let iter_keys ~f map =

View file

@ -84,9 +84,13 @@ let remove tbl x = Hashtbl.remove tbl x
let copy tbl = Hashtbl.copy tbl let copy tbl = Hashtbl.copy tbl
let is_some = function
| None -> false
| Some _ -> true
let mem ~inj tbl x = let mem ~inj tbl x =
try try
inj.get (Hashtbl.find tbl x) <> None is_some (inj.get (Hashtbl.find tbl x))
with Not_found -> false with Not_found -> false
(*$R (*$R

View file

@ -5,6 +5,9 @@
type 'a sequence = ('a -> unit) -> unit type 'a sequence = ('a -> unit) -> unit
let max_int = max
let min_int = min
module type S = sig module type S = sig
type elt type elt
type t type t
@ -172,7 +175,7 @@ module Make(O : Set.OrderedType) = struct
(fun _ n1 n2 -> match n1, n2 with (fun _ n1 n2 -> match n1, n2 with
| None, None -> assert false | None, None -> assert false
| Some n, None | None, Some n -> Some n | 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 m1 m2
let intersection m1 m2 = let intersection m1 m2 =
@ -181,7 +184,7 @@ module Make(O : Set.OrderedType) = struct
| None, None -> assert false | None, None -> assert false
| Some _, None | Some _, None
| None, 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 m1 m2
let diff m1 m2 = let diff m1 m2 =

View file

@ -96,7 +96,7 @@ let tl l = match l with
(*$Q (*$Q
Q.(list_of_size Gen.(1--100) int) (fun l -> \ Q.(list_of_size Gen.(1--100) int) (fun l -> \
let l' = of_list l in \ 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 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 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 let rec aux ~eq l1 l2 = match l1, l2 with
| Nil, Nil -> true | Nil, Nil -> true
| Cons (size1, t1, l1'), Cons (size2, t2, l2') -> | Cons (size1, t1, l1'), Cons (size2, t2, l2') ->
@ -389,7 +389,7 @@ let equal ?(eq=(=)) l1 l2 =
(*$Q (*$Q
Q.(pair (list int)(list int)) (fun (l1,l2) -> \ 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} *) (** {2 Utils} *)
@ -543,7 +543,7 @@ let rec of_list_map ~f l = match l with
let y = f x in let y = f x in
cons y (of_list_map ~f l') 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 let rec cmp_gen ~cmp g1 g2 = match g1(), g2() with
| None, None -> 0 | None, None -> 0
| Some _, None -> 1 | Some _, None -> 1
@ -556,7 +556,7 @@ let compare ?(cmp=Pervasives.compare) l1 l2 =
(*$Q (*$Q
Q.(pair (list int)(list int)) (fun (l1,l2) -> \ 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} *) (** {2 Infix} *)

View file

@ -109,9 +109,9 @@ val rev_map : f:('a -> 'b) -> 'a t -> 'b t
val rev : 'a t -> 'a t val rev : 'a t -> 'a t
(** Reverse the list *) (** 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 *) (** Lexicographic comparison *)
(** {2 Utils} *) (** {2 Utils} *)

View file

@ -23,7 +23,11 @@ let make_ hd tl = match hd with
| [] -> {hd=List.rev tl; tl=[] } | [] -> {hd=List.rev tl; tl=[] }
| _::_ -> {hd; 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) 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 = let peek_exn q =
match q.hd with match q.hd with
| [] -> assert (q.tl = []); invalid_arg "Queue.peek" | [] -> assert (list_is_empty q.tl); invalid_arg "Queue.peek"
| x::_ -> x | x::_ -> x
let peek q = match q.hd with let peek q = match q.hd with
@ -40,7 +44,7 @@ let peek q = match q.hd with
let pop_exn q = let pop_exn q =
match q.hd with match q.hd with
| [] -> assert (q.tl = []); invalid_arg "Queue.peek" | [] -> assert (list_is_empty q.tl); invalid_arg "Queue.peek"
| x::hd' -> | x::hd' ->
let q' = make_ hd' q.tl in let q' = make_ hd' q.tl in
x, q' x, q'

View file

@ -527,7 +527,7 @@ module Make(W : WORD)
| Empty -> 0 | Empty -> 0
| Cons (_, t') -> size t' | Cons (_, t') -> size t'
| Node (v, map) -> | 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 M.fold
(fun _ t' acc -> size t' + acc) (fun _ t' acc -> size t' + acc)
map s map s

View file

@ -422,11 +422,11 @@ let of_gen g =
assert_equal [11;12] (drop 10 l |> take 2 |> to_list); 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 let l = to_list l in
of_list (List.sort cmp l) of_list (List.sort cmp l)
let sort_uniq ?(cmp=Pervasives.compare) l = let sort_uniq ~cmp l =
let l = to_list l in let l = to_list l in
uniq (fun x y -> cmp x y = 0) (of_list (List.sort cmp l)) uniq (fun x y -> cmp x y = 0) (of_list (List.sort cmp l))

View file

@ -164,12 +164,12 @@ val unzip : ('a * 'b) t -> 'a t * 'b t
(** {2 Misc} *) (** {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 (** Eager sort. Requires the iterator to be finite. O(n ln(n)) time
and space. and space.
@since 0.3.3 *) @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 (** Eager sort that removes duplicate values. Requires the iterator to be
finite. O(n ln(n)) time and space. finite. O(n ln(n)) time and space.
@since 0.3.3 *) @since 0.3.3 *)

View file

@ -91,7 +91,7 @@ class type ['a] pset = object
method mem : 'a -> bool method mem : 'a -> bool
end end
let set_of_cmp (type elt) ?(cmp=Pervasives.compare) () = let set_of_cmp (type elt) ~cmp () =
let module S = Set.Make(struct let module S = Set.Make(struct
type t = elt type t = elt
let compare = cmp let compare = cmp
@ -105,7 +105,7 @@ let set_of_cmp (type elt) ?(cmp=Pervasives.compare) () =
let _nil () = `Nil let _nil () = `Nil
let _cons x l = `Cons (x, l) 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 let rec dfs pset stack () = match stack with
| [] -> `Nil | [] -> `Nil
| `Explore t :: stack' -> | `Explore t :: stack' ->
@ -141,19 +141,23 @@ module FQ = struct
let empty = _make [] [] 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 push q x = _make q.hd (x::q.tl)
let pop_exn q = let pop_exn q =
match q.hd with match q.hd with
| [] -> assert (q.tl = []); raise Empty | [] -> assert (list_is_empty q.tl); raise Empty
| x::hd' -> | x::hd' ->
let q' = _make hd' q.tl in let q' = _make hd' q.tl in
x, q' x, q'
end end
let bfs ?(pset=set_of_cmp ()) t = let bfs ~pset t =
let rec bfs pset q () = let rec bfs pset q () =
if FQ.is_empty q then `Nil if FQ.is_empty q then `Nil
else else
@ -173,7 +177,7 @@ let rec force t : ([`Nil | `Node of 'a * 'b list] as 'b) = match t() with
| `Nil -> `Nil | `Nil -> `Nil
| `Node (x, l) -> `Node (x, List.map force l) | `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 let rec _find_kl f l = match l() with
| `Nil -> None | `Nil -> None
| `Cons (x, l') -> | `Cons (x, l') ->
@ -181,7 +185,7 @@ let find ?pset f t =
| None -> _find_kl f l' | None -> _find_kl f l'
| Some _ as res -> res | Some _ as res -> res
in in
_find_kl f (bfs ?pset t) _find_kl f (bfs ~pset t)
(** {2 Pretty-printing} *) (** {2 Pretty-printing} *)

View file

@ -80,13 +80,13 @@ class type ['a] pset = object
method mem : 'a -> bool method mem : 'a -> bool
end 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 *) (** 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 *) (** 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 *) (** Breadth-first traversal of the tree *)
val force : 'a t -> ([ `Nil | `Node of 'a * 'b list ] as 'b) 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 structure
@since 0.13 *) @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 _] *) (** Look for an element that maps to [Some _] *)
(** {2 Pretty-printing} (** {2 Pretty-printing}

View file

@ -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

View file

@ -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."]

View file

@ -13,9 +13,32 @@ type t = [
] ]
type sexp = 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 let hash a = Hashtbl.hash a

View file

@ -20,9 +20,11 @@
| Escaped_int_1 of int | Escaped_int_1 of int
| Escaped_int_2 of int | Escaped_int_2 of int
let char_equal (a : char) b = Pervasives.(=) a b
(* remove quotes + unescape *) (* remove quotes + unescape *)
let remove_quotes lexbuf s = 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 buf = Buffer.create (String.length s) in
let st = ref Not_escaped in let st = ref Not_escaped in
for i = 1 to String.length s-2 do for i = 1 to String.length s-2 do
@ -72,4 +74,3 @@ rule token = parse
| string { ATOM (remove_quotes lexbuf (Lexing.lexeme lexbuf)) } | string { ATOM (remove_quotes lexbuf (Lexing.lexeme lexbuf)) }
| _ as c | _ as c
{ error lexbuf (Printf.sprintf "lexing failed on char `%c`" c) } { error lexbuf (Printf.sprintf "lexing failed on char `%c`" c) }

View file

@ -314,11 +314,15 @@ module Make(P : PARAM) = struct
| Run cell -> | Run cell ->
with_lock_ cell (fun cell -> cell.state) with_lock_ cell (fun cell -> cell.state)
let is_not_waiting = function
| Waiting -> false
| Failed _ | Done _ -> true
let is_done = function let is_done = function
| Return _ | Return _
| FailNow _ -> true | FailNow _ -> true
| Run cell -> | Run cell ->
with_lock_ cell (fun c -> c.state <> Waiting) with_lock_ cell (fun c -> is_not_waiting c.state)
(** {2 Combinators *) (** {2 Combinators *)

View file

@ -6,6 +6,11 @@
type job = type job =
| Job : float * (unit -> 'a) -> 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 module TaskHeap = CCHeap.Make(struct
type t = job type t = job
let leq (Job(f1,_)) (Job (f2,_)) = f1 <= f2 let leq (Job(f1,_)) (Job (f2,_)) = f1 <= f2