Commit f3c4504d authored by Andre Maroneze's avatar Andre Maroneze
Browse files

[ocaml] improve compatibility with 4.08: Pervasives.compare

parent 7514d3c2
......@@ -7,7 +7,7 @@ let root = ref ""
module Dep_graph = Graph.Imperative.Digraph.Concrete(
struct
type t = string
let compare = Pervasives.compare
let compare = Transitioning.Stdlib.compare
let hash = Hashtbl.hash
let equal = (=)
end)
......
......@@ -344,7 +344,7 @@ let () =
((Arg.align
(List.sort
(fun (optname1, _, _) (optname2, _, _) ->
Pervasives.compare optname1 optname2
compare optname1 optname2
) argspec)
) @ ["", Arg.Unit (fun () -> ()), example_msg;])
make_test_suite umsg
......@@ -1103,7 +1103,7 @@ module Make_Report(M:sig type t end)=struct
(struct
type t = toplevel_command
let project cmd = (cmd.directory,cmd.file,cmd.n)
let compare c1 c2 = Pervasives.compare (project c1) (project c2)
let compare c1 c2 = compare (project c1) (project c2)
let equal c1 c2 = (project c1)=(project c2)
let hash c = Hashtbl.hash (project c)
end)
......
......@@ -432,7 +432,7 @@ module Bool = struct
type t = Top | True | False | Bottom
let hash (b : t) = Hashtbl.hash b
let equal (b1 : t) (b2 : t) = b1 = b2
let compare (b1 : t) (b2 : t) = Pervasives.compare b1 b2
let compare (b1 : t) (b2 : t) = Transitioning.Stdlib.compare b1 b2
let pretty fmt = function
| Top -> Format.fprintf fmt "Top"
| True -> Format.fprintf fmt "True"
......
......@@ -171,7 +171,7 @@ module Make (F: Float_sig.S) = struct
let compare x y =
match x, y with
| FRange.Itv (b1, e1, n1), FRange.Itv (b2, e2, n2) ->
let c = Pervasives.compare n1 n2 in
let c = Transitioning.Stdlib.compare n1 n2 in
if c <> 0 then c else
let r = F.compare b1 b2 in
if r <> 0 then r else F.compare e1 e2
......
......@@ -129,7 +129,7 @@ module D =
let n = Exp.compare e1 e2 in
if n = 0 then Extlib.compare_basic fk1 fk2 else n
| Memory_access(lv1, access_kind1), Memory_access(lv2, access_kind2) ->
let n = Pervasives.compare access_kind1 access_kind2 in
let n = Transitioning.Stdlib.compare access_kind1 access_kind2 in
if n = 0 then Lval.compare lv1 lv2 else n
| Index_out_of_bound(e11, e12), Index_out_of_bound(e21, e22) ->
let n = Exp.compare e11 e21 in
......@@ -141,11 +141,11 @@ module D =
let n = Extlib.opt_compare Exp.compare e11 e21 in
if n = 0 then Exp.compare e12 e22 else n
| Overflow(s1, e1, n1, b1), Overflow(s2, e2, n2, b2) ->
let n = Pervasives.compare s1 s2 in
let n = Transitioning.Stdlib.compare s1 s2 in
if n = 0 then
let n = Exp.compare e1 e2 in
if n = 0 then
let n = Pervasives.compare b1 b2 in
let n = Transitioning.Stdlib.compare b1 b2 in
if n = 0 then Integer.compare n1 n2 else n
else
n
......@@ -154,7 +154,7 @@ module D =
| Float_to_int(e1, n1, b1), Float_to_int(e2, n2, b2) ->
let n = Exp.compare e1 e2 in
if n = 0 then
let n = Pervasives.compare b1 b2 in
let n = Transitioning.Stdlib.compare b1 b2 in
if n = 0 then Integer.compare n1 n2 else n
else
n
......
......@@ -562,7 +562,7 @@ include Datatype.Make_with_collections
let n = Extlib.opt_compare Kf.compare kf1 kf2 in
if n = 0 then
let n = Kinstr.compare ki1 ki2 in
if n = 0 then Pervasives.compare ba1 ba2 else n
if n = 0 then Transitioning.Stdlib.compare ba1 ba2 else n
else
n
| IPAxiom (s1,_,_,_,_), IPAxiom (s2,_,_,_,_)
......
......@@ -47,7 +47,7 @@ module Emitted_status =
| True -> "VALID"
| False_if_reachable | False_and_reachable -> "**NOT** VALID"
| Dont_know -> "unknown")
let compare (s1:t) s2 = Pervasives.compare s1 s2
let compare (s1:t) s2 = Transitioning.Stdlib.compare s1 s2
let equal (s1:t) s2 = s1 = s2
let hash (s:t) = Caml_hashtbl.hash s
end)
......
......@@ -409,7 +409,7 @@ type order =
| A of Datatype.String.Set.t
let cmp_order a b = match a , b with
| I a , I b -> Pervasives.compare a b
| I a , I b -> Transitioning.Stdlib.compare a b
| I _ , _ -> (-1)
| _ , I _ -> 1
| S a , S b -> String.compare a b
......
......@@ -1584,7 +1584,7 @@ and compare_toffset off1 off2 =
and compare_logic_label l1 l2 = match l1, l2 with
| StmtLabel s1 , StmtLabel s2 -> Stmt.compare !s1 !s2
| FormalLabel s1, FormalLabel s2 -> String.compare s1 s2
| BuiltinLabel l1, BuiltinLabel l2 -> Pervasives.compare l1 l2
| BuiltinLabel l1, BuiltinLabel l2 -> Transitioning.Stdlib.compare l1 l2
| (StmtLabel _ | FormalLabel _), (FormalLabel _ | BuiltinLabel _) -> -1
| (BuiltinLabel _ | FormalLabel _), (StmtLabel _ | FormalLabel _) -> 1
......
......@@ -284,7 +284,7 @@ module DatatypeMachdep = Datatype.Make_with_collections(struct
let reprs = [Machdeps.x86_32]
let name = "File.Machdep"
type t = Cil_types.mach
let compare : t -> t -> int = Pervasives.compare
let compare : t -> t -> int = Transitioning.Stdlib.compare
let equal : t -> t -> bool = (=)
let hash : t -> int = Hashtbl.hash
let copy = Datatype.identity
......
......@@ -457,7 +457,7 @@ module Type_namespace =
let reprs = [Typedef]
let name = "Logic_typing.type_namespace"
type t = type_namespace
let compare : t -> t -> int = Pervasives.compare
let compare : t -> t -> int = Transitioning.Stdlib.compare
let equal : t -> t -> bool = (=)
let hash : t -> int = Hashtbl.hash
end)
......@@ -3593,7 +3593,7 @@ struct
struct
type t = string list
let compare s1 s2 =
Pervasives.(compare (List.sort compare s1) (List.sort compare s2))
Transitioning.Stdlib.(compare (List.sort compare s1) (List.sort compare s2))
end)
let type_spec old_behaviors loc is_stmt_contract result env s =
......
......@@ -1544,12 +1544,12 @@ let rec compare_term t1 t2 =
| TAlignOfE _, _ -> 1
| _, TAlignOfE _ -> -1
| TUnOp (o1,t1), TUnOp(o2,t2) ->
let res = Pervasives.compare o1 o2 in
let res = Transitioning.Stdlib.compare o1 o2 in
if res = 0 then compare_term t1 t2 else res
| TUnOp _, _ -> 1
| _, TUnOp _ -> -1
| TBinOp(o1,l1,r1), TBinOp(o2,l2,r2) ->
let res = Pervasives.compare o1 o2 in
let res = Transitioning.Stdlib.compare o1 o2 in
if res = 0 then
let res = compare_term l1 l2 in
if res = 0 then compare_term r1 r2 else res
......@@ -1749,7 +1749,7 @@ and compare_predicate_node p1 p2 =
| Papp _, _ -> 1
| _, Papp _ -> -1
| Prel(r1,lt1,rt1), Prel(r2,lt2,rt2) ->
let res = Pervasives.compare r1 r2 in
let res = Transitioning.Stdlib.compare r1 r2 in
if res = 0 then
let res = compare_term lt1 lt2 in
if res = 0 then compare_term rt1 rt2 else res
......
......@@ -1776,7 +1776,7 @@ module Bool =
let name = "bool"
let reprs = [ true ]
let copy = identity
let compare : bool -> bool -> int = Pervasives.compare
let compare : bool -> bool -> int = Transitioning.Stdlib.compare
let equal : bool -> bool -> bool = (=)
let pretty fmt b = Format.fprintf fmt "%B" b
let varname _ = "b"
......@@ -1790,12 +1790,12 @@ module Int = struct
let name = "int"
let reprs = [ 2 ]
let copy = identity
let compare : int -> int -> int = Pervasives.compare
let compare : int -> int -> int = Transitioning.Stdlib.compare
let equal : int -> int -> bool = (=)
let pretty fmt n = Format.fprintf fmt "%d" n
let varname _ = "n"
end)
let compare : int -> int -> int = Pervasives.compare
let compare : int -> int -> int = Transitioning.Stdlib.compare
end
let int = Int.ty
......@@ -1848,7 +1848,7 @@ module Float =
let name = "float"
let reprs = [ 0.1 ]
let copy = identity
let compare : float -> float -> int = Pervasives.compare
let compare : float -> float -> int = Transitioning.Stdlib.compare
let equal : float -> float -> bool = (=)
let pretty fmt f = Format.fprintf fmt "%f" f
let varname _ = "f"
......
......@@ -50,7 +50,7 @@ module Make(H: Hashtbl.HashedType) : S with type key = H.t = struct
include Hashtbl.Make(H)
let fold_sorted ?(cmp=Pervasives.compare) f h acc =
let fold_sorted ?(cmp=Transitioning.Stdlib.compare) f h acc =
let module Aux = struct type t = key let compare = cmp end in
let module M = FCMap.Make(Aux) in
let add k v m =
......
......@@ -57,6 +57,12 @@ let _: ('a -> bool) -> 'a list -> 'a option = find_opt
let _: 'a -> ('a * 'b) list -> 'b option = assoc_opt
let _: 'a -> ('a * 'b) list -> 'b option = assq_opt
let stdlib_compare = compare (* Pervasives/Stdlib compare *)
module Stdlib = struct
let compare = stdlib_compare
end
[@@@ warning "-3"]
module String = struct
......
......@@ -223,7 +223,7 @@ let bitwise_op4 size op4 a b c d =
let equal = (=);; (* String equality. *)
let compare = Pervasives.compare
let compare = Transitioning.Stdlib.compare
let hash = Hashtbl.hash
let concat bv1 size1 bv2 size2 =
......
......@@ -37,7 +37,7 @@ type json =
type t = json
let equal = (=)
let compare = Pervasives.compare
let compare = Transitioning.Stdlib.compare
type token = EOF | TRUE | FALSE | NULL | KEY of char
| STR of string | INT of string | DEC of string
......
......@@ -48,7 +48,7 @@ let rec pp_print_string_fill out s =
Format.fprintf out "%s@ %a" s1 pp_print_string_fill s2
end else Format.pp_print_string out s
type sformat = (unit,Format.formatter,unit) Pervasives.format
type sformat = (unit,Format.formatter,unit) format
type 'a formatter = Format.formatter -> 'a -> unit
type ('a,'b) formatter2 = Format.formatter -> 'a -> 'b -> unit
......@@ -180,11 +180,14 @@ let pp_trail pp fmt x =
(* --- Margins --- *)
(* -------------------------------------------------------------------------- *)
let pervasives_min = min
let pervasives_max = max
type marger = int ref
let marger () = ref 0
let add_margin marger ?(margin=0) ?(min=0) ?(max=80) text =
let size = String.length text + margin in
let n = Pervasives.min max (Pervasives.max min size) in
let n = pervasives_min max (pervasives_max min size) in
if n > !marger then marger := n
type align = [ `Center | `Left | `Right ]
......
......@@ -70,7 +70,7 @@ val escape_underscores : string -> string
(** {2 pretty printers for standard types} *)
(* ********************************************************************** *)
type sformat = (unit,Format.formatter,unit) Pervasives.format
type sformat = (unit,Format.formatter,unit) format
type 'a formatter = Format.formatter -> 'a -> unit
type ('a,'b) formatter2 = Format.formatter -> 'a -> 'b -> unit
......
......@@ -42,7 +42,7 @@ type 'a entry = int * int * 'a
module Wmap = Map.Make
(struct
type t = int
let compare (a:t) (b:t) = Pervasives.compare a b
let compare (a:t) (b:t) = Transitioning.Stdlib.compare a b
end)
module Rmap = Map.Make
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment