diff --git a/Makefile b/Makefile index 91dd1a49..ae9d00fb 100644 --- a/Makefile +++ b/Makefile @@ -23,6 +23,9 @@ benchs: examples: dune build examples/id_sexp.exe +unlabel: + dune build @unlabel + VERSION=$(shell awk '/^version:/ {print $$2}' containers.opam) update_next_tag: diff --git a/README.md b/README.md index e48a345f..1c56b45b 100644 --- a/README.md +++ b/README.md @@ -609,18 +609,18 @@ See [the extended documentation](doc/containers.md) for more examples. Beforehand, check `grep deprecated -r src` to see whether some functions can be removed. -- `make test` +- `make all` - update version in `containers.opam` - `make update_next_tag` (to update `@since` comments; be careful not to change symlinks) - check status of modules (`{b status: foo}`) and update if required; removed deprecated functions, etc. +- `make unlabel` to see if labelled interfaces are up to date (requires compiler-libs) - update `CHANGELOG.adoc` (see its end to find the right git command) - commit the changes - `make test doc` -- tag, and push both to github -- `opam pin add containers https://github.com/c-cube/ocaml-containers.git#` -- new opam package: `opam publish prepare; opam publish submit` -- re-generate doc: `make doc push_doc` +- `export VERSION=; git tag -f $VERSION; git push origin :$VERSION; git push origin $VERSION` +- new opam package: `opam publish https://github.com/c-cube/ocaml-containers/archive/.tar.gz` +- re-generate doc: `make doc` and put it into `gh-pages` ### List Authors diff --git a/benchs/dune b/benchs/dune index 19a7d5f5..ad6c8d26 100644 --- a/benchs/dune +++ b/benchs/dune @@ -4,7 +4,7 @@ (libraries containers containers.data containers.iter containers.thread benchmark gen iter qcheck batteries clarity) - (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -color always) + (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -color always -open CCShims_) (ocamlopt_flags :standard -O3 -color always -unbox-closures -unbox-closures-factor 20) ) diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index b3b4438f..aa930b54 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -930,7 +930,7 @@ module Deque = struct let take_back d = match !d with | None -> raise Empty - | Some first when Pervasives.(==) first first.prev -> + | Some first when Stdlib.(==) first first.prev -> (* only one element *) d := None; first.content @@ -943,7 +943,7 @@ module Deque = struct let take_front d = match !d with | None -> raise Empty - | Some first when Pervasives.(==) first first.prev -> + | Some first when Stdlib.(==) first first.prev -> (* only one element *) d := None; first.content diff --git a/qtest/make.ml b/qtest/make.ml index c8c7c3d6..9398769c 100644 --- a/qtest/make.ml +++ b/qtest/make.ml @@ -20,6 +20,7 @@ let do_not_test file = is_suffix ~sub:"containers.ml" file || is_suffix ~sub:"containers_top.ml" file || is_suffix ~sub:"mkflags.ml" file || + is_suffix ~sub:"mkshims.ml" file || is_suffix ~sub:"unlabel.ml" file || is_suffix ~sub:"utop.ml" file @@ -44,7 +45,7 @@ let run_qtest target = |> String.concat " " in let cmd = - Printf.sprintf "qtest extract --preamble 'open CCFun;;' -o %S %s 2>/dev/null" + Printf.sprintf "qtest extract --preamble 'open CCShims_;; open CCFun;;' -o %S %s 2>/dev/null" target files in exit (Sys.command cmd) diff --git a/src/core/CCArray_slice.ml b/src/core/CCArray_slice.ml index fb908dea..728e3230 100644 --- a/src/core/CCArray_slice.ml +++ b/src/core/CCArray_slice.ml @@ -3,6 +3,8 @@ (** {1 Array Slice} *) +open CCShims_ + type 'a sequence = ('a -> unit) -> unit type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] type 'a gen = unit -> 'a option @@ -85,7 +87,7 @@ let rec _compare cmp a1 i1 j1 a2 i2 j2 = let equal eq a b = length a = length b && _equal eq a.arr a.i a.j b.arr b.i b.j -let compare_int (a : int) b = Pervasives.compare a b +let compare_int (a : int) b = Stdlib.compare a b let compare cmp a b = _compare cmp a.arr a.i a.j b.arr b.i b.j @@ -277,10 +279,10 @@ let sorted cmp a = _sorted cmp a.arr a.i a.j (*$= & ~cmp:(=) ~printer:Q.Print.(array int) [||] \ (let a = 1--6 in let s = make a 2 ~len:0 in \ - sorted Pervasives.compare s) + sorted Stdlib.compare s) [|2;3;4|] \ (let a = [|6;5;4;3;2;1|] in let s = make a 2 ~len:3 in \ - sorted Pervasives.compare s) + sorted Stdlib.compare s) *) (*$Q @@ -288,7 +290,7 @@ let sorted cmp a = _sorted cmp a.arr a.i a.j Array.length a > 10 ==> ( Array.length a > 10 && \ let s = make a 5 ~len:5 in \ let b = Array.sub a 5 5 in \ - Array.sort Pervasives.compare b; b = sorted Pervasives.compare s)) + Array.sort Stdlib.compare b; b = sorted Stdlib.compare s)) *) let sort_ranking cmp a = @@ -299,10 +301,10 @@ let sort_ranking cmp a = (*$= & ~cmp:(=) ~printer:Q.Print.(array int) [||] \ (let a = 1--6 in let s = make a 2 ~len:0 in \ - sort_ranking Pervasives.compare s) + sort_ranking Stdlib.compare s) [|2;1;3;0|] \ (let a = [|"d";"c";"b";"e";"a"|] in let s = make a 1 ~len:4 in \ - sort_ranking Pervasives.compare s) + sort_ranking Stdlib.compare s) *) (*$Q @@ -318,10 +320,10 @@ let sort_indices cmp a = _sort_indices cmp a.arr a.i a.j (*$= & ~cmp:(=) ~printer:Q.Print.(array int) [||] \ (let a = 1--6 in let s = make a 2 ~len:0 in \ - sort_indices Pervasives.compare s) + sort_indices Stdlib.compare s) [|3;1;0;2|] \ (let a = [|"d";"c";"b";"e";"a"|] in let s = make a 1 ~len:4 in \ - sort_indices Pervasives.compare s) + sort_indices Stdlib.compare s) *) (*$Q diff --git a/src/core/CCBool.ml b/src/core/CCBool.ml index 89a6a9e5..d19e86d1 100644 --- a/src/core/CCBool.ml +++ b/src/core/CCBool.ml @@ -1,11 +1,13 @@ (* This file is free software, part of containers. See file "license" for more details. *) +open CCShims_ + type t = bool -let equal (a:bool) b = Pervasives.(=) a b +let equal (a:bool) b = Stdlib.(=) a b -let compare (a:bool) b = Pervasives.compare a b +let compare (a:bool) b = Stdlib.compare a b let negate = not diff --git a/src/core/CCChar.ml b/src/core/CCChar.ml index 42036003..4323a764 100644 --- a/src/core/CCChar.ml +++ b/src/core/CCChar.ml @@ -4,9 +4,10 @@ @since 0.14 *) +open CCShims_ include Char -let equal (a:char) b = Pervasives.(=) a b +let equal (a:char) b = Stdlib.(=) a b let pp_buf = Buffer.add_char let pp = Format.pp_print_char diff --git a/src/core/CCEqual.ml b/src/core/CCEqual.ml index 211835b6..407ae6fd 100644 --- a/src/core/CCEqual.ml +++ b/src/core/CCEqual.ml @@ -3,15 +3,17 @@ (** {1 Equality Combinators} *) +open CCShims_ + type 'a t = 'a -> 'a -> bool -let poly = Pervasives.(=) -let physical = Pervasives.(==) +let poly = Stdlib.(=) +let physical = Stdlib.(==) let int : int t = (=) -let string : string t = Pervasives.(=) -let bool : bool t = Pervasives.(=) -let float : float t = Pervasives.(=) +let string : string t = Stdlib.(=) +let bool : bool t = Stdlib.(=) +let float : float t = Stdlib.(=) 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 8e189506..241e3228 100644 --- a/src/core/CCFloat.ml +++ b/src/core/CCFloat.ml @@ -1,8 +1,10 @@ (* This file is free software, part of containers. See file "license" for more details. *) +open CCShims_ + type t = float -type fpclass = Pervasives.fpclass = +type fpclass = Stdlib.fpclass = | FP_normal | FP_subnormal | FP_zero @@ -10,50 +12,50 @@ type fpclass = Pervasives.fpclass = | FP_nan module Infix = struct - let (=) : t -> t -> bool = Pervasives.(=) - let (<>) : t -> t -> bool = Pervasives.(<>) - let (<) : t -> t -> bool = Pervasives.(<) - let (>) : t -> t -> bool = Pervasives.(>) - let (<=) : t -> t -> bool = Pervasives.(<=) - let (>=) : t -> t -> bool = Pervasives.(>=) - let (~-) : t -> t = Pervasives.(~-.) - let (+) : t -> t -> t = Pervasives.(+.) - let (-) : t -> t -> t = Pervasives.(-.) - let ( * ) : t -> t -> t = Pervasives.( *. ) - let (/) : t -> t -> t = Pervasives.(/.) + let (=) : t -> t -> bool = Stdlib.(=) + let (<>) : t -> t -> bool = Stdlib.(<>) + let (<) : t -> t -> bool = Stdlib.(<) + let (>) : t -> t -> bool = Stdlib.(>) + let (<=) : t -> t -> bool = Stdlib.(<=) + let (>=) : t -> t -> bool = Stdlib.(>=) + let (~-) : t -> t = Stdlib.(~-.) + let (+) : t -> t -> t = Stdlib.(+.) + let (-) : t -> t -> t = Stdlib.(-.) + let ( * ) : t -> t -> t = Stdlib.( *. ) + let (/) : t -> t -> t = Stdlib.(/.) end include Infix -let nan = Pervasives.nan +let nan = Stdlib.nan -let infinity = Pervasives.infinity -let neg_infinity = Pervasives.neg_infinity +let infinity = Stdlib.infinity +let neg_infinity = Stdlib.neg_infinity let max_value = infinity let min_value = neg_infinity -let max_finite_value = Pervasives.max_float +let max_finite_value = Stdlib.max_float -let epsilon = Pervasives.epsilon_float +let epsilon = Stdlib.epsilon_float -let is_nan x = Pervasives.(classify_float x = Pervasives.FP_nan) +let is_nan x = Stdlib.(classify_float x = Stdlib.FP_nan) let add = (+.) let sub = (-.) let mul = ( *. ) let div = (/.) let neg = (~-.) -let abs = Pervasives.abs_float +let abs = Stdlib.abs_float let scale = ( *. ) let min (x : t) y = - match Pervasives.classify_float x, Pervasives.classify_float y with + match Stdlib.classify_float x, Stdlib.classify_float y with | FP_nan, _ -> y | _, FP_nan -> x | _ -> if x < y then x else y let max (x : t) y = - match Pervasives.classify_float x, Pervasives.classify_float y with + match Stdlib.classify_float x, Stdlib.classify_float y with | FP_nan, _ -> y | _, FP_nan -> x | _ -> if x > y then x else y @@ -75,7 +77,7 @@ let max (x : t) y = let equal (a:float) b = a=b let hash : t -> int = Hashtbl.hash -let compare (a:float) b = Pervasives.compare a b +let compare (a:float) b = Stdlib.compare a b type 'a printer = Format.formatter -> 'a -> unit type 'a random_gen = Random.State.t -> 'a @@ -85,7 +87,7 @@ let pp = Format.pp_print_float let fsign a = if is_nan a then nan else if a = 0. then a - else Pervasives.copysign 1. a + else Stdlib.copysign 1. a exception TrapNaN of string @@ -104,12 +106,12 @@ let round x = 0. (round 0.) *) -let to_int (a:float) = Pervasives.int_of_float a -let of_int (a:int) = Pervasives.float_of_int a +let to_int (a:float) = Stdlib.int_of_float a +let of_int (a:int) = Stdlib.float_of_int a -let to_string (a:float) = Pervasives.string_of_float a -let of_string_exn (a:string) = Pervasives.float_of_string a -let of_string (a:string) = Pervasives.float_of_string a +let to_string (a:float) = Stdlib.string_of_float a +let of_string_exn (a:string) = Stdlib.float_of_string a +let of_string (a:string) = Stdlib.float_of_string a let random n st = Random.State.float st n @@ -118,4 +120,4 @@ 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 +let classify = Stdlib.classify_float diff --git a/src/core/CCFloat.mli b/src/core/CCFloat.mli index a4778766..aaf21ce3 100644 --- a/src/core/CCFloat.mli +++ b/src/core/CCFloat.mli @@ -4,8 +4,10 @@ (** {1 Basic operations on floating-point numbers} @since 0.6.1 *) +open CCShims_ + type t = float -type fpclass = Pervasives.fpclass = +type fpclass = Stdlib.fpclass = | FP_normal | FP_subnormal | FP_zero @@ -13,20 +15,20 @@ type fpclass = Pervasives.fpclass = | FP_nan val nan : t -(** Equal to {!Pervasives.nan}. *) +(** Equal to {!Stdlib.nan}. *) val max_value : t -(** Positive infinity. Equal to {!Pervasives.infinity}. *) +(** Positive infinity. Equal to {!Stdlib.infinity}. *) val min_value : t -(** Negative infinity. Equal to {!Pervasives.neg_infinity}. *) +(** Negative infinity. Equal to {!Stdlib.neg_infinity}. *) val max_finite_value : t -(** Equal to {!Pervasives.max_float}. *) +(** Equal to {!Stdlib.max_float}. *) val epsilon : t (** The smallest positive float x such that [1.0 +. x <> 1.0]. - Equal to {!Pervasives.epsilon_float}. *) + Equal to {!Stdlib.epsilon_float}. *) val is_nan : t -> bool (** [is_nan f] returns [true] if f is NaN, [false] otherwise. *) @@ -42,7 +44,7 @@ val neg : t -> t val abs : t -> t (** The absolute value of a floating-point number. - Equal to {!Pervasives.abs_float}. *) + Equal to {!Stdlib.abs_float}. *) val scale : t -> t -> t (** Equal to [( *. )]. *) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index dbc2447d..06f5dbbc 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -294,14 +294,15 @@ let mark_close_tag st ~or_else s = (* add color handling to formatter [ppf] *) let set_color_tag_handling ppf = let open Format in - let functions = pp_get_formatter_tag_functions ppf () in + let functions = CCShimsFormat_.pp_get_formatter_tag_functions ppf () in let st = Stack.create () in (* stack of styles *) - let functions' = {functions with - mark_open_tag=(mark_open_tag st ~or_else:functions.mark_open_tag); - mark_close_tag=(mark_close_tag st ~or_else:functions.mark_close_tag); - } in + let functions' = + CCShimsFormat_.cc_update_funs functions + (mark_open_tag st) + (mark_close_tag st) + in pp_set_mark_tags ppf true; (* enable tags *) - pp_set_formatter_tag_functions ppf functions' + CCShimsFormat_.pp_set_formatter_tag_functions ppf functions' let set_color_default = let first = ref true in @@ -326,14 +327,14 @@ let set_color_default = *) let with_color s pp out x = - Format.pp_open_tag out s; + CCShimsFormat_.pp_open_tag out s; pp out x; - Format.pp_close_tag out () + CCShimsFormat_.pp_close_tag out () let with_colorf s out fmt = - Format.pp_open_tag out s; + CCShimsFormat_.pp_open_tag out s; Format.kfprintf - (fun out -> Format.pp_close_tag out ()) + (fun out -> CCShimsFormat_.pp_close_tag out ()) out fmt (* c: whether colors are enabled *) @@ -350,10 +351,10 @@ let with_color_ksf ~f s fmt = let buf = Buffer.create 64 in let out = Format.formatter_of_buffer buf in if !color_enabled then set_color_tag_handling out; - Format.pp_open_tag out s; + CCShimsFormat_.pp_open_tag out s; Format.kfprintf (fun out -> - Format.pp_close_tag out (); + CCShimsFormat_.pp_close_tag out (); Format.pp_print_flush out (); f (Buffer.contents buf)) out fmt diff --git a/src/core/CCFun.ml b/src/core/CCFun.ml index e9e49878..0796dee4 100644 --- a/src/core/CCFun.ml +++ b/src/core/CCFun.ml @@ -13,7 +13,7 @@ let opaque_identity x = x (* import standard implementations, if any *) include Sys -include Pervasives +include CCShims_.Stdlib let compose f g x = g (f x) diff --git a/src/core/CCHashtbl.ml b/src/core/CCHashtbl.ml index c0db18b7..4bd301bd 100644 --- a/src/core/CCHashtbl.ml +++ b/src/core/CCHashtbl.ml @@ -56,7 +56,7 @@ module Poly = struct (*$T of_list [1,"a"; 2,"b"] |> map_list (fun x y -> string_of_int x ^ y) \ - |> List.sort Pervasives.compare = ["1a"; "2b"] + |> List.sort Stdlib.compare = ["1a"; "2b"] *) let to_seq tbl k = Hashtbl.iter (fun key v -> k (key,v)) tbl diff --git a/src/core/CCHeap.ml b/src/core/CCHeap.ml index 22093c1b..5afc9d2d 100644 --- a/src/core/CCHeap.ml +++ b/src/core/CCHeap.ml @@ -396,8 +396,8 @@ module Make(E : PARTIAL_ORD) : S with type elt = E.t = struct extract_list (H.of_gen (CCList.to_gen l))) Q.(list int) (fun l -> \ let h = H.of_list l in \ - (H.to_gen h |> CCList.of_gen |> List.sort Pervasives.compare) \ - = (H.to_list h |> List.sort Pervasives.compare)) + (H.to_gen h |> CCList.of_gen |> List.sort Stdlib.compare) \ + = (H.to_list h |> List.sort Stdlib.compare)) *) let rec to_tree h () = match h with diff --git a/src/core/CCInt.ml b/src/core/CCInt.ml index 9b595c8d..6cb7ba3e 100644 --- a/src/core/CCInt.ml +++ b/src/core/CCInt.ml @@ -1,10 +1,12 @@ (* This file is free software, part of containers. See file "license" for more details. *) +open CCShims_ + type t = int type 'a sequence = ('a -> unit) -> unit -let equal (a:int) b = Pervasives.(=) a b +let equal (a:int) b = Stdlib.(=) a b let compare (a:int) b = compare a b @@ -95,15 +97,15 @@ module Infix : sig val (lsr) : t -> int -> t val (asr) : t -> int -> t end = struct - include Pervasives + include Stdlib let (--) = range let (--^) = range' let ( ** ) = pow end include Infix -let min : t -> t -> t = Pervasives.min -let max : t -> t -> t = Pervasives.max +let min : t -> t -> t = Stdlib.min +let max : t -> t -> t = Stdlib.max let floor_div a n = if a < 0 && n >= 0 then @@ -143,7 +145,7 @@ 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 bool_neq (a : bool) b = Stdlib.(<>) a b let rem a n = let y = a mod n in diff --git a/src/core/CCInt32.ml b/src/core/CCInt32.ml index 74aaab63..1be2d6d3 100644 --- a/src/core/CCInt32.ml +++ b/src/core/CCInt32.ml @@ -1,8 +1,9 @@ (* This file is free software, part of containers. See file "license" for more details. *) +open CCShims_ include Int32 -let equal (x:t) y = Pervasives.(=) x y +let equal (x:t) y = Stdlib.(=) x y module Infix = struct let (+) = add @@ -33,15 +34,15 @@ module Infix = struct let (=) = equal - let (<>) = Pervasives.(<>) - let (<) = Pervasives.(<) - let (<=) = Pervasives.(<=) - let (>) = Pervasives.(>) - let (>=) = Pervasives.(>=) + let (<>) = Stdlib.(<>) + let (<) = Stdlib.(<) + let (<=) = Stdlib.(<=) + let (>) = Stdlib.(>) + let (>=) = Stdlib.(>=) end include Infix -let hash x = Pervasives.abs (to_int x) +let hash x = Stdlib.abs (to_int x) (** {2 Conversion} *) diff --git a/src/core/CCInt64.ml b/src/core/CCInt64.ml index bfaed6f9..b2dbad44 100644 --- a/src/core/CCInt64.ml +++ b/src/core/CCInt64.ml @@ -1,8 +1,9 @@ (* This file is free software, part of containers. See file "license" for more details. *) +open CCShims_ include Int64 -let equal (x:t) y = Pervasives.(=) x y +let equal (x:t) y = Stdlib.(=) x y module Infix = struct let (+) = add @@ -33,16 +34,16 @@ module Infix = struct let (=) = equal - let (<>) = Pervasives.(<>) - let (<) = Pervasives.(<) - let (<=) = Pervasives.(<=) - let (>) = Pervasives.(>) - let (>=) = Pervasives.(>=) + let (<>) = Stdlib.(<>) + let (<) = Stdlib.(<) + let (<=) = Stdlib.(<=) + let (>) = Stdlib.(>) + let (>=) = Stdlib.(>=) end include Infix -let hash x = Pervasives.abs (to_int x) +let hash x = Stdlib.abs (to_int x) (** {2 Conversion} *) diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 278931d7..fb483d73 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -3,11 +3,11 @@ (** {1 Complements to list} *) -(*$inject - let lsort l = List.sort Pervasives.compare l -*) +open CCShims_ -type 'a t = 'a list +(*$inject + let lsort l = List.sort Stdlib.compare l +*) (* backport new functions from stdlib here *) @@ -56,17 +56,17 @@ let rec compare_length_with l n = match l, n with let rec assoc_opt x = function | [] -> None - | (y,v) :: _ when Pervasives.(=) x y -> Some v + | (y,v) :: _ when Stdlib.(=) x y -> Some v | _ :: tail -> assoc_opt x tail let rec assq_opt x = function | [] -> None - | (y,v) :: _ when Pervasives.(==) x y -> Some v + | (y,v) :: _ when Stdlib.(==) x y -> Some v | _ :: tail -> assq_opt x tail (* end of backport *) -include List +include CCShimsList_ let empty = [] @@ -443,7 +443,7 @@ let diagonal l = diagonal [] = [] diagonal [1] = [] diagonal [1;2] = [1,2] - diagonal [1;2;3] |> List.sort Pervasives.compare = [1, 2; 1, 3; 2, 3] + diagonal [1;2;3] |> List.sort Stdlib.compare = [1, 2; 1, 3; 2, 3] *) let partition_map f l = @@ -634,7 +634,7 @@ let is_sorted ~cmp l = (*$Q Q.(list small_int) (fun l -> \ - is_sorted ~cmp:CCInt.compare (List.sort Pervasives.compare l)) + is_sorted ~cmp:CCInt.compare (List.sort Stdlib.compare l)) *) let sorted_insert ~cmp ?(uniq=false) x l = @@ -652,20 +652,20 @@ let sorted_insert ~cmp ?(uniq=false) x l = (*$Q Q.(pair small_int (list small_int)) (fun (x,l) -> \ - let l = List.sort Pervasives.compare l in \ + let l = List.sort Stdlib.compare l in \ is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare x l)) Q.(pair small_int (list small_int)) (fun (x,l) -> \ - let l = List.sort Pervasives.compare l in \ + let l = List.sort Stdlib.compare l in \ is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare ~uniq:true x l)) Q.(pair small_int (list small_int)) (fun (x,l) -> \ - let l = List.sort Pervasives.compare l in \ + let l = List.sort Stdlib.compare l in \ is_sorted ~cmp:CCInt.compare (sorted_insert ~cmp:CCInt.compare ~uniq:false x l)) Q.(pair small_int (list small_int)) (fun (x,l) -> \ - let l = List.sort Pervasives.compare l in \ + let l = List.sort Stdlib.compare l in \ let l' = sorted_insert ~cmp:CCInt.compare ~uniq:false x l in \ List.length l' = List.length l + 1) Q.(pair small_int (list small_int)) (fun (x,l) -> \ - let l = List.sort Pervasives.compare l in \ + let l = List.sort Stdlib.compare l in \ List.mem x (sorted_insert ~cmp:CCInt.compare x l)) *) @@ -726,14 +726,14 @@ let sorted_merge_uniq ~cmp l1 l2 = (*$Q Q.(list int) (fun l -> \ - let l = List.sort Pervasives.compare l in \ + let l = List.sort Stdlib.compare l in \ sorted_merge_uniq ~cmp:CCInt.compare l [] = uniq_succ ~eq:CCInt.equal l) Q.(list int) (fun l -> \ - let l = List.sort Pervasives.compare l in \ + let l = List.sort Stdlib.compare l in \ sorted_merge_uniq ~cmp:CCInt.compare [] l = uniq_succ ~eq:CCInt.equal l) Q.(pair (list int) (list int)) (fun (l1, l2) -> \ - let l1 = List.sort Pervasives.compare l1 \ - and l2 = List.sort Pervasives.compare l2 in \ + let l1 = List.sort Stdlib.compare l1 \ + and l2 = List.sort Stdlib.compare l2 in \ let l3 = sorted_merge_uniq ~cmp:CCInt.compare l1 l2 in \ uniq_succ ~eq:CCInt.equal l3 = l3) *) @@ -1054,7 +1054,7 @@ let all_ok l = | Some e -> Result.Error e end -let group_by (type k) ?(hash=Hashtbl.hash) ?(eq=Pervasives.(=)) l = +let group_by (type k) ?(hash=Hashtbl.hash) ?(eq=Stdlib.(=)) l = let module Tbl = Hashtbl.Make(struct type t = k let equal = eq let hash = hash end) in (* compute group table *) let tbl = Tbl.create 32 in @@ -1078,7 +1078,7 @@ let join ~join_row s1 s2 : _ t = OUnit.assert_equal ["1 = 1"; "2 = 2"] s; *) -let join_by (type a) ?(eq=Pervasives.(=)) ?(hash=Hashtbl.hash) f1 f2 ~merge c1 c2 = +let join_by (type a) ?(eq=Stdlib.(=)) ?(hash=Hashtbl.hash) f1 f2 ~merge c1 c2 = let module Tbl = Hashtbl.Make(struct type t = a let equal = eq let hash = hash end) in let tbl = Tbl.create 32 in List.iter @@ -1104,7 +1104,7 @@ type ('a, 'b) join_all_cell = { mutable ja_right: 'b list; } -let join_all_by (type a) ?(eq=Pervasives.(=)) ?(hash=Hashtbl.hash) f1 f2 ~merge c1 c2 = +let join_all_by (type a) ?(eq=Stdlib.(=)) ?(hash=Hashtbl.hash) f1 f2 ~merge c1 c2 = let module Tbl = Hashtbl.Make(struct type t = a let equal = eq let hash = hash end) in let tbl = Tbl.create 32 in (* build the map [key -> cell] *) @@ -1132,7 +1132,7 @@ let join_all_by (type a) ?(eq=Pervasives.(=)) ?(hash=Hashtbl.hash) f1 f2 ~merge | Some z -> z :: res) tbl [] -let group_join_by (type a) ?(eq=Pervasives.(=)) ?(hash=Hashtbl.hash) f c1 c2 = +let group_join_by (type a) ?(eq=Stdlib.(=)) ?(hash=Hashtbl.hash) f c1 c2 = let module Tbl = Hashtbl.Make(struct type t = a let equal = eq let hash = hash end) in let tbl = Tbl.create 32 in List.iter (fun x -> Tbl.replace tbl x []) c1; @@ -1154,8 +1154,8 @@ let group_join_by (type a) ?(eq=Pervasives.(=)) ?(hash=Hashtbl.hash) f c1 c2 = (group_join_by (fun s->s.[0]) \ (CCString.to_list "abc") \ ["abc"; "boom"; "attic"; "deleted"; "barbary"; "bop"] \ - |> map (fun (c,l)->c,List.sort Pervasives.compare l) \ - |> sort Pervasives.compare) + |> map (fun (c,l)->c,List.sort Stdlib.compare l) \ + |> sort Stdlib.compare) *) (*$inject @@ -1207,13 +1207,13 @@ let uniq ~eq l = in uniq eq [] l (*$T - uniq ~eq:CCInt.equal [1;2;3] |> List.sort Pervasives.compare = [1;2;3] - uniq ~eq:CCInt.equal [1;1;2;2;3;4;4;2;4;1;5] |> List.sort Pervasives.compare = [1;2;3;4;5] + uniq ~eq:CCInt.equal [1;2;3] |> List.sort Stdlib.compare = [1;2;3] + uniq ~eq:CCInt.equal [1;1;2;2;3;4;4;2;4;1;5] |> List.sort Stdlib.compare = [1;2;3;4;5] *) (*$Q Q.(small_list small_int) (fun l -> \ - sort_uniq ~cmp:CCInt.compare l = (uniq ~eq:CCInt.equal l |> sort Pervasives.compare)) + sort_uniq ~cmp:CCInt.compare l = (uniq ~eq:CCInt.equal l |> sort Stdlib.compare)) *) let union ~eq l1 l2 = @@ -1492,9 +1492,9 @@ module Assoc = struct ~f:(fun x _ l -> (x,y)::l) (*$T - Assoc.set ~eq:CCInt.equal 2 "two" [1,"1"; 2, "2"] |> List.sort Pervasives.compare \ + Assoc.set ~eq:CCInt.equal 2 "two" [1,"1"; 2, "2"] |> List.sort Stdlib.compare \ = [1, "1"; 2, "two"] - Assoc.set ~eq:CCInt.equal 3 "3" [1,"1"; 2, "2"] |> List.sort Pervasives.compare \ + Assoc.set ~eq:CCInt.equal 3 "3" [1,"1"; 2, "2"] |> List.sort Stdlib.compare \ = [1, "1"; 2, "2"; 3, "3"] *) diff --git a/src/core/CCNativeint.ml b/src/core/CCNativeint.ml index b9692c38..171426be 100644 --- a/src/core/CCNativeint.ml +++ b/src/core/CCNativeint.ml @@ -1,8 +1,9 @@ (* This file is free software, part of containers. See file "license" for more details. *) +open CCShims_ include Nativeint -let equal (x:t) y = Pervasives.(=) x y +let equal (x:t) y = Stdlib.(=) x y module Infix = struct let (+) = add @@ -33,15 +34,15 @@ module Infix = struct let (=) = equal - let (<>) = Pervasives.(<>) - let (<) = Pervasives.(<) - let (<=) = Pervasives.(<=) - let (>) = Pervasives.(>) - let (>=) = Pervasives.(>=) + let (<>) = Stdlib.(<>) + let (<) = Stdlib.(<) + let (<=) = Stdlib.(<=) + let (>) = Stdlib.(>) + let (>=) = Stdlib.(>=) end include Infix -let hash x = Pervasives.abs (to_int x) +let hash x = Stdlib.abs (to_int x) (** {2 Conversion} *) diff --git a/src/core/CCOrd.ml b/src/core/CCOrd.ml index 0b38fcfb..413b2453 100644 --- a/src/core/CCOrd.ml +++ b/src/core/CCOrd.ml @@ -3,10 +3,12 @@ (** {1 Comparisons} *) +open CCShims_ + type 'a t = 'a -> 'a -> int (** Comparison (total ordering) between two elements, that returns an int *) -let compare = Pervasives.compare +let compare = Stdlib.compare let opp f x y = - (f x y) @@ -32,10 +34,10 @@ let equiv i j = if (equiv x y && equiv y z) then (equiv x z) else true) *) -let int (x:int) y = Pervasives.compare x y -let string (x:string) y = Pervasives.compare x y -let bool (x:bool) y = Pervasives.compare x y -let float (x:float) y = Pervasives.compare x y +let int (x:int) y = Stdlib.compare x y +let string (x:string) y = Stdlib.compare x y +let bool (x:bool) y = Stdlib.compare x y +let float (x:float) y = Stdlib.compare x y (*$T bool true false > 0 @@ -101,7 +103,7 @@ let rec list ord l1 l2 = match l1, l2 with (*$Q Q.(pair (list int)(list int)) CCOrd.(fun (l1,l2) -> \ - equiv (list int l1 l2) (Pervasives.compare l1 l2)) + equiv (list int l1 l2) (Stdlib.compare l1 l2)) *) let array ord a1 a2 = diff --git a/src/core/CCParse.ml b/src/core/CCParse.ml index 50dd98ca..954d61b1 100644 --- a/src/core/CCParse.ml +++ b/src/core/CCParse.ml @@ -3,6 +3,8 @@ (** {1 Very Simple Parser Combinators} *) +open CCShims_ + (*$inject module T = struct type tree = L of int | N of tree * tree @@ -139,8 +141,8 @@ 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 char_equal (a : char) b = Stdlib.(=) a b +let string_equal (a : string) b = Stdlib.(=) a b let rec string_of_branch l = let pp_s () = function diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index a6babfb9..090431d8 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -3,6 +3,7 @@ (** {1 Random Generators} *) +open CCShims_ include Random type state = Random.State.t @@ -225,7 +226,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 + let (<) (a : float) b = Stdlib.(<) 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 d8eefd07..74442efd 100644 --- a/src/core/CCString.ml +++ b/src/core/CCString.ml @@ -3,6 +3,8 @@ (** {1 Basic String Utils} *) +open CCShims_ + type 'a gen = unit -> 'a option type 'a sequence = ('a -> unit) -> unit type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] @@ -61,9 +63,9 @@ module type S = sig val pp : Format.formatter -> t -> unit end -let equal (a:string) b = Pervasives.(=) a b +let equal (a:string) b = Stdlib.(=) a b -let compare_int (a : int) b = Pervasives.compare a b +let compare_int (a : int) b = Stdlib.compare a b let compare = String.compare let hash s = Hashtbl.hash s @@ -696,7 +698,7 @@ let prefix ~pre s = else ( let rec check i = if i=len then true - else if Pervasives.(<>) (String.unsafe_get s i) (String.unsafe_get pre i) then false + else if Stdlib.(<>) (String.unsafe_get s i) (String.unsafe_get pre i) then false else check (i+1) in check 0 @@ -719,7 +721,7 @@ let suffix ~suf s = let off = String.length s - len in let rec check i = if i=len then true - else if Pervasives.(<>) (String.unsafe_get s (off+i)) (String.unsafe_get suf i) then false + else if Stdlib.(<>) (String.unsafe_get s (off+i)) (String.unsafe_get suf i) then false else check (i+1) in check 0 diff --git a/src/core/CCUtf8_string.ml b/src/core/CCUtf8_string.ml index 21856a90..2fc60809 100644 --- a/src/core/CCUtf8_string.ml +++ b/src/core/CCUtf8_string.ml @@ -5,11 +5,13 @@ We only deal with UTF8 strings as they naturally map to OCaml bytestrings *) +open CCShims_ + type uchar = Uchar.t type 'a gen = unit -> 'a option type 'a sequence = ('a -> unit) -> unit -let equal (a:string) b = Pervasives.(=) a b +let equal (a:string) b = Stdlib.(=) a b let hash : string -> int = Hashtbl.hash let pp = Format.pp_print_string @@ -208,7 +210,7 @@ let flat_map f s : t = iter (fun c -> iter (code_to_string buf) (f c)) s; Buffer.contents buf -let append = Pervasives.(^) +let append = Stdlib.(^) let unsafe_of_string s = s diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 03c749b9..3bde49e1 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -317,7 +317,7 @@ let compare cmp v1 v2 = Q.(pair (small_list small_int)(small_list small_int)) (fun (l1,l2) -> let v1 = of_list l1 in let v2 = of_list l2 in - compare Pervasives.compare v1 v2 = CCList.compare Pervasives.compare l1 l2) + compare Stdlib.compare v1 v2 = CCList.compare Stdlib.compare l1 l2) *) exception Empty @@ -422,9 +422,9 @@ let sort cmp v = (*$QR (gen Q.small_int) (fun v -> let v' = copy v in - sort' Pervasives.compare v'; + sort' Stdlib.compare v'; let l = to_list v' in - List.sort Pervasives.compare l = l + List.sort Stdlib.compare l = l ) *) @@ -452,14 +452,14 @@ let uniq_sort cmp v = (*$T let v = of_list [1;4;5;3;2;4;1] in \ - uniq_sort Pervasives.compare v; to_list v = [1;2;3;4;5] + uniq_sort Stdlib.compare v; to_list v = [1;2;3;4;5] *) (*$QR & ~long_factor:10 Q.(small_list small_int) (fun l -> let v = of_list l in - uniq_sort Pervasives.compare v; - to_list v = (CCList.sort_uniq ~cmp:Pervasives.compare l)) + uniq_sort Stdlib.compare v; + to_list v = (CCList.sort_uniq ~cmp:Stdlib.compare l)) *) let iter k v = diff --git a/src/core/containers.ml b/src/core/containers.ml index ae54d23c..86dccf6d 100644 --- a/src/core/containers.ml +++ b/src/core/containers.ml @@ -45,4 +45,6 @@ module Vector = CCVector module Monomorphic = CCMonomorphic module Utf8_string = CCUtf8_string +module Stdlib = CCShims_.Stdlib + include Monomorphic diff --git a/src/core/dune b/src/core/dune index fcd0cc4f..828b2edb 100644 --- a/src/core/dune +++ b/src/core/dune @@ -1,38 +1,44 @@ -(rule - (targets CCArray.mli) +(alias + (name unlabel) (deps (:mli CCArrayLabels.mli) ../unlabel.exe) - (mode promote) - (action (run ../unlabel.exe %{mli} %{targets}))) + (action (run ../unlabel.exe %{mli} CCArray.mli))) -(rule - (targets CCArray_slice.mli) +(alias + (name unlabel) (deps (:mli CCArray_sliceLabels.mli) ../unlabel.exe) - (mode promote) - (action (run ../unlabel.exe %{mli} %{targets}))) + (action (run ../unlabel.exe %{mli} CCArray_slice.mli))) -(rule - (targets CCEqual.mli) +(alias + (name unlabel) (deps (:mli CCEqualLabels.mli) ../unlabel.exe) - (mode promote) - (action (run ../unlabel.exe %{mli} %{targets}))) + (action (run ../unlabel.exe %{mli} CCEqual.mli))) -(rule - (targets CCList.mli) +(alias + (name unlabel) (deps (:mli CCListLabels.mli) ../unlabel.exe) - (mode promote) - (action (run ../unlabel.exe %{mli} %{targets}))) + (action (run ../unlabel.exe %{mli} CCList.mli))) + +(alias + (name unlabel) + (deps (:mli CCStringLabels.mli) ../unlabel.exe) + (action (run ../unlabel.exe %{mli} CCString.mli))) + + +(executable + (name mkshims) + (modules mkshims) + (libraries dune.configurator)) (rule - (targets CCString.mli) - (deps (:mli CCStringLabels.mli) ../unlabel.exe) - (mode promote) - (action (run ../unlabel.exe %{mli} %{targets}))) + (targets CCShims_.ml CCShimsList_.ml CCShimsFormat_.ml) + (deps ./mkshims.exe) + (action (run ./mkshims.exe))) (library (name containers) (public_name containers) (wrapped false) + (modules :standard \ mkshims) (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -nolabels -open CCMonomorphic) (ocamlopt_flags (:include ../flambda.flags)) - (libraries result uchar containers.monomorphic) - ) + (libraries result uchar containers.monomorphic)) diff --git a/src/core/mkshims.ml b/src/core/mkshims.ml new file mode 100644 index 00000000..724910f9 --- /dev/null +++ b/src/core/mkshims.ml @@ -0,0 +1,55 @@ + +module C = Configurator.V1 + +let shims_pre_408 = "module Stdlib = Pervasives" + +let shims_post_408 = "module Stdlib = Stdlib" + +let shims_fmt_pre_408 = " +include Format +let cc_update_funs funs f1 f2 = + let open Format in + { + funs with + mark_open_tag = f1 funs.mark_open_tag; + mark_close_tag = f2 funs.mark_close_tag; + } + +" +let shims_fmt_post_408 = " +open Format + +[@@@ocaml.warning \"-3\"] + +let pp_open_tag = pp_open_tag +let pp_close_tag = pp_close_tag +let pp_get_formatter_tag_functions = pp_get_formatter_tag_functions +let pp_set_formatter_tag_functions = pp_set_formatter_tag_functions + +let cc_update_funs funs f1 f2 = + let open Format in + { + funs with + mark_open_tag = f1 ~or_else:funs.mark_open_tag; + mark_close_tag = f2 ~or_else:funs.mark_close_tag; + } +" + +let shims_list_pre_408 = " + include List + type +'a t = 'a list +" +let shims_list_post_408 = "include List" + +let write_file f s = + let out = open_out f in + output_string out s; flush out; close_out out + +let () = + C.main ~name:"mkshims" (fun c -> + let version = C.ocaml_config_var_exn c "version" in + let major, minor = Scanf.sscanf version "%u.%u" (fun maj min -> maj, min) in + write_file "CCShims_.ml" (if (major, minor) >= (4,8) then shims_post_408 else shims_pre_408); + write_file "CCShimsList_.ml" (if (major, minor) >= (4,8) then shims_list_post_408 else shims_list_pre_408); + write_file "CCShimsFormat_.ml" (if (major, minor) >= (4,8) then shims_fmt_post_408 else shims_fmt_pre_408); + ) diff --git a/src/data/CCCache.ml b/src/data/CCCache.ml index e8cf3426..4de7e637 100644 --- a/src/data/CCCache.ml +++ b/src/data/CCCache.ml @@ -222,7 +222,7 @@ module LRU(X:HASH) = struct (* take first from queue *) let take_ c = match c.first with - | Some n when Pervasives.(==) n.next n -> + | Some n when Stdlib.(==) n.next n -> (* last element *) c.first <- None; n @@ -241,7 +241,7 @@ module LRU(X:HASH) = struct n.next <- n; n.prev <- n; c.first <- Some n - | Some n1 when Pervasives.(==) n1 n -> () + | Some n1 when Stdlib.(==) n1 n -> () | Some n1 -> n.prev <- n1.prev; n.next <- n1; diff --git a/src/data/CCDeque.ml b/src/data/CCDeque.ml index 923bf95b..58e14705 100644 --- a/src/data/CCDeque.ml +++ b/src/data/CCDeque.ml @@ -74,7 +74,7 @@ let is_zero_ n = match n.cell with | Two _ | Three _ -> false -let bool_eq (a : bool) b = Pervasives.(=) a b +let bool_eq (a : bool) b = Stdlib.(=) a b let is_empty d = let res = d.size = 0 in @@ -163,7 +163,7 @@ let take_back_node_ n = match n.cell with let take_back d = if is_empty d then raise Empty - else if Pervasives.(==) d.cur d.cur.prev + else if Stdlib.(==) d.cur d.cur.prev then ( (* only one cell *) decr_size_ d; @@ -196,7 +196,7 @@ let take_front_node_ n = match n.cell with let take_front d = if is_empty d then raise Empty - else if Pervasives.(==) d.cur.prev d.cur + else if Stdlib.(==) d.cur.prev d.cur then ( (* only one cell *) decr_size_ d; @@ -255,7 +255,7 @@ let fold f acc d = | Two (x,y) -> f (f acc x) y | Three (x,y,z) -> f (f (f acc x) y) z in - if Pervasives.(==) n.next first then acc else aux ~first f acc n.next + if Stdlib.(==) n.next first then acc else aux ~first f acc n.next in aux ~first:d.cur f acc d.cur @@ -337,7 +337,7 @@ let to_gen q = let cell = ref q.cur.cell in let cur = ref q.cur in let rec next () = match !cell with - | Zero when Pervasives.(==) (!cur).next first -> None + | Zero when Stdlib.(==) (!cur).next first -> None | Zero -> (* go to next node *) let n = !cur in @@ -399,8 +399,8 @@ let compare ~cmp a b = (*$Q Q.(pair (list int) (list int)) (fun (l1,l2) -> \ - CCOrd.equiv (compare ~cmp:Pervasives.compare (of_list l1) (of_list l2)) \ - (CCList.compare Pervasives.compare l1 l2)) + CCOrd.equiv (compare ~cmp:Stdlib.compare (of_list l1) (of_list l2)) \ + (CCList.compare Stdlib.compare l1 l2)) *) type 'a printer = Format.formatter -> 'a -> unit diff --git a/src/data/CCFun_vec.ml b/src/data/CCFun_vec.ml index 4ba201c8..140519ea 100644 --- a/src/data/CCFun_vec.ml +++ b/src/data/CCFun_vec.ml @@ -6,7 +6,7 @@ let g = Q.(small_list (pair small_int small_int)) in Q.map_same_type (fun l -> - CCList.sort_uniq ~cmp:(fun a b -> Pervasives.compare (fst a)(fst b)) l + CCList.sort_uniq ~cmp:(fun a b -> Stdlib.compare (fst a)(fst b)) l ) g ;; *) @@ -24,7 +24,7 @@ type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list] type state = { mutable frozen: bool } type t = Nil | St of state let empty = Nil - let equal a b = Pervasives.(==) a b + let equal a b = Stdlib.(==) a b let create () = St {frozen=false} let active = function Nil -> false | St st -> not st.frozen let frozen = function Nil -> true | St st -> st.frozen @@ -324,9 +324,9 @@ let to_seq m yield = iteri ~f:(fun _ v -> yield v) m (*$Q _listuniq (fun l -> \ - (List.sort Pervasives.compare l) = \ + (List.sort Stdlib.compare l) = \ (l |> Iter.of_list |> of_seq |> to_seq |> Iter.to_list \ - |> List.sort Pervasives.compare) ) + |> List.sort Stdlib.compare) ) *) let rec add_gen m g = match g() with @@ -355,9 +355,9 @@ let to_gen m = (*$Q _listuniq (fun l -> \ - (List.sort Pervasives.compare l) = \ + (List.sort Stdlib.compare l) = \ (l |> Gen.of_list |> of_gen |> to_gen |> Gen.to_list \ - |> List.sort Pervasives.compare) ) + |> List.sort Stdlib.compare) ) *) let choose m = to_gen m () diff --git a/src/data/CCHashTrie.ml b/src/data/CCHashTrie.ml index 0dbc9720..85f8f726 100644 --- a/src/data/CCHashTrie.ml +++ b/src/data/CCHashTrie.ml @@ -7,7 +7,7 @@ let g = Q.(list (pair small_int small_int)) in Q.map_same_type (fun l -> - CCList.sort_uniq ~cmp:(fun a b -> Pervasives.compare (fst a)(fst b)) l + CCList.sort_uniq ~cmp:(fun a b -> Stdlib.compare (fst a)(fst b)) l ) g ;; *) @@ -23,7 +23,7 @@ type 'a ktree = unit -> [`Nil | `Node of 'a * 'a ktree list] module Transient = struct type t = { mutable frozen: bool } let empty = {frozen=true} (* special value *) - let equal a b = Pervasives.(==) a b + let equal a b = Stdlib.(==) a b let create () = {frozen=false} let active st =not st.frozen let frozen st = st.frozen @@ -232,13 +232,13 @@ module A_SPARSE = struct (* insert at [real_idx] in a new array *) let bits = a.bits lor idx in let n = Array.length a.arr in - let arr = Array.make Pervasives.(n+1) x in + let arr = Array.make Stdlib.(n+1) x in arr.(real_idx) <- x; if real_idx>0 then ( Array.blit a.arr 0 arr 0 real_idx; ); if real_idx0 then ( Array.blit a.arr 0 arr 0 real_idx; ); if real_idx 0 then ( Array.blit a.arr 0 arr 0 real_idx; ); @@ -329,7 +329,7 @@ module Make(Key : KEY) let make = Key.hash let zero = 0 let is_0 h = h = 0 - let equal : int -> int -> bool = Pervasives.(=) + let equal : int -> int -> bool = Stdlib.(=) let rem h = h land (A.length - 1) let quotient h = h lsr A.length_log end @@ -496,7 +496,7 @@ module Make(Key : KEY) add_ ~id k v ~h:(hash_ k) m (*$R - let lsort = List.sort Pervasives.compare in + let lsort = List.sort Stdlib.compare in let m = M.of_list [1, 1; 2, 2] in let id = Transient.create() in let m' = M.add_mut ~id 3 3 m in @@ -608,7 +608,7 @@ module Make(Key : KEY) | Some _ -> Some 0 ) m in - assert_equal [1,1; 2,2; 4,4; 5,5] (M.to_list m' |> List.sort Pervasives.compare); + assert_equal [1,1; 2,2; 4,4; 5,5] (M.to_list m' |> List.sort Stdlib.compare); *) let iter ~f t = @@ -643,7 +643,7 @@ module Make(Key : KEY) let l = CCList.(1 -- 10 |> map (fun x->x,x)) in \ M.of_list l \ |> M.fold ~f:(fun acc x y -> (x,y)::acc) ~x:[] \ - |> List.sort Pervasives.compare = l + |> List.sort Stdlib.compare = l *) let cardinal m = fold ~f:(fun n _ _ -> n+1) ~x:0 m @@ -672,9 +672,9 @@ module Make(Key : KEY) (*$Q _listuniq (fun l -> \ - (List.sort Pervasives.compare l) = \ + (List.sort Stdlib.compare l) = \ (l |> Iter.of_list |> M.of_seq |> M.to_seq |> Iter.to_list \ - |> List.sort Pervasives.compare) ) + |> List.sort Stdlib.compare) ) *) let rec add_gen_mut ~id m g = match g() with @@ -716,9 +716,9 @@ module Make(Key : KEY) (*$Q _listuniq (fun l -> \ - (List.sort Pervasives.compare l) = \ + (List.sort Stdlib.compare l) = \ (l |> Gen.of_list |> M.of_gen |> M.to_gen |> Gen.to_list \ - |> List.sort Pervasives.compare) ) + |> List.sort Stdlib.compare) ) *) let choose m = to_gen m () diff --git a/src/data/CCHet.ml b/src/data/CCHet.ml index b6254dfc..abd9ec0e 100644 --- a/src/data/CCHet.ml +++ b/src/data/CCHet.ml @@ -139,7 +139,7 @@ end module Map = struct module M = Map.Make(struct type t = int - let compare (i:int) j = Pervasives.compare i j + let compare (i:int) j = Stdlib.compare i j end) type t = exn_pair M.t diff --git a/src/data/CCIntMap.ml b/src/data/CCIntMap.ml index 7174dbcd..14faf74f 100644 --- a/src/data/CCIntMap.ml +++ b/src/data/CCIntMap.ml @@ -23,7 +23,7 @@ end = struct let min_int = min_int - let equal : t -> t -> bool = Pervasives.(=) + let equal : t -> t -> bool = Stdlib.(=) let rec highest_bit_naive x m = if x=m then m @@ -54,7 +54,7 @@ end = struct let gt a b = (b != min_int) && (a = min_int || a > b) let lt a b = gt b a - let equal_int = Pervasives.(=) + let equal_int = Stdlib.(=) end (*$inject @@ -74,7 +74,7 @@ end *) (*$inject - let _list_uniq l = CCList.sort_uniq ~cmp:(fun a b-> Pervasives.compare (fst a)(fst b)) l + let _list_uniq l = CCList.sort_uniq ~cmp:(fun a b-> Stdlib.compare (fst a)(fst b)) l *) type +'a t = @@ -270,13 +270,13 @@ let update k f t = [1,1; 2, 22; 3, 3] \ (of_list [1,1;2,2;3,3] \ |> update 2 (function None -> assert false | Some _ -> Some 22) \ - |> to_list |> List.sort Pervasives.compare) + |> to_list |> List.sort Stdlib.compare) *) let doubleton k1 v1 k2 v2 = add k1 v1 (singleton k2 v2) let rec equal ~eq a b = - Pervasives.(==) a b || + Stdlib.(==) a b || begin match a, b with | E, E -> true | L (ka, va), L (kb, vb) -> ka = kb && eq va vb @@ -562,7 +562,7 @@ let rec merge ~f t1 t2 : _ t = (*$QR Q.(let p = small_list (pair small_int unit) in pair p p) (fun (l1,l2) -> let l1 = _list_uniq l1 and l2 = _list_uniq l2 in - equal Pervasives.(=) + equal Stdlib.(=) (union (fun _ v1 _ -> v1) (of_list l1) (of_list l2)) (merge ~f:merge_union (of_list l1) (of_list l2))) *) @@ -570,7 +570,7 @@ let rec merge ~f t1 t2 : _ t = (*$QR Q.(let p = small_list (pair small_int unit) in pair p p) (fun (l1,l2) -> let l1 = _list_uniq l1 and l2 = _list_uniq l2 in - equal Pervasives.(=) + equal Stdlib.(=) (inter (fun _ v1 _ -> v1) (of_list l1) (of_list l2)) (merge ~f:merge_inter (of_list l1) (of_list l2))) *) @@ -636,7 +636,7 @@ let to_gen m = (*$T doubleton 1 "a" 2 "b" |> to_gen |> of_gen |> to_list \ - |> List.sort Pervasives.compare = [1, "a"; 2, "b"] + |> List.sort Stdlib.compare = [1, "a"; 2, "b"] *) (*$Q @@ -663,7 +663,7 @@ let compare ~cmp a b = (*$Q Q.(list (pair int bool)) ( fun l -> \ let m1 = of_list l and m2 = of_list (List.rev l) in \ - compare ~cmp:Pervasives.compare m1 m2 = 0) + compare ~cmp:Stdlib.compare m1 m2 = 0) *) @@ -672,8 +672,8 @@ let compare ~cmp a b = let l1 = List.map (fun (k,v) -> abs k,v) l1 in let l2 = List.map (fun (k,v) -> abs k,v) l2 in let m1 = of_list l1 and m2 = of_list l2 in - let c = compare ~cmp:Pervasives.compare m1 m2 - and c' = compare ~cmp:Pervasives.compare m2 m1 in + let c = compare ~cmp:Stdlib.compare m1 m2 + and c' = compare ~cmp:Stdlib.compare m2 m1 in (c = 0) = (c' = 0) && (c < 0) = (c' > 0) && (c > 0) = (c' < 0)) *) @@ -682,7 +682,7 @@ let compare ~cmp a b = let l1 = List.map (fun (k,v) -> abs k,v) l1 in let l2 = List.map (fun (k,v) -> abs k,v) l2 in let m1 = of_list l1 and m2 = of_list l2 in - (compare ~cmp:Pervasives.compare m1 m2 = 0) = equal ~eq:(=) m1 m2) + (compare ~cmp:Stdlib.compare m1 m2 = 0) = equal ~eq:(=) m1 m2) *) let rec add_klist m l = match l() with @@ -833,7 +833,7 @@ let pp pp_x out m = let rec remove_m i s = match s with | [] -> [] | (j,v)::s' -> if i=j then s' else (j,v)::(remove_m i s') - let add_m k v s = List.sort Pervasives.compare ((k,v)::remove_m k s) + let add_m k v s = List.sort Stdlib.compare ((k,v)::remove_m k s) let rec union_m s s' = match s,s' with | [], _ -> s' | _, [] -> s @@ -848,7 +848,7 @@ let pp pp_x out m = then (k,min v (List.assoc k s'))::(inter_m s s') else inter_m s s' - let abstract s = List.sort Pervasives.compare (fold (fun k v acc -> (k,v)::acc) s []) + let abstract s = List.sort Stdlib.compare (fold (fun k v acc -> (k,v)::acc) s []) *) (* A bunch of agreement properties *) diff --git a/src/data/CCPersistentHashtbl.ml b/src/data/CCPersistentHashtbl.ml index 8eedf828..a58a6cc9 100644 --- a/src/data/CCPersistentHashtbl.ml +++ b/src/data/CCPersistentHashtbl.ml @@ -130,7 +130,7 @@ end let my_seq = Iter.of_list my_list let _list_uniq = CCList.sort_uniq - ~cmp:(fun a b -> Pervasives.compare (fst a) (fst b)) + ~cmp:(fun a b -> Stdlib.compare (fst a) (fst b)) let _list_int_int = Q.( map_same_type _list_uniq diff --git a/src/data/CCRAL.ml b/src/data/CCRAL.ml index e66e52fb..2bc3353e 100644 --- a/src/data/CCRAL.ml +++ b/src/data/CCRAL.ml @@ -604,7 +604,7 @@ let compare ~cmp l1 l2 = (*$Q Q.(pair (list int)(list int)) (fun (l1,l2) -> \ - compare ~cmp:CCInt.compare (of_list l1) (of_list l2) = (Pervasives.compare l1 l2)) + compare ~cmp:CCInt.compare (of_list l1) (of_list l2) = (Stdlib.compare l1 l2)) *) (** {2 Infix} *) diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml index a2c00fc6..01cde777 100644 --- a/src/data/CCTrie.ml +++ b/src/data/CCTrie.ml @@ -398,7 +398,7 @@ module Make(W : WORD) (*$T T.fold (fun acc k v -> (k,v) :: acc) [] t1 \ - |> List.sort Pervasives.compare = List.sort Pervasives.compare l1 + |> List.sort Stdlib.compare = List.sort Stdlib.compare l1 *) let mapi f t = @@ -418,9 +418,9 @@ module Make(W : WORD) in map_ _id t (*$= & ~printer:Q.Print.(list (pair (list int) string)) - (List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Pervasives.compare) \ + (List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Stdlib.compare) \ (T.mapi (fun k v -> v ^ "!") t1 \ - |> T.to_list |> List.sort Pervasives.compare) + |> T.to_list |> List.sort Stdlib.compare) *) let map f t = @@ -435,9 +435,9 @@ module Make(W : WORD) in Node (v', map') in map_ t (*$= & ~printer:Q.Print.(list (pair (list int) string)) - (List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Pervasives.compare) \ + (List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Stdlib.compare) \ (T.map (fun v -> v ^ "!") t1 \ - |> T.to_list |> List.sort Pervasives.compare) + |> T.to_list |> List.sort Stdlib.compare) *) diff --git a/src/data/CCWBTree.ml b/src/data/CCWBTree.ml index bd471239..8363d93f 100644 --- a/src/data/CCWBTree.ml +++ b/src/data/CCWBTree.ml @@ -34,7 +34,7 @@ let op = Q.make ~print:pp_op gen_op - let _list_uniq = CCList.sort_uniq ~cmp:(CCFun.compose_binop fst Pervasives.compare) + let _list_uniq = CCList.sort_uniq ~cmp:(CCFun.compose_binop fst Stdlib.compare) *) (*$Q & ~count:200 @@ -539,7 +539,7 @@ module MakeFull(K : KEY) : S with type key = K.t = struct ~cmp:(CCList.equal (CCPair.equal CCInt.equal CCInt.equal)) ~printer:CCFormat.(to_string (list (pair int int))) [1, 2; 4, 8] - (M.to_list m |> List.sort Pervasives.compare) + (M.to_list m |> List.sort Stdlib.compare) *) (*$QR diff --git a/src/data/dune b/src/data/dune index ed738693..cda5e3ae 100644 --- a/src/data/dune +++ b/src/data/dune @@ -3,7 +3,6 @@ (name containers_data) (public_name containers.data) (wrapped false) - (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) + (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -open CCShims_) (ocamlopt_flags :standard (:include ../flambda.flags)) - (libraries result) - ) + (libraries result containers)) diff --git a/src/dune b/src/dune index 6863ff71..ff298374 100644 --- a/src/dune +++ b/src/dune @@ -8,6 +8,9 @@ (modules unlabel) (libraries compiler-libs.common)) +(env + (_ (flags :standard -warn-error -3))) + (rule (targets flambda.flags) (mode fallback) diff --git a/src/monomorphic/CCMonomorphic.ml b/src/monomorphic/CCMonomorphic.ml index 2f402823..462cf2b1 100644 --- a/src/monomorphic/CCMonomorphic.ml +++ b/src/monomorphic/CCMonomorphic.ml @@ -1,23 +1,25 @@ (* This file is free software, part of containers. See file "license" for more details. *) -let (=) : int -> int -> bool = Pervasives.(=) -let (<>) : int -> int -> bool = Pervasives.(<>) -let (<) : int -> int -> bool = Pervasives.(<) -let (>) : int -> int -> bool = Pervasives.(>) -let (<=) : int -> int -> bool = Pervasives.(<=) -let (>=) : int -> int -> bool = Pervasives.(>=) +open CCMonomorphicShims_ -let compare : int -> int -> int = Pervasives.compare -let min : int -> int -> int = Pervasives.min -let max : int -> int -> int = Pervasives.max +let (=) : int -> int -> bool = Stdlib.(=) +let (<>) : int -> int -> bool = Stdlib.(<>) +let (<) : int -> int -> bool = Stdlib.(<) +let (>) : int -> int -> bool = Stdlib.(>) +let (<=) : int -> int -> bool = Stdlib.(<=) +let (>=) : int -> int -> bool = Stdlib.(>=) -let (=.) : float -> float -> bool = Pervasives.(=) -let (<>.) : float -> float -> bool = Pervasives.(<>) -let (<.) : float -> float -> bool = Pervasives.(<) -let (>.) : float -> float -> bool = Pervasives.(>) -let (<=.) : float -> float -> bool = Pervasives.(<=) -let (>=.) : float -> float -> bool = Pervasives.(>=) +let compare : int -> int -> int = Stdlib.compare +let min : int -> int -> int = Stdlib.min +let max : int -> int -> int = Stdlib.max + +let (=.) : float -> float -> bool = Stdlib.(=) +let (<>.) : float -> float -> bool = Stdlib.(<>) +let (<.) : float -> float -> bool = Stdlib.(<) +let (>.) : float -> float -> bool = Stdlib.(>) +let (<=.) : float -> float -> bool = Stdlib.(<=) +let (>=.) : float -> float -> bool = Stdlib.(>=) let (==) = `Consider_using_CCEqual_physical diff --git a/src/monomorphic/dune b/src/monomorphic/dune index 0322d471..06b39722 100644 --- a/src/monomorphic/dune +++ b/src/monomorphic/dune @@ -1,8 +1,18 @@ +(executable + (name mkshims) + (modules mkshims) + (libraries dune.configurator)) + +(rule + (targets CCMonomorphicShims_.ml) + (deps ./mkshims.exe) + (action (with-stdout-to %{targets} (run ./mkshims.exe)))) + (library (name containers_monomorphic) (public_name containers.monomorphic) + (modules CCMonomorphic CCMonomorphicShims_) (wrapped false) (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) - (ocamlopt_flags :standard (:include ../flambda.flags)) - ) + (ocamlopt_flags :standard (:include ../flambda.flags))) diff --git a/src/monomorphic/mkshims.ml b/src/monomorphic/mkshims.ml new file mode 100644 index 00000000..f391a32c --- /dev/null +++ b/src/monomorphic/mkshims.ml @@ -0,0 +1,11 @@ + +module C = Configurator.V1 + +let shims_pre_408 = "module Stdlib = Pervasives" +let shims_post_408 = "module Stdlib = Stdlib" + +let () = + C.main ~name:"mkshims" (fun c -> + let version = C.ocaml_config_var_exn c "version" in + let major, minor = Scanf.sscanf version "%u.%u" (fun maj min -> maj, min) in + print_endline (if (major, minor) >= (4,8) then shims_post_408 else shims_pre_408)) diff --git a/src/sexp/CCSexp.ml b/src/sexp/CCSexp.ml index 25857c31..7c4a8471 100644 --- a/src/sexp/CCSexp.ml +++ b/src/sexp/CCSexp.ml @@ -3,6 +3,8 @@ (** {1 Simple S-expression parsing/printing} *) +open CCShims_ + type 'a or_error = ('a, string) Result.result type 'a sequence = ('a -> unit) -> unit type 'a gen = unit -> 'a option @@ -13,7 +15,7 @@ type t = [ ] type sexp = t -let equal_string (a : string) b = Pervasives.(=) a b +let equal_string (a : string) b = Stdlib.(=) a b let rec equal a b = match a, b with | `Atom s1, `Atom s2 -> @@ -22,7 +24,7 @@ let rec equal a b = match a, b with 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 compare_string (a : string) b = Stdlib.compare a b let rec compare_list a b = match a, b with | [], [] -> 0 diff --git a/src/sexp/CCSexp_lex.mll b/src/sexp/CCSexp_lex.mll index 024d0a6b..3db73cd6 100644 --- a/src/sexp/CCSexp_lex.mll +++ b/src/sexp/CCSexp_lex.mll @@ -1,4 +1,5 @@ { + open CCShims_ type token = | ATOM of string | LIST_OPEN @@ -20,7 +21,7 @@ | Escaped_int_1 of int | Escaped_int_2 of int - let char_equal (a : char) b = Pervasives.(=) a b + let char_equal (a : char) b = Stdlib.(=) a b (* remove quotes + unescape *) let remove_quotes lexbuf s = diff --git a/src/sexp/dune b/src/sexp/dune index 0066e698..bf1a6f9d 100644 --- a/src/sexp/dune +++ b/src/sexp/dune @@ -5,7 +5,6 @@ (wrapped false) (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) (ocamlopt_flags :standard (:include ../flambda.flags)) - (libraries result) - ) + (libraries result containers)) (ocamllex (modules CCSexp_lex)) diff --git a/src/threads/CCBlockingQueue.ml b/src/threads/CCBlockingQueue.ml index 9a5a0f9f..053c085a 100644 --- a/src/threads/CCBlockingQueue.ml +++ b/src/threads/CCBlockingQueue.ml @@ -73,7 +73,7 @@ let take q = done) in Thread.join t1; Thread.join t2; Thread.join t3; - assert_equal [1;2;3;4] (List.sort Pervasives.compare (CCLock.get l)) + assert_equal [1;2;3;4] (List.sort Stdlib.compare (CCLock.get l)) *) let push_list q l = @@ -156,7 +156,7 @@ let take_list q n = ) in CCThread.Arr.join senders; CCThread.Arr.join receivers; - let l = CCLock.get res |> List.sort Pervasives.compare in + let l = CCLock.get res |> List.sort Stdlib.compare in assert_equal CCList.(1 -- 3*n) l *) diff --git a/src/threads/CCLock.ml b/src/threads/CCLock.ml index 61daccfe..d916f371 100644 --- a/src/threads/CCLock.ml +++ b/src/threads/CCLock.ml @@ -120,9 +120,9 @@ let set l x = let l = create 0 in set l 4; set l 5; get l = 5 *) -let incr l = update l Pervasives.succ +let incr l = update l Stdlib.succ -let decr l = update l Pervasives.pred +let decr l = update l Stdlib.pred (*$R diff --git a/src/threads/CCTimer.ml b/src/threads/CCTimer.ml index 9ad6e2c4..2315c028 100644 --- a/src/threads/CCTimer.ml +++ b/src/threads/CCTimer.ml @@ -6,10 +6,10 @@ 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 +let (<=) (a : float) b = Stdlib.(<=) a b +let (>=) (a : float) b = Stdlib.(>=) a b +let (<) (a : float) b = Stdlib.(<) a b +let (>) (a : float) b = Stdlib.(>) a b module TaskHeap = CCHeap.Make(struct type t = job diff --git a/src/threads/dune b/src/threads/dune index 504d9d99..4df73ac3 100644 --- a/src/threads/dune +++ b/src/threads/dune @@ -4,8 +4,7 @@ (public_name containers.thread) (wrapped false) (optional) - (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) + (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -open CCShims_) (ocamlopt_flags :standard (:include ../flambda.flags)) - (libraries containers threads) - ) + (libraries containers threads))