diff --git a/infer/src/IR/Objc_models.ml b/infer/src/IR/Objc_models.ml index 07a5e2ff8..125c31c5c 100644 --- a/infer/src/IR/Objc_models.ml +++ b/infer/src/IR/Objc_models.ml @@ -201,8 +201,8 @@ struct | Core_graphics -> core_graphics_types let is_objc_memory_model_controlled o = - IList.mem (string_equal) o core_foundation_types || - IList.mem (string_equal) o core_graphics_types + IList.mem Core.Std.String.equal o core_foundation_types || + IList.mem Core.Std.String.equal o core_graphics_types let rec is_core_lib lib typ = match typ with @@ -210,7 +210,7 @@ struct is_core_lib lib styp | Typ.Tstruct name -> let core_lib_types = core_lib_to_type_list lib in - IList.mem string_equal (Typename.name name) core_lib_types + IList.mem Core.Std.String.equal (Typename.name name) core_lib_types | _ -> false let is_core_foundation_type typ = diff --git a/infer/src/IR/Procdesc.re b/infer/src/IR/Procdesc.re index 3810b7d7c..a21bef2e8 100644 --- a/infer/src/IR/Procdesc.re +++ b/infer/src/IR/Procdesc.re @@ -63,7 +63,7 @@ let module Node = { preds: [], exn: [] }; - let compare node1 node2 => int_compare node1.id node2.id; + let compare node1 node2 => Core.Std.Int.compare node1.id node2.id; let hash node => Hashtbl.hash node.id; let equal node1 node2 => compare node1 node2 == 0; @@ -71,7 +71,7 @@ let module Node = { let get_id node => node.id; /** compare node ids */ - let compare_id = int_compare; + let compare_id = Core.Std.Int.compare; let get_succs node => node.succs; type node = t; let module NodeSet = Set.Make { diff --git a/infer/src/IR/Sil.re b/infer/src/IR/Sil.re index e95552811..aeee8f040 100644 --- a/infer/src/IR/Sil.re +++ b/infer/src/IR/Sil.re @@ -2019,7 +2019,7 @@ let rec exp_compare_structural e1 e2 exp_map => { if (n != 0) { n } else { - opt_compare Typ.compare to1 to2 + [%compare : option Typ.t] to1 to2 }, exp_map ) @@ -2159,7 +2159,7 @@ let compare_structural_instr instr1 instr2 exp_map => { if (n != 0) { n } else { - let n = bool_compare true_branch1 true_branch2; + let n = Core.Std.Bool.compare true_branch1 true_branch2; if (n != 0) { n } else { diff --git a/infer/src/backend/InferPrint.re b/infer/src/backend/InferPrint.re index 2c9f80d7b..6b8c72d40 100644 --- a/infer/src/backend/InferPrint.re +++ b/infer/src/backend/InferPrint.re @@ -345,7 +345,7 @@ let should_report (issue_kind: Exceptions.err_kind) issue_type error_desc => let eq o y => switch (o, y) { | (None, _) => false - | (Some x, y) => string_equal x y + | (Some x, y) => Core.Std.String.equal x y }; IList.mem eq issue_bucket high_buckets }; @@ -1273,7 +1273,7 @@ let module AnalysisResults = { if (n != 0) { n } else { - int_compare + Core.Std.Int.compare summ1.Specs.attributes.ProcAttributes.loc.Location.line summ2.Specs.attributes.ProcAttributes.loc.Location.line } @@ -1283,7 +1283,7 @@ let module AnalysisResults = { /** Create an iterator which loads spec files one at a time */ let iterator_of_spec_files () => { - let sorted_spec_files = IList.sort string_compare (spec_files_from_cmdline ()); + let sorted_spec_files = IList.sort Core.Std.String.compare (spec_files_from_cmdline ()); let do_spec f fname => switch (Specs.load_summary (DB.filename_from_string fname)) { | None => diff --git a/infer/src/backend/infer.ml b/infer/src/backend/infer.ml index 6ee2bd3cc..12f87ed81 100644 --- a/infer/src/backend/infer.ml +++ b/infer/src/backend/infer.ml @@ -88,7 +88,7 @@ let clean_results_dir () = let rec cleandir dir = match Unix.readdir dir with | entry -> - if (IList.exists (string_equal entry) dirs) then ( + if (IList.exists (Core.Std.String.equal entry) dirs) then ( rmtree (name // entry) ) else if not (entry = Filename.current_dir_name || entry = Filename.parent_dir_name) then ( diff --git a/infer/src/backend/inferconfig.ml b/infer/src/backend/inferconfig.ml index 195aae383..79d1da077 100644 --- a/infer/src/backend/inferconfig.ml +++ b/infer/src/backend/inferconfig.ml @@ -124,7 +124,7 @@ module FileOrProcMatcher = struct (fun p -> match p.Config.method_name with | None -> true - | Some m -> string_equal m method_name) + | Some m -> Core.Std.String.equal m method_name) class_patterns with Not_found -> false in @@ -221,7 +221,7 @@ let filters_from_inferconfig inferconfig : filters = let error_filter = function error_name -> let error_str = Localise.to_string error_name in - not (IList.exists (string_equal error_str) inferconfig.suppress_errors) in + not (IList.exists (Core.Std.String.equal error_str) inferconfig.suppress_errors) in { path_filter = path_filter; error_filter = error_filter; diff --git a/infer/src/backend/interproc.ml b/infer/src/backend/interproc.ml index d6398cabe..280985521 100644 --- a/infer/src/backend/interproc.ml +++ b/infer/src/backend/interproc.ml @@ -41,10 +41,10 @@ module NodeVisitSet = - 1 | Some d1, Some d2 -> (* shorter distance to exit is better *) - int_compare d1 d2 in + Core.Std.Int.compare d1 d2 in if n <> 0 then n else compare_ids n1 n2 let compare_number_of_visits x1 x2 = - let n = int_compare x1.visits x2.visits in (* visited fewer times is better *) + let n = Core.Std.Int.compare x1.visits x2.visits in (* visited fewer times is better *) if n <> 0 then n else compare_distance_to_exit x1 x2 let compare x1 x2 = if !Config.footprint then @@ -728,7 +728,7 @@ let compute_visited vset = let node_loc = Procdesc.Node.get_loc n in let instrs_loc = IList.map Sil.instr_get_loc (Procdesc.Node.get_instrs n) in let lines = IList.map (fun loc -> loc.Location.line) (node_loc :: instrs_loc) in - IList.remove_duplicates int_compare (IList.sort int_compare lines) in + IList.remove_duplicates Core.Std.Int.compare (IList.sort Core.Std.Int.compare lines) in let do_node n = res := Specs.Visitedset.add (Procdesc.Node.get_id n, node_get_all_lines n) !res in diff --git a/infer/src/backend/paths.ml b/infer/src/backend/paths.ml index f9bb3434f..de39c3a53 100644 --- a/infer/src/backend/paths.ml +++ b/infer/src/backend/paths.ml @@ -490,7 +490,7 @@ end = struct () in iter_shortest_sequence g pos_opt path; let compare lt1 lt2 = - let n = int_compare lt1.Errlog.lt_level lt2.Errlog.lt_level in + let n = Core.Std.Int.compare lt1.Errlog.lt_level lt2.Errlog.lt_level in if n <> 0 then n else Location.compare lt1.Errlog.lt_loc lt2.Errlog.lt_loc in let relevant lt = lt.Errlog.lt_node_tags <> [] in IList.remove_irrelevant_duplicates compare relevant (IList.rev !trace) diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index 1e11bec3c..0e3d40c67 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -1639,8 +1639,7 @@ let get_overrides_of tenv supertype pname = (** Check the equality of two types ignoring flags in the subtyping components *) let texp_equal_modulo_subtype_flag texp1 texp2 = match texp1, texp2 with | Exp.Sizeof (t1, len1, st1), Exp.Sizeof (t2, len2, st2) -> - Typ.equal t1 t2 - && (opt_equal Exp.equal len1 len2) + [%compare.equal: Typ.t * Exp.t option] (t1, len1) (t2, len2) && Subtype.equal_modulo_flag st1 st2 | _ -> Exp.equal texp1 texp2 @@ -2220,7 +2219,7 @@ exception NO_COVER (** Find miminum set of pi's in [cases] whose disjunction covers true *) let find_minimum_pure_cover tenv cases = let cases = - let compare (pi1, _) (pi2, _) = int_compare (IList.length pi1) (IList.length pi2) + let compare (pi1, _) (pi2, _) = Core.Std.Int.compare (IList.length pi1) (IList.length pi2) in IList.sort compare cases in let rec grow seen todo = match todo with | [] -> raise NO_COVER diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index d1a2df363..3cc80269f 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -818,7 +818,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = | _ -> false) (Attribute.get_for_exp tenv prop guarded_by_exp) in let guardedby_is_self_referential = - string_equal "itself" (String.lowercase guarded_by_str) || + Core.Std.String.equal "itself" (String.lowercase guarded_by_str) || string_is_suffix guarded_by_str (Ident.fieldname_to_string accessed_fld) in let proc_has_suppress_guarded_by_annot pdesc = let proc_signature = diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index c944abe85..f6c9ed5c5 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -1335,7 +1335,7 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call let is_not_const (e, _, i) = match AttributesTable.load_attributes callee_pname with | Some attrs -> - let is_const = IList.mem int_equal i attrs.ProcAttributes.const_formals in + let is_const = IList.mem Core.Std.Int.equal i attrs.ProcAttributes.const_formals in if is_const then ( L.d_str (Printf.sprintf "Not havocing const argument number %d: " i); Sil.d_exp e; diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index 92f41b3d5..50208222e 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/infer/src/base/CommandLineOption.ml @@ -384,7 +384,7 @@ let mk_path_list ?(default=[]) ?(deprecated=[]) ~long ?short ?exes ?(meta="path" let mk_symbol ~default ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = let strings = IList.map fst symbols in let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in - let of_string str = IList.assoc string_equal str symbols in + let of_string str = IList.assoc Core.Std.String.equal str symbols in let to_string sym = IList.assoc ( = ) sym sym_to_str in mk ~deprecated ~long ?short ~default ?exes ~meta doc ~default_to_string:(fun s -> to_string s) @@ -394,7 +394,7 @@ let mk_symbol ~default ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") d let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = let strings = IList.map fst symbols in - let of_string str = IList.assoc string_equal str symbols in + let of_string str = IList.assoc Core.Std.String.equal str symbols in mk ~deprecated ~long ?short ~default:None ?exes ~meta doc ~default_to_string:(fun _ -> "") ~mk_setter:(fun var str -> var := Some (of_string str)) @@ -403,7 +403,7 @@ let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = let mk_symbol_seq ?(default=[]) ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in - let of_string str = IList.assoc string_equal str symbols in + let of_string str = IList.assoc Core.Std.String.equal str symbols in let to_string sym = IList.assoc ( = ) sym sym_to_str in mk ~deprecated ~long ?short ~default ?exes ~meta:(",-separated sequence" ^ meta) doc ~default_to_string:(fun syms -> String.concat " " (IList.map to_string syms)) @@ -453,7 +453,8 @@ let decode_inferconfig_to_argv current_exe path = let {decode_json} = IList.find (fun {long; short} -> - string_equal key long || (* for deprecated options *) string_equal key short) + Core.Std.String.equal key long + || (* for deprecated options *) Core.Std.String.equal key short) desc_list in decode_json json_val @ result with @@ -568,7 +569,7 @@ let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe e let is_not_dup_with_doc speclist (opt, _, doc) = opt = "" || IList.for_all (fun (opt', _, doc') -> - (doc <> "" && doc' = "") || (not (string_equal opt opt'))) speclist in + (doc <> "" && doc' = "") || (not (Core.Std.String.equal opt opt'))) speclist in let unique_exe_speclist = IList.filter (is_not_dup_with_doc !curr_speclist) exe_speclist in curr_speclist := IList.filter (is_not_dup_with_doc unique_exe_speclist) !curr_speclist @ (match header with diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index 0414350f7..78bcffe12 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -240,7 +240,7 @@ let real_exe_name = let current_exe = if !Sys.interactive then CLOpt.Interactive - else try IList.assoc string_equal (Filename.basename real_exe_name) CLOpt.exes + else try IList.assoc Core.Std.String.equal (Filename.basename real_exe_name) CLOpt.exes with Not_found -> CLOpt.Toplevel let bin_dir = @@ -319,8 +319,8 @@ let patterns_of_json_with_key json_key json = let detect_pattern assoc = match detect_language assoc with | Ok language -> - let is_method_pattern key = IList.exists (string_equal key) ["class"; "method"] - and is_source_contains key = IList.exists (string_equal key) ["source_contains"] in + let is_method_pattern key = IList.exists (Core.Std.String.equal key) ["class"; "method"] + and is_source_contains key = IList.exists (Core.Std.String.equal key) ["source_contains"] in let rec loop = function | [] -> Error ("Unknown pattern for " ^ json_key ^ " in " ^ inferconfig_file) diff --git a/infer/src/base/DB.ml b/infer/src/base/DB.ml index 4aa0ad291..3c7b33a6e 100644 --- a/infer/src/base/DB.ml +++ b/infer/src/base/DB.ml @@ -144,7 +144,7 @@ let source_file_of_header header_file = let header_file_exts = ["h"; "hh"; "hpp"; "hxx"] in let file_no_ext, ext_opt = Core.Std.Filename.split_extension abs_path in let file_opt = match ext_opt with - | Some ext when IList.mem string_equal ext header_file_exts -> ( + | Some ext when IList.mem Core.Std.String.equal ext header_file_exts -> ( let possible_files = IList.map (fun ext -> file_no_ext ^ "." ^ ext) source_file_exts in try Some (IList.find source_file_path_exists possible_files) with Not_found -> None diff --git a/infer/src/base/Utils.ml b/infer/src/base/Utils.ml index d2f4364ec..35bf3d8e3 100644 --- a/infer/src/base/Utils.ml +++ b/infer/src/base/Utils.ml @@ -31,89 +31,19 @@ let initial_timeofday = Unix.gettimeofday () (** Compare police: generic compare disabled. *) let compare = () -let string_equal (s1: string) (s2: string) = s1 = s2 - -let string_compare (s1: string) (s2: string) = Pervasives.compare s1 s2 - -let float_compare (f1: float) (f2: float) = Pervasives.compare f1 f2 - -let bool_compare (b1: bool) (b2: bool) = Pervasives.compare b1 b2 - -let bool_equal (b1: bool) (b2: bool) = b1 = b2 - -(** Extend and equality function to an option type. *) -let opt_equal cmp x1 x2 = match x1, x2 with - | None, None -> true - | Some _, None -> false - | None, Some _ -> false - | Some y1, Some y2 -> cmp y1 y2 - -let opt_compare cmp x1 x2 = - match x1, x2 with - | Some y1, Some y2 -> cmp y1 y2 - | None, None -> 0 - | None, _ -> -1 - | _, None -> 1 - -(** Efficient comparison for integers *) -let int_compare (i: int) (j: int) = (Obj.magic (i > j)) - (Obj.magic (i < j)) - -let int_equal (i: int) (j: int) = i = j - -(** Generic comparison of pairs given a compare function for each element of the pair. *) -let pair_compare compare compare' (x1, y1) (x2, y2) = - let n = compare x1 x2 in - if n <> 0 then n else compare' y1 y2 - -(** Generic comparison of triples given a compare function for each element of the triple *) -let triple_compare compare compare' compare'' (x1, y1, z1) (x2, y2, z2) = - let n = compare x1 x2 in - if n <> 0 then n else let n = compare' y1 y2 in - if n <> 0 then n else compare'' z1 z2 - -(** Generic equality of triples given an equal function for each element of the triple *) -let triple_equal x_equal y_equal z_equal (x1, y1, z1) (x2, y2, z2) = - x_equal x1 x2 && y_equal y1 y2 && z_equal z1 z2 - let fst3 (x,_,_) = x let snd3 (_,x,_) = x let trd3 (_,_,x) = x let int_of_bool b = if b then 1 else 0 -let tags_compare (x : 'a) (y : 'a) = - let x = Obj.repr x - and y = Obj.repr y in - if Obj.is_int x - then - if Obj.is_int y - (* we can use (-) because tags are small and won't overflow *) - then Obj.obj x - Obj.obj y - else -1 - else if Obj.is_int y - then 1 - else - let r = Obj.tag x - Obj.tag y in - if r = 0 - then failwith "Comparing parameterized constructors" - else r - (** {2 Useful Modules} *) (** Set of integers *) -module IntSet = - Set.Make(struct - type t = int - let compare = int_compare - end) +module IntSet = Set.Make(Core.Std.Int) (** Hash table over strings *) -module StringHash = Hashtbl.Make ( - struct - type t = string - let equal (s1: string) (s2: string) = s1 = s2 - let hash = Hashtbl.hash - end) +module StringHash = Hashtbl.Make (Core.Std.String) (** Set of strings *) module StringSet = Set.Make(String) @@ -133,21 +63,15 @@ let string_list_intersection a b = StringSet.inter (string_set_of_list a) (string_set_of_list b) module StringPPSet = PrettyPrintable.MakePPSet(struct - type t = string - let compare = string_compare + include Core.Std.String let pp_element fmt s = F.fprintf fmt "%s" s end) (** Maps from integers *) -module IntMap = Map.Make (struct - type t = int - let compare = int_compare - end) +module IntMap = Map.Make (Core.Std.Int) (** Maps from strings *) -module StringMap = Map.Make (struct - type t = string - let compare (s1: string) (s2: string) = Pervasives.compare s1 s2 end) +module StringMap = Map.Make (Core.Std.String) (** {2 Printing} *) @@ -537,11 +461,6 @@ let join_strings sep = function | hd:: tl -> IList.fold_left (fun str p -> str ^ sep ^ p) hd tl -let next compare = - fun x y n -> - if n <> 0 then n - else compare x y - let directory_fold f init path = let collect current_dir (accu, dirs) path = diff --git a/infer/src/base/Utils.mli b/infer/src/base/Utils.mli index ab1a59a35..e196e0d4d 100644 --- a/infer/src/base/Utils.mli +++ b/infer/src/base/Utils.mli @@ -29,50 +29,6 @@ val initial_timeofday : float (** Compare police: generic compare disabled. *) val compare : unit -(** Comparison for booleans *) -val bool_compare : bool -> bool -> int - -(** Equality for booleans *) -val bool_equal : bool -> bool -> bool - -(** Efficient comparison for integers *) -val int_compare : int -> int -> int - -(** Equality for integers *) -val int_equal : int -> int -> bool - -(** Extend and equality function to an option type. *) -val opt_equal : ('a -> 'a -> bool) -> 'a option -> 'a option -> bool - -(** Comparison of option type. *) -val opt_compare : ('a -> 'a -> int) -> 'a option -> 'a option -> int - -(** Generic comparison of pairs given a compare function for each element of the pair. *) -val pair_compare : ('a -> 'b -> int) -> ('c -> 'd -> int) -> ('a * 'c) -> ('b * 'd) -> int - -(** Generic comparison of triples given a compare function for each element of the triple. *) -val triple_compare : - ('a -> 'b -> int) -> ('c -> 'd -> int) -> ('e -> 'f -> int) -> - ('a * 'c * 'e) -> ('b * 'd * 'f) -> int - -(** Generic equality of triples given an equal function for each element of the triple. *) -val triple_equal : - ('a -> 'b -> bool) -> ('c -> 'd -> bool) -> ('e -> 'f -> bool) -> - ('a * 'c * 'e) -> ('b * 'd * 'f) -> bool - -(** Comparison for strings *) -val string_compare : string -> string -> int - -(** Equality for strings *) -val string_equal : string -> string -> bool - -(** Comparison for floats *) -val float_compare : float -> float -> int - -(** Use this function to compare sum types (ONLY!) in the default case of your custom compare - function. It will fail if you try to check equality of parameterized constructors *) -val tags_compare: 'a -> 'a -> int - (** Return the first component of a triple. *) val fst3 : 'a * 'b * 'c -> 'a @@ -264,14 +220,6 @@ val proc_flags_find : proc_flags -> string -> string (** [join_strings sep parts] contatenates the elements of [parts] using [sep] as separator *) val join_strings : string -> string list -> string -(** [next compare] transforms the comparison function [compare] to another function taking - the outcome of another comparison as last parameter and only performs this comparison if this value - is different from 0. Useful to combine comparison functions using the operator |>. The outcome of - the expression [Int.compare x y |> next Set.compare s t] is: [Int.compare x y] if this value is - not [0], skipping the evaluation of [Set.compare s t] in such case; or [Set.compare s t] in case - [Int.compare x y] is [0] *) -val next : ('a -> 'a -> int) -> ('a -> 'a -> int -> int) - (** Functional fold function over all the file of a directory *) val directory_fold : ('a -> string -> 'a) -> 'a -> string -> 'a diff --git a/infer/src/base/Version.ml.in b/infer/src/base/Version.ml.in index cd5b1ac3c..50a77ecc8 100644 --- a/infer/src/base/Version.ml.in +++ b/infer/src/base/Version.ml.in @@ -16,7 +16,7 @@ let patch = @INFER_PATCH@ let commit = "@INFER_GIT_COMMIT@" let branch = "@INFER_GIT_BRANCH@" -let is_release = string_equal "@IS_RELEASE_TREE@" "yes" +let is_release = Core.Std.String.equal "@IS_RELEASE_TREE@" "yes" let tag = Printf.sprintf "v%d.%d.%d" major minor patch let versionString = diff --git a/infer/src/checkers/BoundedCallTree.ml b/infer/src/checkers/BoundedCallTree.ml index 708812148..fe2e0c100 100644 --- a/infer/src/checkers/BoundedCallTree.ml +++ b/infer/src/checkers/BoundedCallTree.ml @@ -116,11 +116,11 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let matches_proc frame = let matches_class pname = match pname with | Procname.Java java_proc -> - string_equal + Core.Std.String.equal frame.Stacktrace.class_str (Procname.java_get_class_name java_proc) | Procname.ObjC_Cpp objc_cpp_prod -> - string_equal + Core.Std.String.equal frame.Stacktrace.class_str (Procname.objc_cpp_get_class_name objc_cpp_prod) | Procname.C _ -> true (* Needed for test code. *) diff --git a/infer/src/checkers/Siof.ml b/infer/src/checkers/Siof.ml index 6a9fb6a2b..c0014cc1d 100644 --- a/infer/src/checkers/Siof.ml +++ b/infer/src/checkers/Siof.ml @@ -94,7 +94,7 @@ let is_foreign tu_opt v = let is_orig_file f = match tu_opt with | Some orig_file -> let orig_path = DB.source_file_to_abs_path orig_file in - string_equal orig_path (DB.source_file_to_abs_path f) + Core.Std.String.equal orig_path (DB.source_file_to_abs_path f) | None -> assert false in Option.map_default (fun f -> not (is_orig_file f)) false (Pvar.get_source_file v) diff --git a/infer/src/checkers/Stacktrace.ml b/infer/src/checkers/Stacktrace.ml index 4caf82e56..092a4f75a 100644 --- a/infer/src/checkers/Stacktrace.ml +++ b/infer/src/checkers/Stacktrace.ml @@ -60,7 +60,7 @@ let parse_stack_frame frame_str = let class_str = Str.matched_group 1 qualified_procname in let method_str = Str.matched_group 2 qualified_procname in (* Native methods don't have debugging info *) - if string_equal file_and_line "Native Method" then + if Core.Std.String.equal file_and_line "Native Method" then make_frame class_str method_str "Native Method" None else begin (* Separate the filename and line number. diff --git a/infer/src/checkers/annotations.ml b/infer/src/checkers/annotations.ml index d77a1069d..f8b015813 100644 --- a/infer/src/checkers/annotations.ml +++ b/infer/src/checkers/annotations.ml @@ -75,7 +75,7 @@ let ia_get ia ann_name = let ma_contains ma ann_names = let found = ref false in ma_iter (fun a -> - if IList.exists (string_equal a.Annot.class_name) ann_names then found := true + if IList.exists (Core.Std.String.equal a.Annot.class_name) ann_names then found := true ) ma; !found diff --git a/infer/src/checkers/checkTraceCallSequence.ml b/infer/src/checkers/checkTraceCallSequence.ml index 95684bd19..ba7a15477 100644 --- a/infer/src/checkers/checkTraceCallSequence.ml +++ b/infer/src/checkers/checkTraceCallSequence.ml @@ -152,7 +152,7 @@ module State = struct let elem' = Elem.set_env elem env' in [elem'] | Some b' -> - if bool_equal b b' then [elem] + if Core.Std.Bool.equal b b' then [elem] else [] in map2 f s @@ -230,7 +230,7 @@ module BooleanVars = struct let exp_boolean_var exp = match exp with | Exp.Lvar pvar when Pvar.is_local pvar -> let name = Mangled.to_string (Pvar.get_name pvar) in - if IList.mem string_equal name boolean_variables + if IList.mem Core.Std.String.equal name boolean_variables then Some name else None | _ -> None diff --git a/infer/src/checkers/checkers.ml b/infer/src/checkers/checkers.ml index 2fdaebf4d..02a481777 100644 --- a/infer/src/checkers/checkers.ml +++ b/infer/src/checkers/checkers.ml @@ -95,10 +95,10 @@ module ST = struct let drop_prefix str = Str.replace_first (Str.regexp "^[A-Za-z]+_") "" str in let normalized_equal s1 s2 = - string_equal (normalize s1) (normalize s2) in + Core.Std.String.equal (normalize s1) (normalize s2) in let is_parameter_suppressed = - IList.mem string_equal a.class_name [Annotations.suppressLint] && + IList.mem Core.Std.String.equal a.class_name [Annotations.suppressLint] && IList.mem normalized_equal kind a.parameters in let is_annotation_suppressed = string_is_suffix (normalize (drop_prefix kind)) (normalize a.class_name) in diff --git a/infer/src/checkers/constantPropagation.ml b/infer/src/checkers/constantPropagation.ml index 864119a46..4b1c88668 100644 --- a/infer/src/checkers/constantPropagation.ml +++ b/infer/src/checkers/constantPropagation.ml @@ -27,7 +27,9 @@ module ConstantMap = Exp.Map (** Dataflow struct *) module ConstantFlow = Dataflow.MakeDF(struct - type t = (Const.t option) ConstantMap.t + type t = (Const.t option) ConstantMap.t [@@deriving compare] + + let equal m n = compare m n = 0 let pp fmt constants = let pp_key fmt = Exp.pp fmt in @@ -38,11 +40,6 @@ module ConstantFlow = Dataflow.MakeDF(struct ConstantMap.iter print_kv constants; Format.fprintf fmt "]@." - (* Item - wise equality where values are equal iff - - both are None - - both are a constant and equal wrt. Const.equal *) - let equal m n = ConstantMap.equal (opt_equal Const.equal) m n - let join = ConstantMap.merge merge_values let proc_throws _ = Dataflow.DontKnow diff --git a/infer/src/checkers/dataflow.ml b/infer/src/checkers/dataflow.ml index 169875589..0ac05ee6f 100644 --- a/infer/src/checkers/dataflow.ml +++ b/infer/src/checkers/dataflow.ml @@ -175,7 +175,7 @@ let callback_test_dataflow { Callbacks.proc_desc; tenv } = let verbose = false in let module DFCount = MakeDF(struct type t = int - let equal = int_equal + let equal = Core.Std.Int.equal let join n m = if n = 0 then m else n let do_node _ n s = if verbose then L.stdout "visiting node %a with state %d@." Procdesc.Node.pp n s; diff --git a/infer/src/checkers/immutableChecker.ml b/infer/src/checkers/immutableChecker.ml index dbeef49ec..38630f37b 100644 --- a/infer/src/checkers/immutableChecker.ml +++ b/infer/src/checkers/immutableChecker.ml @@ -25,7 +25,8 @@ let check_immutable_cast tenv curr_pname curr_pdesc typ_expected typ_found_opt l ] in let in_casts expected given = IList.exists (fun (x, y) -> - string_equal (Typename.name expected) x && string_equal (Typename.name given) y + Core.Std.String.equal (Typename.name expected) x + && Core.Std.String.equal (Typename.name given) y ) casts in match PatternMatch.type_get_class_name typ_expected, PatternMatch.type_get_class_name typ_found with diff --git a/infer/src/checkers/patternMatch.ml b/infer/src/checkers/patternMatch.ml index 6f11d664c..60c32994d 100644 --- a/infer/src/checkers/patternMatch.ml +++ b/infer/src/checkers/patternMatch.ml @@ -273,7 +273,7 @@ let method_is_initializer match proc_attributes.ProcAttributes.proc_name with | Procname.Java pname_java -> let mname = Procname.java_get_method pname_java in - IList.exists (string_equal mname) initializer_methods + IList.exists (Core.Std.String.equal mname) initializer_methods | _ -> false else diff --git a/infer/src/checkers/printfArgs.ml b/infer/src/checkers/printfArgs.ml index 3853699e6..581f0153f 100644 --- a/infer/src/checkers/printfArgs.ml +++ b/infer/src/checkers/printfArgs.ml @@ -49,7 +49,7 @@ let printf_like_function try Some ( IList.find - (fun printf -> string_equal printf.unique_id (Procname.to_unique_id proc_name)) + (fun printf -> Core.Std.String.equal printf.unique_id (Procname.to_unique_id proc_name)) !printf_like_functions) with Not_found -> None @@ -70,15 +70,15 @@ let format_type_matches_given_type match format_type with | "d" | "i" | "u" | "x" | "X" | "o" -> IList.mem - string_equal + Core.Std.String.equal given_type ["java.lang.Integer"; "java.lang.Long"; "java.lang.Short"; "java.lang.Byte"] | "a" | "A" | "f" | "F" | "g" | "G" | "e" | "E" -> IList.mem - string_equal + Core.Std.String.equal given_type ["java.lang.Double"; "java.lang.Float"] - | "c" -> string_equal given_type "java.lang.Character" + | "c" -> Core.Std.String.equal given_type "java.lang.Character" | "b" | "h" | "H" | "s" -> true (* accepts pretty much anything, even null *) | _ -> false diff --git a/infer/src/checkers/repeatedCallsChecker.ml b/infer/src/checkers/repeatedCallsChecker.ml index f1dcc7da4..f30d7d643 100644 --- a/infer/src/checkers/repeatedCallsChecker.ml +++ b/infer/src/checkers/repeatedCallsChecker.ml @@ -76,8 +76,8 @@ struct !found in let module DFAllocCheck = Dataflow.MakeDF(struct - type t = Location.t option - let equal = opt_equal Location.equal + type t = Location.t option [@@deriving compare] + let equal x y = compare x y = 0 let _join _paths l1o l2o = (* join with left priority *) match l1o, l2o with | None, None -> diff --git a/infer/src/clang/CType.ml b/infer/src/clang/CType.ml index 8231d3de6..7593610a6 100644 --- a/infer/src/clang/CType.ml +++ b/infer/src/clang/CType.ml @@ -38,7 +38,7 @@ let mk_structname n = Typename.TN_csu (Csu.Struct, Mangled.from_string n) let is_class typ = match typ with | Typ.Tptr (Tstruct ((TN_csu _) as name), _) -> - string_equal (Typename.name name) CFrontend_config.objc_class + Core.Std.String.equal (Typename.name name) CFrontend_config.objc_class | _ -> false let rec return_type_of_function_type_ptr type_ptr = diff --git a/infer/src/clang/ClangCommand.re b/infer/src/clang/ClangCommand.re index 20a8764c6..830c88296 100644 --- a/infer/src/clang/ClangCommand.re +++ b/infer/src/clang/ClangCommand.re @@ -37,7 +37,7 @@ let value_of_argv_option argv opt_name => let result' = if (Option.is_some result) { result - } else if (string_equal opt_name prev_arg) { + } else if (Core.Std.String.equal opt_name prev_arg) { Some arg } else { None @@ -50,7 +50,7 @@ let value_of_argv_option argv opt_name => let value_of_option {orig_argv} => value_of_argv_option orig_argv; -let has_flag {orig_argv} flag => IList.exists (string_equal flag) orig_argv; +let has_flag {orig_argv} flag => IList.exists (Core.Std.String.equal flag) orig_argv; let can_attach_ast_exporter cmd => has_flag cmd "-cc1" && ( @@ -84,14 +84,14 @@ let clang_cc1_cmd_sanitizer cmd => { /* command line options not supported by the opensource compiler or the plugins */ let flags_blacklist = ["-fembed-bitcode-marker", "-fno-canonical-system-headers"]; let replace_option_arg option arg => - if (string_equal option "-arch" && string_equal arg "armv7k") { + if (Core.Std.String.equal option "-arch" && Core.Std.String.equal arg "armv7k") { "armv7" /* replace armv7k arch with armv7 */ } else if ( - string_equal option "-isystem" + Core.Std.String.equal option "-isystem" ) { switch Config.clang_include_to_override { - | Some to_replace when string_equal arg to_replace => + | Some to_replace when Core.Std.String.equal arg to_replace => fcp_dir /\/ "clang" /\/ "install" /\/ "lib" /\/ "clang" /\/ "4.0.0" /\/ "include" | _ => arg } @@ -110,7 +110,7 @@ let clang_cc1_cmd_sanitizer cmd => { | [] => /* return non-reversed list */ IList.rev (post_args_rev @ res_rev) - | [flag, ...tl] when IList.mem string_equal flag flags_blacklist => + | [flag, ...tl] when IList.mem Core.Std.String.equal flag flags_blacklist => filter_unsupported_args_and_swap_includes (flag, res_rev) tl | [arg, ...tl] => { let res_rev' = [replace_option_arg prev arg, ...res_rev]; diff --git a/infer/src/clang/ComponentKit.ml b/infer/src/clang/ComponentKit.ml index 38c13afa3..5cf2241ca 100644 --- a/infer/src/clang/ComponentKit.ml +++ b/infer/src/clang/ComponentKit.ml @@ -99,9 +99,9 @@ let mutable_local_vars_advice context an = let objc_whitelist = ["NSError"] in match get_referenced_type qual_type with | Some CXXRecordDecl (_, ndi, _, _, _, _, _, _) -> - IList.mem string_equal ndi.ni_name cpp_whitelist + IList.mem Core.Std.String.equal ndi.ni_name cpp_whitelist | Some ObjCInterfaceDecl (_, ndi, _, _, _) -> - IList.mem string_equal ndi.ni_name objc_whitelist + IList.mem Core.Std.String.equal ndi.ni_name objc_whitelist | _ -> false in match an with @@ -170,7 +170,7 @@ let component_with_unconventional_superclass_advice context an = let has_conventional_superclass = let open CFrontend_config in match superclass_name with - | Some name when IList.mem string_equal name [ + | Some name when IList.mem Core.Std.String.equal name [ ckcomponent_cl; ckcomponentcontroller_cl; "CKCompositeComponent"; diff --git a/infer/src/clang/cFrontend_utils.ml b/infer/src/clang/cFrontend_utils.ml index f6d4876fe..b0230dc0e 100644 --- a/infer/src/clang/cFrontend_utils.ml +++ b/infer/src/clang/cFrontend_utils.ml @@ -418,7 +418,8 @@ struct else match if_decl with | Some Clang_ast_t.ObjCInterfaceDecl (_, ndi, _, _, _) -> - let in_list some_list = IList.mem string_equal ndi.Clang_ast_t.ni_name some_list in + let in_list some_list = + IList.mem Core.Std.String.equal ndi.Clang_ast_t.ni_name some_list in not (in_list blacklist) && (in_list ancestors || is_objc_if_descendant ~blacklist:blacklist (get_super_if if_decl) ancestors) diff --git a/infer/src/clang/cTL.ml b/infer/src/clang/cTL.ml index bec54349a..ae944fd44 100644 --- a/infer/src/clang/cTL.ml +++ b/infer/src/clang/cTL.ml @@ -288,7 +288,7 @@ let node_to_unique_string_id an = (* true iff an ast node is a node of type among the list tl *) let node_has_type tl an = let an_str = node_to_string an in - IList.mem (string_equal) an_str tl + IList.mem Core.Std.String.equal an_str tl (* given a decl returns a stmt such that decl--->stmt via label trs *) let transition_decl_to_stmt d trs = @@ -467,7 +467,7 @@ and in_node node_type_list phi an lctx = let holds_for_one_node n = match lctx.CLintersContext.et_evaluation_node with | Some id -> - (string_equal id (node_to_unique_string_id an)) && (eval_formula phi an lctx) + (Core.Std.String.equal id (node_to_unique_string_id an)) && (eval_formula phi an lctx) | None -> (node_has_type [n] an) && (eval_formula phi an lctx) in IList.exists holds_for_one_node node_type_list diff --git a/infer/src/clang/cTrans_models.ml b/infer/src/clang/cTrans_models.ml index 73171e40e..2c73ff109 100644 --- a/infer/src/clang/cTrans_models.ml +++ b/infer/src/clang/cTrans_models.ml @@ -67,7 +67,7 @@ let is_modeled_builtin funct = funct = CFrontend_config.builtin_memset_chk let is_modeled_attribute attr_name = - IList.mem string_equal attr_name CFrontend_config.modeled_function_attributes + IList.mem Core.Std.String.equal attr_name CFrontend_config.modeled_function_attributes let get_first_param_typedef_string_opt type_ptr = match Ast_utils.get_desugared_type type_ptr with diff --git a/infer/src/eradicate/eradicate.ml b/infer/src/eradicate/eradicate.ml index 51cd50e6c..c28191952 100644 --- a/infer/src/eradicate/eradicate.ml +++ b/infer/src/eradicate/eradicate.ml @@ -88,7 +88,7 @@ struct | Some (typ_found, _, _) -> Some typ_found | None -> None in let ret_implicitly_nullable = - string_equal (PatternMatch.get_type_name ret_type) "java.lang.Void" in + Core.Std.String.equal (PatternMatch.get_type_name ret_type) "java.lang.Void" in State.set_node exit_node; if checks.TypeCheck.check_ret_type <> [] then diff --git a/infer/src/eradicate/eradicateChecks.ml b/infer/src/eradicate/eradicateChecks.ml index 342279e13..782d716de 100644 --- a/infer/src/eradicate/eradicateChecks.ml +++ b/infer/src/eradicate/eradicateChecks.ml @@ -116,7 +116,7 @@ let check_condition tenv case_zero find_canonical_duplicate curr_pdesc let throwable_found = ref false in let typ_is_throwable = function | Typ.Tstruct (TN_csu (Class Java, _) as name) -> - string_equal (Typename.name name) "java.lang.Throwable" + Core.Std.String.equal (Typename.name name) "java.lang.Throwable" | _ -> false in let do_instr = function | Sil.Call (_, Exp.Const (Const.Cfun pn), [_; (Exp.Sizeof(t, _, _), _)], _, _) when @@ -273,7 +273,7 @@ let check_constructor_initialization tenv let should_check_field_initialization = let in_current_class = let fld_cname = Ident.java_fieldname_get_class fn in - string_equal (Typename.name name) fld_cname in + Core.Std.String.equal (Typename.name name) fld_cname in not injector_readonly_annotated && PatternMatch.type_is_class ft && in_current_class && diff --git a/infer/src/harness/androidFramework.ml b/infer/src/harness/androidFramework.ml index f84908097..4b2ed9f69 100644 --- a/infer/src/harness/androidFramework.ml +++ b/infer/src/harness/androidFramework.ml @@ -22,7 +22,8 @@ let is_destroy_method pname = match pname with | Procname.Java pname_java -> let method_name = Procname.java_get_method pname_java in - string_equal method_name on_destroy || string_equal method_name on_destroy_view + Core.Std.String.equal method_name on_destroy + || Core.Std.String.equal method_name on_destroy_view | _ -> false diff --git a/infer/src/integration/CaptureCompilationDatabase.ml b/infer/src/integration/CaptureCompilationDatabase.ml index a82d49179..a6d739d40 100644 --- a/infer/src/integration/CaptureCompilationDatabase.ml +++ b/infer/src/integration/CaptureCompilationDatabase.ml @@ -82,7 +82,7 @@ let run_compilation_file compilation_database file = let found = ref false in Array.iteri (fun i key_val -> match string_split_character key_val '=' with - | Some var, args when string_equal var CLOpt.args_env_var -> + | Some var, args when Core.Std.String.equal var CLOpt.args_env_var -> found := true ; env0.(i) <- F.sprintf "%s=%s%c--fcp-syntax-only" CLOpt.args_env_var args CLOpt.env_var_sep diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 23cd586cb..745bb1c11 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -344,7 +344,7 @@ let get_class_type program tenv cn = (** return true if [field_name] is the autogenerated C.$assertionsDisabled field for class C *) let is_autogenerated_assert_field field_name = - string_equal (Ident.java_fieldname_get_field field_name) "$assertionsDisabled" + Core.Std.String.equal (Ident.java_fieldname_get_field field_name) "$assertionsDisabled" let is_closeable program tenv typ = let closeable_cn = JBasics.make_cn "java.io.Closeable" in diff --git a/infer/src/unit/schedulerTests.ml b/infer/src/unit/schedulerTests.ml index 988b97d4f..29d886f05 100644 --- a/infer/src/unit/schedulerTests.ml +++ b/infer/src/unit/schedulerTests.ml @@ -25,7 +25,7 @@ module MockNode = struct let loc _ = assert false let underlying_id _ = assert false let kind _ = Procdesc.Node.Stmt_node "" - let compare_id = int_compare + let compare_id = Core.Std.Int.compare let pp_id fmt i = F.fprintf fmt "%i" i end @@ -35,7 +35,7 @@ module MockProcCfg = struct include (MockNode : module type of MockNode with type t := node) type t = (node * node list) list - let compare_id = int_compare + let compare_id = Core.Std.Int.compare let succs t n = try