Avoid uses of the polymorphic operators

This commit is contained in:
Jacques-Pascal Deplaix 2017-12-28 19:19:29 +01:00
parent 35b4e772be
commit 9622f6f6ff
32 changed files with 244 additions and 218 deletions

View file

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

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,10 +296,10 @@ 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
@ -314,7 +313,7 @@ let lookup ?(cmp=Pervasives.compare) k a =
lookup 2 [| 1 |] = None lookup 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
@ -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,10 +345,10 @@ 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
@ -356,7 +356,7 @@ let lookup ?(cmp=Pervasives.compare) k a =
(Some 1) (lookup "c" (make [| "a"; "b"; "c" |] 1 2)) (Some 1) (lookup "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

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

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

@ -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=Pervasives.(=)) 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=Pervasives.(=)) 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=Pervasives.(=)) 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=Pervasives.(=)) 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 =
@ -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=Pervasives.(=)) ~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=Pervasives.(=)) ~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=Pervasives.(=)) 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=Pervasives.(=)) 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=Pervasives.(=)) 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
@ -998,12 +998,12 @@ let remove_one ?(eq=Pervasives.(=)) x l =
not (mem x l) || List.length (remove_one x l) = List.length l - 1) not (mem x l) || List.length (remove_one x l) = List.length l - 1)
*) *)
let subset ?(eq=Pervasives.(=)) 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=Pervasives.(=)) 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
@ -1019,7 +1019,7 @@ let uniq ?(eq=Pervasives.(=)) l =
sort_uniq l = (uniq l |> sort Pervasives.compare)) sort_uniq l = (uniq l |> sort Pervasives.compare))
*) *)
let union ?(eq=Pervasives.(=)) 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
@ -1030,7 +1030,7 @@ let union ?(eq=Pervasives.(=)) l1 l2 =
union [1;2;4] [2;3;4;5] = [1;2;3;4;5] union [1;2;4] [2;3;4;5] = [1;2;3;4;5]
*) *)
let inter ?(eq=Pervasives.(=)) 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
@ -1236,9 +1236,9 @@ 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=Pervasives.(=)) x l = search_exn eq l x let get_exn ~eq x l = search_exn eq l x
let get ?(eq=Pervasives.(=)) 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
@ -1259,7 +1259,7 @@ 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=Pervasives.(=)) 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)
@ -1270,7 +1270,7 @@ module Assoc = struct
= [1, "1"; 2, "2"; 3, "3"] = [1, "1"; 2, "2"; 3, "3"]
*) *)
let mem ?(eq=Pervasives.(=)) 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
@ -1279,7 +1279,7 @@ module Assoc = struct
not (Assoc.mem 4 [1,"1"; 2,"2"; 3, "3"]) not (Assoc.mem 4 [1,"1"; 2,"2"; 3, "3"])
*) *)
let update ?(eq=Pervasives.(=)) ~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
@ -1297,7 +1297,7 @@ module Assoc = struct
~f:(function None -> Some "3" | _ -> assert false) |> lsort) ~f:(function None -> Some "3" | _ -> assert false) |> lsort)
*) *)
let remove ?(eq=Pervasives.(=)) 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 *)

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
@ -316,14 +316,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 *)
@ -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,28 +437,28 @@ 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

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,28 +320,28 @@ 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

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=Pervasives.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

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

@ -58,6 +58,7 @@ end
let equal (a:string) b = Pervasives.(=) 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
@ -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)

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=Pervasives.(=)) 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

@ -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} *)
@ -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);
@ -176,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);
@ -298,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
@ -360,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

@ -379,7 +379,7 @@ let copy d =
assert_equal ~cmp q q' assert_equal ~cmp q q'
*) *)
let equal ?(eq=Pervasives.(=)) 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 _
@ -387,7 +387,7 @@ let equal ?(eq=Pervasives.(=)) 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

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

@ -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=Pervasives.(=)) ?(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=Pervasives.(=)) ?(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=Pervasives.(=)) ~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,12 +279,12 @@ 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
@ -305,8 +305,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 +316,7 @@ let is_dag ?(tbl=mk_table 128) ~graph vs =
exception Has_cycle exception Has_cycle
let topo_sort_tag ?(eq=Pervasives.(=)) ?(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,12 +331,12 @@ let topo_sort_tag ?(eq=Pervasives.(=)) ?(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 l = topo_sort ~graph:divisors_graph (Seq.return 42) in \
@ -393,7 +393,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,7 +482,7 @@ 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
@ -541,8 +541,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=Pervasives.(=)) ~eq
?(attrs_v=fun _ -> []) ?(attrs_v=fun _ -> [])
?(attrs_e=fun _ -> []) ?(attrs_e=fun _ -> [])
?(name="graph") ?(name="graph")
@ -598,8 +598,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 +622,7 @@ type ('v, 'e) mut_graph = {
remove : 'v -> unit; remove : 'v -> unit;
} }
let mk_mut_tbl (type k) ?(eq=Pervasives.(=)) ?(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 +757,7 @@ end
(** {2 Misc} *) (** {2 Misc} *)
let of_list ?(eq=Pervasives.(=)) 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

@ -22,7 +22,7 @@ end = struct
let min_int = min_int let min_int = min_int
let equal (a : int) b = Pervasives.(=) a b 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
@ -469,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

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

@ -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=Pervasives.(=)) 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') ->
@ -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

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

@ -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' ->
@ -157,7 +157,7 @@ module FQ = struct
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
@ -177,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') ->
@ -185,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

@ -13,9 +13,32 @@ type t = [
] ]
type sexp = t type sexp = t
let equal (a : sexp) b = Pervasives.(=) 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