From 6d2063ded494260c6c484c74963ec3631e799aa2 Mon Sep 17 00:00:00 2001 From: Jacques-Pascal Deplaix Date: Thu, 21 Dec 2017 16:29:35 +0000 Subject: [PATCH] Internally shadow polymorphic operators and functions from Pervasives --- .merlin | 1 + _oasis | 9 +++++---- _tags | 1 + benchs/run_benchs.ml | 14 +++++++------- opam | 2 +- src/core/CCBool.ml | 2 +- src/core/CCChar.ml | 16 +++++++--------- src/core/CCEqual.ml | 8 ++++---- src/core/CCFloat.ml | 20 ++++++++++---------- src/core/CCInt.ml | 4 +++- src/core/CCInt64.ml | 2 +- src/core/CCList.ml | 34 +++++++++++++++++----------------- src/core/CCParse.ml | 13 ++++++++----- src/core/CCRandom.ml | 3 ++- src/core/CCString.ml | 21 ++++++++------------- src/core/CCVector.ml | 2 +- src/data/CCCache.ml | 6 +++++- src/data/CCDeque.ml | 7 ++++--- src/data/CCFQueue.ml | 6 +++++- src/data/CCGraph.ml | 12 ++++++------ src/data/CCHashTrie.ml | 6 ++++-- src/data/CCIntMap.ml | 9 ++++++--- src/data/CCMixmap.ml | 6 +++++- src/data/CCMixtbl.ml | 6 +++++- src/data/CCRAL.ml | 2 +- src/data/CCSimple_queue.ml | 10 +++++++--- src/data/CCTrie.ml | 2 +- src/iter/CCKTree.ml | 8 ++++++-- src/sexp/CCSexp.ml | 2 +- src/sexp/CCSexp_lex.mll | 5 +++-- src/threads/CCPool.ml | 6 +++++- src/threads/CCTimer.ml | 5 +++++ 32 files changed, 146 insertions(+), 104 deletions(-) diff --git a/.merlin b/.merlin index 0e4c8f02..7cf051e1 100644 --- a/.merlin +++ b/.merlin @@ -20,3 +20,4 @@ PKG threads.posix PKG lwt PKG qcheck FLG -w +a-4-44-48-60@8 +FLG -open CCMonomorphic diff --git a/_oasis b/_oasis index c388c63d..9c663cad 100644 --- a/_oasis +++ b/_oasis @@ -44,7 +44,7 @@ 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" @@ -56,14 +56,14 @@ Library "containers_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 @@ -75,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 @@ -83,6 +83,7 @@ Library "containers_data" Library "containers_iter" Path: src/iter Modules: CCKTree, CCKList, CCLazy_list + BuildDepends: containers.monomorphic FindlibParent: containers FindlibName: iter diff --git a/_tags b/_tags index 51eb014f..1f3db001 100644 --- a/_tags +++ b/_tags @@ -161,3 +161,4 @@ true: annot, bin_annot and not : warn(+a-4-44-58-60@8) true: no_alias_deps, safe_string, short_paths, color(always) : nolabels +not ( or ): open(CCMonomorphic) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index 8e10fc0d..4eb98522 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -280,7 +280,7 @@ module Arr = struct let a2 = Array.copy a1 in sort_std a1; quicksort ~limit:10 a2; - assert (a1 = a2)) + assert (CCArray.equal CCInt.equal a1 a2)) [ 10; 100; 1000] let bench_sort ?(time=2) n = @@ -1154,7 +1154,7 @@ module Str = struct and mk_current () = CCString.find_all_l ~sub:needle haystack and mk_current_compiled = let f = CCString.find_all_l ~start:0 ~sub:needle in fun () -> f haystack in - assert (mk_naive () = mk_current ()); + assert (CCList.equal CCInt.equal (mk_naive ()) (mk_current ())); B.throughputN 3 ~repeat [ "naive", mk_naive, () ; "current", mk_current, () @@ -1168,7 +1168,7 @@ module Str = struct pp_pb needle haystack; let mk_naive () = find_all_l ~sub:needle haystack and mk_current () = CCString.find_all_l ~sub:needle haystack in - assert (mk_naive () = mk_current ()); + assert (CCList.equal CCInt.equal (mk_naive ()) (mk_current ())); B.throughputN 3 ~repeat [ "naive", mk_naive, () ; "current", mk_current, () @@ -1182,7 +1182,7 @@ module Str = struct let rec same s1 s2 i = if i = String.length s1 then true else ( - String.unsafe_get s1 i = String.unsafe_get s2 i && same s1 s2 (i+1) + CCChar.equal (String.unsafe_get s1 i) (String.unsafe_get s2 i) && same s1 s2 (i+1) ) in String.length pre <= String.length s && @@ -1193,7 +1193,7 @@ module Str = struct begin let i = ref 0 in while !i < String.length pre && - String.unsafe_get s !i = String.unsafe_get pre !i + CCChar.equal (String.unsafe_get s !i) (String.unsafe_get pre !i) do incr i done; !i = String.length pre end @@ -1225,7 +1225,7 @@ module Str = struct else let rec loop str p i = if i = len then true - else if String.unsafe_get str i <> String.unsafe_get p i then false + else if not (CCChar.equal (String.unsafe_get str i) (String.unsafe_get p i)) then false else loop str p (i + 1) in loop str p 0 @@ -1256,7 +1256,7 @@ module Str = struct Array.iteri (fun i (pre, y) -> let res = f ~pre y in - assert (res = output.(i))) + assert (CCBool.equal res output.(i))) input in Benchmark.throughputN 3 diff --git a/opam b/opam index a82de59b..f930cfba 100644 --- a/opam +++ b/opam @@ -39,6 +39,6 @@ conflicts: [ tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ] homepage: "https://github.com/c-cube/ocaml-containers/" doc: "http://cedeela.fr/~simon/software/containers/" -available: [ocaml-version >= "4.01.0"] +available: [ocaml-version >= "4.02.0"] dev-repo: "https://github.com/c-cube/ocaml-containers.git" bug-reports: "https://github.com/c-cube/ocaml-containers/issues/" diff --git a/src/core/CCBool.ml b/src/core/CCBool.ml index 087d0101..89a6a9e5 100644 --- a/src/core/CCBool.ml +++ b/src/core/CCBool.ml @@ -3,7 +3,7 @@ type t = bool -let equal (a:bool) b = a=b +let equal (a:bool) b = Pervasives.(=) a b let compare (a:bool) b = Pervasives.compare a b diff --git a/src/core/CCChar.ml b/src/core/CCChar.ml index 55900bd6..68d45cad 100644 --- a/src/core/CCChar.ml +++ b/src/core/CCChar.ml @@ -6,7 +6,7 @@ include Char -let equal (a:char) b = a=b +let equal (a:char) b = Pervasives.(=) a b let pp = Buffer.add_char let print = Format.pp_print_char @@ -15,12 +15,10 @@ let of_int_exn = Char.chr let of_int c = try Some (of_int_exn c) with _ -> None let to_int = Char.code -let lowercase_ascii c = - if c >= 'A' && c <= 'Z' - then Char.unsafe_chr (Char. code c + 32) - else c +let lowercase_ascii = function + | 'A'..'Z' as c -> Char.unsafe_chr (Char.code c + 32) + | c -> c -let uppercase_ascii c = - if c >= 'a' && c <= 'z' - then Char.unsafe_chr (Char.code c - 32) - else c +let uppercase_ascii = function + | 'a'..'z' as c -> Char.unsafe_chr (Char.code c - 32) + | c -> c diff --git a/src/core/CCEqual.ml b/src/core/CCEqual.ml index f879bd05..3039b565 100644 --- a/src/core/CCEqual.ml +++ b/src/core/CCEqual.ml @@ -5,12 +5,12 @@ type 'a t = 'a -> 'a -> bool -let poly = (=) +let poly = Pervasives.(=) let int : int t = (=) -let string : string t = (=) -let bool : bool t = (=) -let float : float t = (=) +let string : string t = Pervasives.(=) +let bool : bool t = Pervasives.(=) +let float : float t = Pervasives.(=) let unit () () = true let rec list f l1 l2 = match l1, l2 with diff --git a/src/core/CCFloat.ml b/src/core/CCFloat.ml index 2e7fcc41..cb4062b9 100644 --- a/src/core/CCFloat.ml +++ b/src/core/CCFloat.ml @@ -9,6 +9,16 @@ type fpclass = Pervasives.fpclass = | FP_infinite | FP_nan +module Infix = struct + let (=) = Pervasives.(=) + let (<>) = Pervasives.(<>) + let (<) = Pervasives.(<) + let (>) = Pervasives.(>) + let (<=) = Pervasives.(<=) + let (>=) = Pervasives.(>=) +end +include Infix + let nan = Pervasives.nan let infinity = Pervasives.infinity @@ -84,13 +94,3 @@ let random_range i j st = i +. random (j-.i) st let equal_precision ~epsilon a b = abs_float (a-.b) < epsilon let classify = Pervasives.classify_float - -module Infix = struct - let (=) = Pervasives.(=) - let (<>) = Pervasives.(<>) - let (<) = Pervasives.(<) - let (>) = Pervasives.(>) - let (<=) = Pervasives.(<=) - let (>=) = Pervasives.(>=) -end -include Infix diff --git a/src/core/CCInt.ml b/src/core/CCInt.ml index eb37fccc..7628375f 100644 --- a/src/core/CCInt.ml +++ b/src/core/CCInt.ml @@ -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 diff --git a/src/core/CCInt64.ml b/src/core/CCInt64.ml index f9ab3841..9ac33506 100644 --- a/src/core/CCInt64.ml +++ b/src/core/CCInt64.ml @@ -28,7 +28,7 @@ let (lsr) = shift_right_logical let (asr) = shift_right -let equal (x:t) y = x=y +let equal (x:t) y = Pervasives.(=) x y let hash x = Pervasives.abs (to_int x) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 601fb06d..f8192c71 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -635,7 +635,7 @@ let sorted_insert ?(cmp=Pervasives.compare) ?(uniq=false) x l = List.mem x (sorted_insert x l)) *) -let uniq_succ ?(eq=(=)) l = +let uniq_succ ?(eq=Pervasives.(=)) l = let rec f acc l = match l with | [] -> List.rev acc | [x] -> List.rev (x::acc) @@ -648,7 +648,7 @@ let uniq_succ ?(eq=(=)) l = uniq_succ [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=Pervasives.(=)) l = let rec f ~eq acc cur l = match cur, l with | [], [] -> List.rev acc | _::_, [] -> List.rev (List.rev cur :: acc) @@ -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=Pervasives.(=)) ~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 @@ -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=Pervasives.(=)) 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=Pervasives.(=)) x l = if mem ~eq x l then l else x::l -let remove_one ?(eq=(=)) x l = +let remove_one ?(eq=Pervasives.(=)) 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 @@ -998,12 +998,12 @@ let remove_one ?(eq=(=)) x l = not (mem x l) || List.length (remove_one x l) = List.length l - 1) *) -let subset ?(eq=(=)) l1 l2 = +let subset ?(eq=Pervasives.(=)) l1 l2 = List.for_all (fun t -> mem ~eq t l2) l1 -let uniq ?(eq=(=)) l = +let uniq ?(eq=Pervasives.(=)) 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 @@ -1019,7 +1019,7 @@ let uniq ?(eq=(=)) l = sort_uniq l = (uniq l |> sort Pervasives.compare)) *) -let union ?(eq=(=)) l1 l2 = +let union ?(eq=Pervasives.(=)) 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 @@ -1030,7 +1030,7 @@ let union ?(eq=(=)) l1 l2 = union [1;2;4] [2;3;4;5] = [1;2;3;4;5] *) -let inter ?(eq=(=)) l1 l2 = +let inter ?(eq=Pervasives.(=)) 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 @@ -1236,9 +1236,9 @@ 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=Pervasives.(=)) x l = search_exn eq l x - let get ?(eq=(=)) x l = + let get ?(eq=Pervasives.(=)) x l = try Some (search_exn eq l x) with Not_found -> None @@ -1259,7 +1259,7 @@ 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=Pervasives.(=)) x y l = search_set eq [] l x ~f:(fun x _ l -> (x,y)::l) @@ -1270,7 +1270,7 @@ module Assoc = struct = [1, "1"; 2, "2"; 3, "3"] *) - let mem ?(eq=(=)) x l = + let mem ?(eq=Pervasives.(=)) x l = try ignore (search_exn eq l x); true with Not_found -> false @@ -1279,7 +1279,7 @@ module Assoc = struct not (Assoc.mem 4 [1,"1"; 2,"2"; 3, "3"]) *) - let update ?(eq=(=)) ~f x l = + let update ?(eq=Pervasives.(=)) ~f x l = search_set eq [] l x ~f:(fun x opt_y rest -> match f opt_y with @@ -1297,7 +1297,7 @@ module Assoc = struct ~f:(function None -> Some "3" | _ -> assert false) |> lsort) *) - let remove ?(eq=(=)) x l = + let remove ?(eq=Pervasives.(=)) x l = search_set eq [] l x ~f:(fun _ opt_y rest -> match opt_y with | None -> l (* keep as is *) diff --git a/src/core/CCParse.ml b/src/core/CCParse.ml index f581784a..229895f0 100644 --- a/src/core/CCParse.ml +++ b/src/core/CCParse.ml @@ -43,6 +43,9 @@ type state = { exception ParseError of parse_branch * (unit -> string) +let char_equal (a : char) b = Pervasives.(=) a b +let string_equal (a : string) b = Pervasives.(=) a b + let rec string_of_branch l = let pp_s () = function | None -> "" @@ -87,7 +90,7 @@ let next st ~ok ~err = else ( let c = st.str.[st.i] in st.i <- st.i + 1; - if c='\n' + if char_equal c '\n' then (st.lnum <- st.lnum + 1; st.cnum <- 1) else st.cnum <- st.cnum + 1; ok c @@ -146,7 +149,7 @@ let char c = let msg = Printf.sprintf "expected '%c'" c in fun st ~ok ~err -> next st ~err - ~ok:(fun c' -> if c=c' then ok c else fail_ ~err st (const_ msg)) + ~ok:(fun c' -> if char_equal c c' then ok c else fail_ ~err st (const_ msg)) let char_if p st ~ok ~err = next st ~err @@ -164,7 +167,7 @@ let chars_if p st ~ok ~err:_ = let chars1_if p st ~ok ~err = chars_if p st ~err ~ok:(fun s -> - if s = "" + if string_equal s "" then fail_ ~err st (const_ "unexpected sequence of chars") else ok s) @@ -231,7 +234,7 @@ let string s st ~ok ~err = else next st ~err ~ok:(fun c -> - if c = s.[i] + if char_equal c s.[i] then check (i+1) else fail_ ~err st (fun () -> Printf.sprintf "expected \"%s\"" s)) in @@ -386,7 +389,7 @@ module U = struct skip_white <* string stop let int = - chars1_if (fun c -> is_num c || c='-') + chars1_if (fun c -> is_num c || char_equal c '-') >>= fun s -> try return (int_of_string s) with Failure _ -> fail "expected an int" diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index bcc83111..6dd2bb1f 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -77,7 +77,7 @@ let replicate n g st = in aux [] n (* Sample without replacement using rejection sampling. *) -let sample_without_replacement (type elt) ?(compare=compare) k (rng:elt t) st= +let sample_without_replacement (type elt) ?(compare=Pervasives.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 @@ -221,6 +221,7 @@ let uniformity_test ?(size_hint=10) k rng st = let confidence = 4. in let std = confidence *. (sqrt (kf *. variance)) in let predicate _key n acc = + let (<) (a : float) b = Pervasives.(<) a b in acc && abs_float (average -. float_of_int n) < std in Hashtbl.fold predicate histogram true diff --git a/src/core/CCString.ml b/src/core/CCString.ml index 9654760d..d2b73e88 100644 --- a/src/core/CCString.ml +++ b/src/core/CCString.ml @@ -56,7 +56,7 @@ 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 = String.compare @@ -78,7 +78,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 +126,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 +158,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 +193,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 +292,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 @@ -490,7 +490,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 +777,9 @@ let exists2 p s1 s2 = (** {2 Ascii functions} *) let equal_caseless s1 s2: bool = - let char_lower c = - if c >= 'A' && c <= 'Z' - then Char.unsafe_chr (Char. code c + 32) - else c - in String.length s1 = String.length s2 && for_all2 - (fun c1 c2 -> char_lower c1 = char_lower c2) + (fun c1 c2 -> CCChar.equal (CCChar.lowercase_ascii c1) (CCChar.lowercase_ascii c2)) s1 s2 let pp buf s = diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 13586ae7..50fdcecd 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -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=Pervasives.(=)) x v = exists (eq x) v let find_exn p v = diff --git a/src/data/CCCache.ml b/src/data/CCCache.ml index ec956458..1ad77bdc 100644 --- a/src/data/CCCache.ml +++ b/src/data/CCCache.ml @@ -161,9 +161,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 = diff --git a/src/data/CCDeque.ml b/src/data/CCDeque.ml index 9453e464..85d40ea5 100644 --- a/src/data/CCDeque.ml +++ b/src/data/CCDeque.ml @@ -74,9 +74,11 @@ let is_zero_ n = match n.cell with | Two _ | Three _ -> false +let bool_eq (a : bool) b = Pervasives.(=) a b + let is_empty d = let res = d.size = 0 in - assert (res = is_zero_ d.cur); + assert (bool_eq res (is_zero_ d.cur)); res let push_front d x = @@ -377,7 +379,7 @@ let copy d = assert_equal ~cmp q q' *) -let equal ?(eq=(=)) a b = +let equal ?(eq=Pervasives.(=)) a b = let rec aux eq a b = match a() , b() with | None, None -> true | None, Some _ @@ -412,4 +414,3 @@ let print pp_x out d = pp_x out x ) d; Format.fprintf out "}@]" - diff --git a/src/data/CCFQueue.ml b/src/data/CCFQueue.ml index de6848f1..44b0662f 100644 --- a/src/data/CCFQueue.ml +++ b/src/data/CCFQueue.ml @@ -34,10 +34,14 @@ let empty = Shallow Zero exception Empty +let is_not_zero = function + | Zero -> false + | One _ | Two _ | Three _ -> true + let _single x = Shallow (One x) let _double x y = Shallow (Two (x,y)) let _deep n hd middle tl = - assert (hd<>Zero && tl<>Zero); + assert (is_not_zero hd && is_not_zero tl); Deep (n, hd, middle, tl) let is_empty = function diff --git a/src/data/CCGraph.ml b/src/data/CCGraph.ml index 067f9c3d..5f89c606 100644 --- a/src/data/CCGraph.ml +++ b/src/data/CCGraph.ml @@ -56,7 +56,7 @@ type ('k, 'a) table = { (** Mutable set *) type 'a set = ('a, unit) table -let mk_table (type k) ?(eq=(=)) ?(hash=Hashtbl.hash) size = +let mk_table (type k) ?(eq=Pervasives.(=)) ?(hash=Hashtbl.hash) size = let module H = Hashtbl.Make(struct type t = k let equal = eq @@ -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=Pervasives.(=)) ~tags ~graph seq = let first = ref true in fun k -> if !first then first := false else raise Sequence_once; @@ -316,7 +316,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=Pervasives.(=)) ?(rev=false) ~tags ~graph seq = (* use DFS *) let l = Traverse.Event.dfs_tag ~eq ~tags ~graph seq @@ -542,7 +542,7 @@ module Dot = struct (** Print an enum of Full.traverse_event *) let pp_seq ?(tbl=mk_table 128) - ?(eq=(=)) + ?(eq=Pervasives.(=)) ?(attrs_v=fun _ -> []) ?(attrs_e=fun _ -> []) ?(name="graph") @@ -622,7 +622,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=Pervasives.(=)) ?(hash=Hashtbl.hash) size = let module Tbl = Hashtbl.Make(struct type t = k let hash = hash @@ -757,7 +757,7 @@ end (** {2 Misc} *) -let of_list ?(eq=(=)) l = +let of_list ?(eq=Pervasives.(=)) l = (fun v yield -> List.iter (fun (a,b) -> if eq a v then yield ((),b)) l) let of_fun f = diff --git a/src/data/CCHashTrie.ml b/src/data/CCHashTrie.ml index 926d13c8..05f42840 100644 --- a/src/data/CCHashTrie.ml +++ b/src/data/CCHashTrie.ml @@ -292,6 +292,7 @@ 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 @@ -299,6 +300,7 @@ module Make(Key : KEY) let make = Key.hash let zero = 0 let is_0 h = h==0 + let equal (a : int) b = Pervasives.(=) a b let rem h = h land (A.length - 1) let quotient h = h lsr A.length_log end @@ -407,14 +409,14 @@ module Make(Key : KEY) let rec add_ ~id k v ~h m = match m with | E -> S (h, k, v) | S (h', k', v') -> - if h=h' + if Hash.equal h h' then if Key.equal k k' then S (h, k, v) (* replace *) else L (h, Cons (k, v, Cons (k', v', Nil))) else make_array_ ~id ~leaf:(Cons (k', v', Nil)) ~h_leaf:h' k v ~h | L (h', l) -> - if h=h' + if Hash.equal h h' then L (h, add_list_ k v l) else (* split into N *) make_array_ ~id ~leaf:l ~h_leaf:h' k v ~h diff --git a/src/data/CCIntMap.ml b/src/data/CCIntMap.ml index cf2e6f82..27fdffb8 100644 --- a/src/data/CCIntMap.ml +++ b/src/data/CCIntMap.ml @@ -11,6 +11,7 @@ module Bit : sig type t = private int val highest : int -> t val min_int : t + val equal : t -> t -> bool val is_0 : bit:t -> int -> bool val is_1 : bit:t -> int -> bool val mask : mask:t -> int -> int (* zeroes the bit, puts all lower bits to 1 *) @@ -21,6 +22,8 @@ end = struct let min_int = min_int + let equal (a : int) b = Pervasives.(=) a b + let rec highest_bit_naive x m = if x=m then m else highest_bit_naive (x land (lnot m)) (2*m) @@ -241,7 +244,7 @@ let rec equal ~eq a b = 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 @@ -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 @@ -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 diff --git a/src/data/CCMixmap.ml b/src/data/CCMixmap.ml index 8c162a36..616aca2b 100644 --- a/src/data/CCMixmap.ml +++ b/src/data/CCMixmap.ml @@ -123,9 +123,13 @@ module Make(X : ORD) : S with type key = X.t = struct let remove = M.remove + let is_some = function + | None -> false + | Some _ -> true + let mem ~inj x map = try - inj.get (M.find x map) <> None + is_some (inj.get (M.find x map)) with Not_found -> false let iter_keys ~f map = diff --git a/src/data/CCMixtbl.ml b/src/data/CCMixtbl.ml index 8d1d9f73..e697a72e 100644 --- a/src/data/CCMixtbl.ml +++ b/src/data/CCMixtbl.ml @@ -84,9 +84,13 @@ let remove tbl x = Hashtbl.remove tbl x let copy tbl = Hashtbl.copy tbl +let is_some = function + | None -> false + | Some _ -> true + let mem ~inj tbl x = try - inj.get (Hashtbl.find tbl x) <> None + is_some (inj.get (Hashtbl.find tbl x)) with Not_found -> false (*$R diff --git a/src/data/CCRAL.ml b/src/data/CCRAL.ml index 5d9aa245..3233c1a2 100644 --- a/src/data/CCRAL.ml +++ b/src/data/CCRAL.ml @@ -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=Pervasives.(=)) l1 l2 = let rec aux ~eq l1 l2 = match l1, l2 with | Nil, Nil -> true | Cons (size1, t1, l1'), Cons (size2, t2, l2') -> diff --git a/src/data/CCSimple_queue.ml b/src/data/CCSimple_queue.ml index ed9b639c..1eea0162 100644 --- a/src/data/CCSimple_queue.ml +++ b/src/data/CCSimple_queue.ml @@ -23,7 +23,11 @@ let make_ hd tl = match hd with | [] -> {hd=List.rev tl; tl=[] } | _::_ -> {hd; tl; } -let is_empty q = q.hd = [] +let list_is_empty = function + | [] -> true + | _::_ -> false + +let is_empty q = list_is_empty q.hd let push x q = make_ q.hd (x :: q.tl) @@ -31,7 +35,7 @@ let snoc q x = push x q let peek_exn q = match q.hd with - | [] -> assert (q.tl = []); invalid_arg "Queue.peek" + | [] -> assert (list_is_empty q.tl); invalid_arg "Queue.peek" | x::_ -> x let peek q = match q.hd with @@ -40,7 +44,7 @@ let peek q = match q.hd with let pop_exn q = match q.hd with - | [] -> assert (q.tl = []); invalid_arg "Queue.peek" + | [] -> assert (list_is_empty q.tl); invalid_arg "Queue.peek" | x::hd' -> let q' = make_ hd' q.tl in x, q' diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml index d7f8b9f7..c5beeae7 100644 --- a/src/data/CCTrie.ml +++ b/src/data/CCTrie.ml @@ -527,7 +527,7 @@ module Make(W : WORD) | Empty -> 0 | Cons (_, t') -> size t' | Node (v, map) -> - let s = if v=None then 0 else 1 in + let s = match v with None -> 0 | Some _ -> 1 in M.fold (fun _ t' acc -> size t' + acc) map s diff --git a/src/iter/CCKTree.ml b/src/iter/CCKTree.ml index eae5a29c..3620ffca 100644 --- a/src/iter/CCKTree.ml +++ b/src/iter/CCKTree.ml @@ -141,13 +141,17 @@ 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' diff --git a/src/sexp/CCSexp.ml b/src/sexp/CCSexp.ml index 6e5d96a0..9c17552e 100644 --- a/src/sexp/CCSexp.ml +++ b/src/sexp/CCSexp.ml @@ -13,7 +13,7 @@ type t = [ ] type sexp = t -let equal a b = a = b +let equal (a : sexp) b = Pervasives.(=) a b let compare a b = Pervasives.compare a b diff --git a/src/sexp/CCSexp_lex.mll b/src/sexp/CCSexp_lex.mll index c67e66eb..024d0a6b 100644 --- a/src/sexp/CCSexp_lex.mll +++ b/src/sexp/CCSexp_lex.mll @@ -20,9 +20,11 @@ | Escaped_int_1 of int | Escaped_int_2 of int + let char_equal (a : char) b = Pervasives.(=) a b + (* remove quotes + unescape *) let remove_quotes lexbuf s = - assert (s.[0] = '"' && s.[String.length s - 1] = '"'); + assert (char_equal s.[0] '"' && char_equal s.[String.length s - 1] '"'); let buf = Buffer.create (String.length s) in let st = ref Not_escaped in for i = 1 to String.length s-2 do @@ -72,4 +74,3 @@ rule token = parse | string { ATOM (remove_quotes lexbuf (Lexing.lexeme lexbuf)) } | _ as c { error lexbuf (Printf.sprintf "lexing failed on char `%c`" c) } - diff --git a/src/threads/CCPool.ml b/src/threads/CCPool.ml index 914461cc..af8ab6ba 100644 --- a/src/threads/CCPool.ml +++ b/src/threads/CCPool.ml @@ -314,11 +314,15 @@ module Make(P : PARAM) = struct | Run cell -> with_lock_ cell (fun cell -> cell.state) + let is_not_waiting = function + | Waiting -> false + | Failed _ | Done _ -> true + let is_done = function | Return _ | FailNow _ -> true | Run cell -> - with_lock_ cell (fun c -> c.state <> Waiting) + with_lock_ cell (fun c -> is_not_waiting c.state) (** {2 Combinators *) diff --git a/src/threads/CCTimer.ml b/src/threads/CCTimer.ml index f2c37cb8..9ad6e2c4 100644 --- a/src/threads/CCTimer.ml +++ b/src/threads/CCTimer.ml @@ -6,6 +6,11 @@ type job = | Job : float * (unit -> 'a) -> job +let (<=) (a : float) b = Pervasives.(<=) a b +let (>=) (a : float) b = Pervasives.(>=) a b +let (<) (a : float) b = Pervasives.(<) a b +let (>) (a : float) b = Pervasives.(>) a b + module TaskHeap = CCHeap.Make(struct type t = job let leq (Job(f1,_)) (Job (f2,_)) = f1 <= f2