simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2026-01-23 17:46:40 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge pull request #169 from jpdeplaix/CCMonomorphic

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.merlin
View file

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

16
_oasis
View file

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

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)
true: no_alias_deps, safe_string, short_paths, color(always)
<src/**/*Labels.cm*>: nolabels
not (<src/monomorphic/CCMonomorphic.*> or <qtest/*>): open(CCMonomorphic)

34
benchs/run_benchs.ml
View file

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

2
opam
View file

@ -39,6 +39,6 @@ conflicts: [
tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ]
homepage: "https://github.com/c-cube/ocaml-containers/"
doc: "http://cedeela.fr/~simon/software/containers/"
available: [ocaml-version >= "4.01.0"]
available: [ocaml-version >= "4.02.0"]
dev-repo: "https://github.com/c-cube/ocaml-containers.git"
bug-reports: "https://github.com/c-cube/ocaml-containers/issues/"

39
src/core/CCArray.ml
View file

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

8
src/core/CCArray.mli
View file

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

8
src/core/CCArrayLabels.mli
View file

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

12
src/core/CCArray_slice.ml
View file

@ -85,6 +85,7 @@ let rec _compare cmp a1 i1 j1 a2 i2 j2 =
let equal eq a b =
length a = length b && _equal eq a.arr a.i a.j b.arr b.i b.j
let compare_int (a : int) b = Pervasives.compare a b
let compare cmp a b =
_compare cmp a.arr a.i a.j b.arr b.i b.j
@ -292,9 +293,8 @@ let sorted cmp a = _sorted cmp a.arr a.i a.j
let sort_ranking cmp a =
let idx = _sort_indices cmp a.arr a.i a.j in
let cmp_int : int -> int -> int = Pervasives.compare in
let sort_indices cmp a = _sort_indices cmp a 0 (Array.length a) in
sort_indices cmp_int idx
sort_indices compare_int idx
(*$= & ~cmp:(=) ~printer:Q.Print.(array int)
[||] \
@ -345,18 +345,18 @@ let find_idx p a =
(Some (1,"c")) (find_idx ((=) "c") (make [| "a"; "b"; "c" |] 1 2))
*)
let lookup_exn ?(cmp=Pervasives.compare) k a =
let lookup_exn ~cmp k a =
_lookup_exn ~cmp k a.arr a.i (a.j-1) - a.i
let lookup ?(cmp=Pervasives.compare) k a =
let lookup ~cmp k a =
try Some (_lookup_exn ~cmp k a.arr a.i (a.j-1) - a.i)
with Not_found -> None
(*$=
(Some 1) (lookup "c" (make [| "a"; "b"; "c" |] 1 2))
(Some 1) (lookup ~cmp:CCString.compare "c" (make [| "a"; "b"; "c" |] 1 2))
*)
let bsearch ?(cmp=Pervasives.compare) k a =
let bsearch ~cmp k a =
match bsearch_ ~cmp k a.arr a.i (a.j - 1) with
| `At m -> `At (m - a.i)
| `Just_after m -> `Just_after (m - a.i)

12
src/core/CCArray_slice.mli
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
(** [sort_indices cmp a] returns a new array [b], with the same length as [a],
such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a]
such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a]
appears in [a]. [a] is not modified.
In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a].
In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a].
[sort_indices] yields the inverse permutation of {!sort_ranking}.
@since 1.0 *)
@ -99,7 +99,7 @@ val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array
such that [b.(i)] is the index at which the [i]-the element of [a] appears
in [sorted cmp a]. [a] is not modified.
In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a].
In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a].
[sort_ranking] yields the inverse permutation of {!sort_indices}.
In the absence of duplicate elements in [a], we also have
@ -119,16 +119,16 @@ val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option
and [p x] holds. Otherwise returns [None]
@since 0.3.4 *)
val lookup : ?cmp:'a ord -> 'a -> 'a t -> int option
val lookup : cmp:'a ord -> 'a -> 'a t -> int option
(** Lookup the index of some value in a sorted array.
@return [None] if the key is not present, or
[Some i] ([i] the index of the key) otherwise *)
val lookup_exn : ?cmp:'a ord -> 'a -> 'a t -> int
val lookup_exn : cmp:'a ord -> 'a -> 'a t -> int
(** Same as {!lookup}, but
@raise Not_found if the key is not present *)
val bsearch : ?cmp:('a -> 'a -> int) -> 'a -> 'a t ->
val bsearch : cmp:('a -> 'a -> int) -> 'a -> 'a t ->
[ `All_lower | `All_bigger | `Just_after of int | `Empty | `At of int ]
(** [bsearch ?cmp x arr] finds the index of the object [x] in the array [arr],
provided [arr] is {b sorted} using [cmp]. If the array is not sorted,

2
src/core/CCBool.ml
View file

@ -3,7 +3,7 @@
type t = bool
let equal (a:bool) b = a=b
let equal (a:bool) b = Pervasives.(=) a b
let compare (a:bool) b = Pervasives.compare a b

16
src/core/CCChar.ml
View file

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

9
src/core/CCEqual.ml
View file

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

4
src/core/CCEqual.mli
View file

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

20
src/core/CCFloat.ml
View file

@ -9,6 +9,16 @@ type fpclass = Pervasives.fpclass =
| FP_infinite
| FP_nan
module Infix = struct
let (=) = Pervasives.(=)
let (<>) = Pervasives.(<>)
let (<) = Pervasives.(<)
let (>) = Pervasives.(>)
let (<=) = Pervasives.(<=)
let (>=) = Pervasives.(>=)
end
include Infix
let nan = Pervasives.nan
let infinity = Pervasives.infinity
@ -84,13 +94,3 @@ let random_range i j st = i +. random (j-.i) st
let equal_precision ~epsilon a b = abs_float (a-.b) < epsilon
let classify = Pervasives.classify_float
module Infix = struct
let (=) = Pervasives.(=)
let (<>) = Pervasives.(<>)
let (<) = Pervasives.(<)
let (>) = Pervasives.(>)
let (<=) = Pervasives.(<=)
let (>=) = Pervasives.(>=)
end
include Infix

18
src/core/CCInt.ml
View file

@ -5,7 +5,7 @@ type t = int
let equal (a:int) b = a=b
let compare (a:int) b = Pervasives.compare a b
let compare a b = compare a b
let hash i = i land max_int
@ -75,9 +75,11 @@ let floor_div a n =
(fun (n, m) -> floor_div n (-m) = int_of_float @@ floor (float n /. float (-m)))
*)
let bool_neq (a : bool) b = Pervasives.(<>) a b
let rem a n =
let y = a mod n in
if (y < 0) <> (n < 0) && y <> 0 then
if bool_neq (y < 0) (n < 0) && y <> 0 then
y + n
else
y
@ -245,12 +247,12 @@ let range' i j yield =
module Infix = struct
let (=) = Pervasives.(=)
let (<>) = Pervasives.(<>)
let (<) = Pervasives.(<)
let (>) = Pervasives.(>)
let (<=) = Pervasives.(<=)
let (>=) = Pervasives.(>=)
let (=) = (=)
let (<>) = (<>)
let (<) = (<)
let (>) = (>)
let (<=) = (<=)
let (>=) = (>=)
let (--) = range
let (--^) = range'
end

2
src/core/CCInt64.ml
View file

@ -28,7 +28,7 @@ let (lsr) = shift_right_logical
let (asr) = shift_right
let equal (x:t) y = x=y
let equal (x:t) y = Pervasives.(=) x y
let hash x = Pervasives.abs (to_int x)

135
src/core/CCList.ml
View file

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

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

62
src/core/CCListLabels.mli
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],
and [p x] holds. Otherwise returns [None] *)
val remove : ?eq:('a -> 'a -> bool) -> key:'a -> 'a t -> 'a t
val remove : eq:('a -> 'a -> bool) -> key:'a -> 'a t -> 'a t
(** [remove ~key l] removes every instance of [key] from [l]. Tailrec.
@param eq equality function
@since 0.11 *)
@ -186,23 +186,23 @@ val remove : ?eq:('a -> 'a -> bool) -> key:'a -> 'a t -> 'a t
val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
(** Map and remove elements at the same time *)
val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
val sorted_merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** Merges elements from both sorted list *)
val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list
val sort_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list
(** Sort the list and remove duplicate elements *)
val sorted_merge_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
val sorted_merge_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** [sorted_merge_uniq l1 l2] merges the sorted lists [l1] and [l2] and
removes duplicates
@since 0.10 *)
val is_sorted : ?cmp:('a -> 'a -> int) -> 'a list -> bool
val is_sorted : cmp:('a -> 'a -> int) -> 'a list -> bool
(** [is_sorted l] returns [true] iff [l] is sorted (according to given order)
@param cmp the comparison function (default [Pervasives.compare])
@since 0.17 *)
val sorted_insert : ?cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list
val sorted_insert : cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list
(** [sorted_insert x l] inserts [x] into [l] such that, if [l] was sorted,
then [sorted_insert x l] is sorted too.
@param uniq if true and [x] is already in sorted position in [l], then
@ -215,14 +215,14 @@ val sorted_insert : ?cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a
is_sorted (sorted_insert x l))
*)
val uniq_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list
val uniq_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list
(** [uniq_succ l] removes duplicate elements that occur one next to the other.
Examples:
[uniq_succ [1;2;1] = [1;2;1]]
[uniq_succ [1;1;2] = [1;2]]
@since 0.10 *)
val group_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list list
val group_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list list
(** [group_succ ~eq l] groups together consecutive elements that are equal
according to [eq]
@since 0.11 *)
@ -259,30 +259,30 @@ val remove_at_idx : int -> 'a t -> 'a t
Those operations maintain the invariant that the list does not
contain duplicates (if it already satisfies it) *)
val add_nodup : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
val add_nodup : eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
(** [add_nodup x set] adds [x] to [set] if it was not already present. Linear time.
@since 0.11 *)
val remove_one : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
val remove_one : eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
(** [remove_one x set] removes one occurrence of [x] from [set]. Linear time.
@since 0.11 *)
val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
val mem : eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
(** Membership to the list. Linear time *)
val subset : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val subset : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** Test for inclusion *)
val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t
val uniq : eq:('a -> 'a -> bool) -> 'a t -> 'a t
(** Remove duplicates w.r.t the equality predicate.
Complexity is quadratic in the length of the list, but the order
of elements is preserved. If you wish for a faster de-duplication
but do not care about the order, use {!sort_uniq}*)
val union : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
val union : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
(** List union. Complexity is product of length of inputs. *)
val inter : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
val inter : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
(** List intersection. Complexity is product of length of inputs. *)
(** {2 Other Constructors} *)
@ -320,32 +320,52 @@ val repeat : int -> 'a t -> 'a t
module Assoc : sig
type ('a, 'b) t = ('a*'b) list
val get : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b option
val get : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b option
(** Find the element *)
val get_exn : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b
val get_exn : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b
(** Same as [get], but unsafe
@raise Not_found if the element is not present *)
val set : ?eq:('a->'a->bool) -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t
val set : eq:('a->'a->bool) -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t
(** Add the binding into the list (erase it if already present) *)
val mem : ?eq:('a->'a->bool) -> 'a -> ('a,_) t -> bool
val mem : eq:('a->'a->bool) -> 'a -> ('a,_) t -> bool
(** [mem x l] returns [true] iff [x] is a key in [l]
@since 0.16 *)
val update :
?eq:('a->'a->bool) -> f:('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t
eq:('a->'a->bool) -> f:('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t
(** [update k ~f l] updates [l] on the key [k], by calling [f (get l k)]
and removing [k] if it returns [None], mapping [k] to [v'] if it
returns [Some v']
@since 0.16 *)
val remove : ?eq:('a->'a->bool) -> 'a -> ('a,'b) t -> ('a,'b) t
val remove : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> ('a,'b) t
(** [remove x l] removes the first occurrence of [k] from [l].
@since 0.17 *)
end
val assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b
(** Same as [Assoc.get_exn]
@since NEXT_RELEASE *)
val assoc_opt : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b option
(** Same as [Assoc.get]
@since NEXT_RELEASE *)
val assq_opt : 'a -> ('a * 'b) t -> 'b option
(** Safe version of {!assq}
@since NEXT_RELEASE *)
val mem_assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * _) t -> bool
(** Same as [Assoc.mem]
@since NEXT_RELEASE *)
val remove_assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> ('a * 'b) t
(** Same as [Assoc.remove]
@since NEXT_RELEASE *)
(** {2 References on Lists}
@since 0.3.3 *)

13
src/core/CCParse.ml
View file

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

5
src/core/CCRandom.ml
View file

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

2
src/core/CCRandom.mli
View file

@ -56,7 +56,7 @@ val replicate : int -> 'a t -> 'a list t
randomly using [g] *)
val sample_without_replacement:
?compare:('a -> 'a -> int) -> int -> 'a t -> 'a list t
compare:('a -> 'a -> int) -> int -> 'a t -> 'a list t
(** [sample_without_replacement n g] makes a list of [n] elements which are all
generated randomly using [g] with the added constraint that none of the generated
random values are equal

4
src/core/CCResult.ml
View file

@ -109,12 +109,12 @@ let (>|=) e f = map f e
let (>>=) e f = flat_map f e
let equal ?(err=Pervasives.(=)) eq a b = match a, b with
let equal ~err eq a b = match a, b with
| Ok x, Ok y -> eq x y
| Error s, Error s' -> err s s'
| _ -> false
let compare ?(err=Pervasives.compare) cmp a b = match a, b with
let compare ~err cmp a b = match a, b with
| Ok x, Ok y -> cmp x y
| Ok _, _ -> 1
| _, Ok _ -> -1

4
src/core/CCResult.mli
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 equal : ?err:'err equal -> 'a equal -> ('a, 'err) t equal
val equal : err:'err equal -> 'a equal -> ('a, 'err) t equal
val compare : ?err:'err ord -> 'a ord -> ('a, 'err) t ord
val compare : err:'err ord -> 'a ord -> ('a, 'err) t ord
val fold : ok:('a -> 'b) -> error:('err -> 'b) -> ('a, 'err) t -> 'b
(** [fold ~ok ~error e] opens [e] and, if [e = Ok x], returns

26
src/core/CCString.ml
View file

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

4
src/core/CCVector.ml
View file

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

2
src/core/CCVector.mli
View file

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

3
src/core/containers.ml
View file

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

25
src/data/CCCache.ml
View file

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

8
src/data/CCCache.mli
View file

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

21
src/data/CCDeque.ml
View file

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

4
src/data/CCDeque.mli
View file

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

6
src/data/CCFQueue.ml
View file

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

62
src/data/CCGraph.ml
View file

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

43
src/data/CCGraph.mli
View file

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

10
src/data/CCHashTrie.ml
View file

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

17
src/data/CCIntMap.ml
View file

@ -11,6 +11,7 @@ module Bit : sig
type t = private int
val highest : int -> t
val min_int : t
val equal : t -> t -> bool
val is_0 : bit:t -> int -> bool
val is_1 : bit:t -> int -> bool
val mask : mask:t -> int -> int (* zeroes the bit, puts all lower bits to 1 *)
@ -21,6 +22,8 @@ end = struct
let min_int = min_int
let equal = (=)
let rec highest_bit_naive x m =
if x=m then m
else highest_bit_naive (x land (lnot m)) (2*m)
@ -237,11 +240,11 @@ let update k f t =
let doubleton k1 v1 k2 v2 = add k1 v1 (singleton k2 v2)
let rec equal ~eq a b = a==b || match a, b with
let rec equal ~eq a b = Pervasives.(==) a b || match a, b with
| E, E -> true
| L (ka, va), L (kb, vb) -> ka = kb && eq va vb
| N (pa, sa, la, ra), N (pb, sb, lb, rb) ->
pa=pb && sa=sb && equal ~eq la lb && equal ~eq ra rb
pa=pb && Bit.equal sa sb && equal ~eq la lb && equal ~eq ra rb
| E, _
| N _, _
| L _, _ -> false
@ -287,7 +290,7 @@ let choose t =
with Not_found -> None
let rec union f t1 t2 =
if t1==t2 then t1
if Pervasives.(==) t1 t2 then t1
else match t1, t2 with
| E, o | o, E -> o
| L (k, v), o
@ -295,7 +298,7 @@ let rec union f t1 t2 =
(* insert k, v into o *)
insert_ (fun ~old v -> f k old v) k v o
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
if p1 = p2 && m1 = m2
if p1 = p2 && Bit.equal m1 m2
then mk_node_ p1 m1 (union f l1 l2) (union f r1 r2)
else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
then if Bit.is_0 p2 ~bit:m1
@ -342,7 +345,7 @@ let rec union f t1 t2 =
*)
let rec inter f a b =
if a==b then a
if Pervasives.(==) a b then a
else match a, b with
| E, _ | _, E -> E
| L (k, v), o
@ -353,7 +356,7 @@ let rec inter f a b =
with Not_found -> E
end
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
if p1 = p2 && m1 = m2
if p1 = p2 && Bit.equal m1 m2
then mk_node_ p1 m1 (inter f l1 l2) (inter f r1 r2)
else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
then if Bit.is_0 p2 ~bit:m1
@ -466,7 +469,7 @@ let compare ~cmp a b =
then
let c = cmp va vb in
if c=0 then cmp_gen cmp a b else c
else Pervasives.compare ka kb
else compare ka kb
in
cmp_gen cmp (to_gen a) (to_gen b)

6
src/data/CCMixmap.ml
View file

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

6
src/data/CCMixtbl.ml
View file

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

7
src/data/CCMultiSet.ml
View file

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

10
src/data/CCRAL.ml
View file

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

4
src/data/CCRAL.mli
View file

@ -109,9 +109,9 @@ val rev_map : f:('a -> 'b) -> 'a t -> 'b t
val rev : 'a t -> 'a t
(** Reverse the list *)
val equal : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val equal : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
val compare : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
val compare : cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
(** Lexicographic comparison *)
(** {2 Utils} *)

10
src/data/CCSimple_queue.ml
View file

@ -23,7 +23,11 @@ let make_ hd tl = match hd with
| [] -> {hd=List.rev tl; tl=[] }
| _::_ -> {hd; tl; }
let is_empty q = q.hd = []
let list_is_empty = function
| [] -> true
| _::_ -> false
let is_empty q = list_is_empty q.hd
let push x q = make_ q.hd (x :: q.tl)
@ -31,7 +35,7 @@ let snoc q x = push x q
let peek_exn q =
match q.hd with
| [] -> assert (q.tl = []); invalid_arg "Queue.peek"
| [] -> assert (list_is_empty q.tl); invalid_arg "Queue.peek"
| x::_ -> x
let peek q = match q.hd with
@ -40,7 +44,7 @@ let peek q = match q.hd with
let pop_exn q =
match q.hd with
| [] -> assert (q.tl = []); invalid_arg "Queue.peek"
| [] -> assert (list_is_empty q.tl); invalid_arg "Queue.peek"
| x::hd' ->
let q' = make_ hd' q.tl in
x, q'

2
src/data/CCTrie.ml
View file

@ -527,7 +527,7 @@ module Make(W : WORD)
| Empty -> 0
| Cons (_, t') -> size t'
| Node (v, map) ->
let s = if v=None then 0 else 1 in
let s = match v with None -> 0 | Some _ -> 1 in
M.fold
(fun _ t' acc -> size t' + acc)
map s

4
src/iter/CCKList.ml
View file

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

4
src/iter/CCKList.mli
View file

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

18
src/iter/CCKTree.ml
View file

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

8
src/iter/CCKTree.mli
View file

@ -80,13 +80,13 @@ class type ['a] pset = object
method mem : 'a -> bool
end
val set_of_cmp : ?cmp:('a -> 'a -> int) -> unit -> 'a pset
val set_of_cmp : cmp:('a -> 'a -> int) -> unit -> 'a pset
(** Build a set structure given a total ordering *)
val dfs : ?pset:'a pset -> 'a t -> [ `Enter of 'a | `Exit of 'a ] klist
val dfs : pset:'a pset -> 'a t -> [ `Enter of 'a | `Exit of 'a ] klist
(** Depth-first traversal of the tree *)
val bfs : ?pset:'a pset -> 'a t -> 'a klist
val bfs : pset:'a pset -> 'a t -> 'a klist
(** Breadth-first traversal of the tree *)
val force : 'a t -> ([ `Nil | `Node of 'a * 'b list ] as 'b)
@ -94,7 +94,7 @@ val force : 'a t -> ([ `Nil | `Node of 'a * 'b list ] as 'b)
structure
@since 0.13 *)
val find : ?pset:'a pset -> ('a -> 'b option) -> 'a t -> 'b option
val find : pset:'a pset -> ('a -> 'b option) -> 'a t -> 'b option
(** Look for an element that maps to [Some _] *)
(** {2 Pretty-printing}

6
src/monomorphic/CCMonomorphic.ml Normal file
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

19
src/monomorphic/CCMonomorphic.mli Normal file
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."]

27
src/sexp/CCSexp.ml
View file

@ -13,9 +13,32 @@ type t = [
]
type sexp = t
let equal a b = a = b
let equal_string (a : string) b = Pervasives.(=) a b
let compare a b = Pervasives.compare a b
let rec equal a b = match a, b with
| `Atom s1, `Atom s2 ->
equal_string s1 s2
| `List l1, `List l2 ->
begin try List.for_all2 equal l1 l2 with Invalid_argument _ -> false end
| `Atom _, _ | `List _, _ -> false
let compare_string (a : string) b = Pervasives.compare a b
let rec compare_list a b = match a, b with
| [], [] -> 0
| [], _::_ -> -1
| _::_, [] -> 1
| x::xs, y::ys ->
begin match compare x y with
| 0 -> compare_list xs ys
| c -> c
end
and compare a b = match a, b with
| `Atom s1, `Atom s2 -> compare_string s1 s2
| `List l1, `List l2 -> compare_list l1 l2
| `Atom _, _ -> -1
| `List _, _ -> 1
let hash a = Hashtbl.hash a

5
src/sexp/CCSexp_lex.mll
View file

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

6
src/threads/CCPool.ml
View file

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

5
src/threads/CCTimer.ml
View file

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