Remove Utils compare and equal functions

Reviewed By: cristianoc

Differential Revision: D4232423

fbshipit-source-id: 174e896
master
Josh Berdine 8 years ago committed by Facebook Github Bot
parent 83408d4d6a
commit 198bc00df7

@ -201,8 +201,8 @@ struct
| Core_graphics -> core_graphics_types | Core_graphics -> core_graphics_types
let is_objc_memory_model_controlled o = let is_objc_memory_model_controlled o =
IList.mem (string_equal) o core_foundation_types || IList.mem Core.Std.String.equal o core_foundation_types ||
IList.mem (string_equal) o core_graphics_types IList.mem Core.Std.String.equal o core_graphics_types
let rec is_core_lib lib typ = let rec is_core_lib lib typ =
match typ with match typ with
@ -210,7 +210,7 @@ struct
is_core_lib lib styp is_core_lib lib styp
| Typ.Tstruct name -> | Typ.Tstruct name ->
let core_lib_types = core_lib_to_type_list lib in 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 | _ -> false
let is_core_foundation_type typ = let is_core_foundation_type typ =

@ -63,7 +63,7 @@ let module Node = {
preds: [], preds: [],
exn: [] 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 hash node => Hashtbl.hash node.id;
let equal node1 node2 => compare node1 node2 == 0; let equal node1 node2 => compare node1 node2 == 0;
@ -71,7 +71,7 @@ let module Node = {
let get_id node => node.id; let get_id node => node.id;
/** compare node ids */ /** compare node ids */
let compare_id = int_compare; let compare_id = Core.Std.Int.compare;
let get_succs node => node.succs; let get_succs node => node.succs;
type node = t; type node = t;
let module NodeSet = Set.Make { let module NodeSet = Set.Make {

@ -2019,7 +2019,7 @@ let rec exp_compare_structural e1 e2 exp_map => {
if (n != 0) { if (n != 0) {
n n
} else { } else {
opt_compare Typ.compare to1 to2 [%compare : option Typ.t] to1 to2
}, },
exp_map exp_map
) )
@ -2159,7 +2159,7 @@ let compare_structural_instr instr1 instr2 exp_map => {
if (n != 0) { if (n != 0) {
n n
} else { } else {
let n = bool_compare true_branch1 true_branch2; let n = Core.Std.Bool.compare true_branch1 true_branch2;
if (n != 0) { if (n != 0) {
n n
} else { } else {

@ -345,7 +345,7 @@ let should_report (issue_kind: Exceptions.err_kind) issue_type error_desc =>
let eq o y => let eq o y =>
switch (o, y) { switch (o, y) {
| (None, _) => false | (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 IList.mem eq issue_bucket high_buckets
}; };
@ -1273,7 +1273,7 @@ let module AnalysisResults = {
if (n != 0) { if (n != 0) {
n n
} else { } else {
int_compare Core.Std.Int.compare
summ1.Specs.attributes.ProcAttributes.loc.Location.line summ1.Specs.attributes.ProcAttributes.loc.Location.line
summ2.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 */ /** Create an iterator which loads spec files one at a time */
let iterator_of_spec_files () => { 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 => let do_spec f fname =>
switch (Specs.load_summary (DB.filename_from_string fname)) { switch (Specs.load_summary (DB.filename_from_string fname)) {
| None => | None =>

@ -88,7 +88,7 @@ let clean_results_dir () =
let rec cleandir dir = let rec cleandir dir =
match Unix.readdir dir with match Unix.readdir dir with
| entry -> | entry ->
if (IList.exists (string_equal entry) dirs) then ( if (IList.exists (Core.Std.String.equal entry) dirs) then (
rmtree (name // entry) rmtree (name // entry)
) else if not (entry = Filename.current_dir_name ) else if not (entry = Filename.current_dir_name
|| entry = Filename.parent_dir_name) then ( || entry = Filename.parent_dir_name) then (

@ -124,7 +124,7 @@ module FileOrProcMatcher = struct
(fun p -> (fun p ->
match p.Config.method_name with match p.Config.method_name with
| None -> true | None -> true
| Some m -> string_equal m method_name) | Some m -> Core.Std.String.equal m method_name)
class_patterns class_patterns
with Not_found -> false in with Not_found -> false in
@ -221,7 +221,7 @@ let filters_from_inferconfig inferconfig : filters =
let error_filter = let error_filter =
function error_name -> function error_name ->
let error_str = Localise.to_string error_name in 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; path_filter = path_filter;
error_filter = error_filter; error_filter = error_filter;

@ -41,10 +41,10 @@ module NodeVisitSet =
- 1 - 1
| Some d1, Some d2 -> | Some d1, Some d2 ->
(* shorter distance to exit is better *) (* 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 if n <> 0 then n else compare_ids n1 n2
let compare_number_of_visits x1 x2 = 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 if n <> 0 then n else compare_distance_to_exit x1 x2
let compare x1 x2 = let compare x1 x2 =
if !Config.footprint then if !Config.footprint then
@ -728,7 +728,7 @@ let compute_visited vset =
let node_loc = Procdesc.Node.get_loc n in 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 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 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 = let do_node n =
res := res :=
Specs.Visitedset.add (Procdesc.Node.get_id n, node_get_all_lines n) !res in Specs.Visitedset.add (Procdesc.Node.get_id n, node_get_all_lines n) !res in

@ -490,7 +490,7 @@ end = struct
() in () in
iter_shortest_sequence g pos_opt path; iter_shortest_sequence g pos_opt path;
let compare lt1 lt2 = 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 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 let relevant lt = lt.Errlog.lt_node_tags <> [] in
IList.remove_irrelevant_duplicates compare relevant (IList.rev !trace) IList.remove_irrelevant_duplicates compare relevant (IList.rev !trace)

@ -1639,8 +1639,7 @@ let get_overrides_of tenv supertype pname =
(** Check the equality of two types ignoring flags in the subtyping components *) (** Check the equality of two types ignoring flags in the subtyping components *)
let texp_equal_modulo_subtype_flag texp1 texp2 = match texp1, texp2 with let texp_equal_modulo_subtype_flag texp1 texp2 = match texp1, texp2 with
| Exp.Sizeof (t1, len1, st1), Exp.Sizeof (t2, len2, st2) -> | Exp.Sizeof (t1, len1, st1), Exp.Sizeof (t2, len2, st2) ->
Typ.equal t1 t2 [%compare.equal: Typ.t * Exp.t option] (t1, len1) (t2, len2)
&& (opt_equal Exp.equal len1 len2)
&& Subtype.equal_modulo_flag st1 st2 && Subtype.equal_modulo_flag st1 st2
| _ -> Exp.equal texp1 texp2 | _ -> Exp.equal texp1 texp2
@ -2220,7 +2219,7 @@ exception NO_COVER
(** Find miminum set of pi's in [cases] whose disjunction covers true *) (** Find miminum set of pi's in [cases] whose disjunction covers true *)
let find_minimum_pure_cover tenv cases = let find_minimum_pure_cover tenv cases =
let 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 in IList.sort compare cases in
let rec grow seen todo = match todo with let rec grow seen todo = match todo with
| [] -> raise NO_COVER | [] -> raise NO_COVER

@ -818,7 +818,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
| _ -> false) | _ -> false)
(Attribute.get_for_exp tenv prop guarded_by_exp) in (Attribute.get_for_exp tenv prop guarded_by_exp) in
let guardedby_is_self_referential = 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 string_is_suffix guarded_by_str (Ident.fieldname_to_string accessed_fld) in
let proc_has_suppress_guarded_by_annot pdesc = let proc_has_suppress_guarded_by_annot pdesc =
let proc_signature = let proc_signature =

@ -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) = let is_not_const (e, _, i) =
match AttributesTable.load_attributes callee_pname with match AttributesTable.load_attributes callee_pname with
| Some attrs -> | 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 ( if is_const then (
L.d_str (Printf.sprintf "Not havocing const argument number %d: " i); L.d_str (Printf.sprintf "Not havocing const argument number %d: " i);
Sil.d_exp e; Sil.d_exp e;

@ -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 mk_symbol ~default ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
let strings = IList.map fst symbols in let strings = IList.map fst symbols in
let sym_to_str = IList.map (fun (x,y) -> (y,x)) 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 let to_string sym = IList.assoc ( = ) sym sym_to_str in
mk ~deprecated ~long ?short ~default ?exes ~meta doc mk ~deprecated ~long ?short ~default ?exes ~meta doc
~default_to_string:(fun s -> to_string s) ~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 mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
let strings = IList.map fst symbols in 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 mk ~deprecated ~long ?short ~default:None ?exes ~meta doc
~default_to_string:(fun _ -> "") ~default_to_string:(fun _ -> "")
~mk_setter:(fun var str -> var := Some (of_string str)) ~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 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 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 let to_string sym = IList.assoc ( = ) sym sym_to_str in
mk ~deprecated ~long ?short ~default ?exes ~meta:(",-separated sequence" ^ meta) doc mk ~deprecated ~long ?short ~default ?exes ~meta:(",-separated sequence" ^ meta) doc
~default_to_string:(fun syms -> String.concat " " (IList.map to_string syms)) ~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} = let {decode_json} =
IList.find IList.find
(fun {long; short} -> (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 desc_list in
decode_json json_val @ result decode_json json_val @ result
with 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) = let is_not_dup_with_doc speclist (opt, _, doc) =
opt = "" || opt = "" ||
IList.for_all (fun (opt', _, doc') -> 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 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 @ curr_speclist := IList.filter (is_not_dup_with_doc unique_exe_speclist) !curr_speclist @
(match header with (match header with

@ -240,7 +240,7 @@ let real_exe_name =
let current_exe = let current_exe =
if !Sys.interactive then CLOpt.Interactive 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 with Not_found -> CLOpt.Toplevel
let bin_dir = let bin_dir =
@ -319,8 +319,8 @@ let patterns_of_json_with_key json_key json =
let detect_pattern assoc = let detect_pattern assoc =
match detect_language assoc with match detect_language assoc with
| Ok language -> | Ok language ->
let is_method_pattern key = IList.exists (string_equal key) ["class"; "method"] let is_method_pattern key = IList.exists (Core.Std.String.equal key) ["class"; "method"]
and is_source_contains key = IList.exists (string_equal key) ["source_contains"] in and is_source_contains key = IList.exists (Core.Std.String.equal key) ["source_contains"] in
let rec loop = function let rec loop = function
| [] -> | [] ->
Error ("Unknown pattern for " ^ json_key ^ " in " ^ inferconfig_file) Error ("Unknown pattern for " ^ json_key ^ " in " ^ inferconfig_file)

@ -144,7 +144,7 @@ let source_file_of_header header_file =
let header_file_exts = ["h"; "hh"; "hpp"; "hxx"] in 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_no_ext, ext_opt = Core.Std.Filename.split_extension abs_path in
let file_opt = match ext_opt with 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 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) try Some (IList.find source_file_path_exists possible_files)
with Not_found -> None with Not_found -> None

@ -31,89 +31,19 @@ let initial_timeofday = Unix.gettimeofday ()
(** Compare police: generic compare disabled. *) (** Compare police: generic compare disabled. *)
let compare = () 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 fst3 (x,_,_) = x
let snd3 (_,x,_) = x let snd3 (_,x,_) = x
let trd3 (_,_,x) = x let trd3 (_,_,x) = x
let int_of_bool b = if b then 1 else 0 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} *) (** {2 Useful Modules} *)
(** Set of integers *) (** Set of integers *)
module IntSet = module IntSet = Set.Make(Core.Std.Int)
Set.Make(struct
type t = int
let compare = int_compare
end)
(** Hash table over strings *) (** Hash table over strings *)
module StringHash = Hashtbl.Make ( module StringHash = Hashtbl.Make (Core.Std.String)
struct
type t = string
let equal (s1: string) (s2: string) = s1 = s2
let hash = Hashtbl.hash
end)
(** Set of strings *) (** Set of strings *)
module StringSet = Set.Make(String) 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) StringSet.inter (string_set_of_list a) (string_set_of_list b)
module StringPPSet = PrettyPrintable.MakePPSet(struct module StringPPSet = PrettyPrintable.MakePPSet(struct
type t = string include Core.Std.String
let compare = string_compare
let pp_element fmt s = F.fprintf fmt "%s" s let pp_element fmt s = F.fprintf fmt "%s" s
end) end)
(** Maps from integers *) (** Maps from integers *)
module IntMap = Map.Make (struct module IntMap = Map.Make (Core.Std.Int)
type t = int
let compare = int_compare
end)
(** Maps from strings *) (** Maps from strings *)
module StringMap = Map.Make (struct module StringMap = Map.Make (Core.Std.String)
type t = string
let compare (s1: string) (s2: string) = Pervasives.compare s1 s2 end)
(** {2 Printing} *) (** {2 Printing} *)
@ -537,11 +461,6 @@ let join_strings sep = function
| hd:: tl -> | hd:: tl ->
IList.fold_left (fun str p -> str ^ sep ^ p) 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 directory_fold f init path =
let collect current_dir (accu, dirs) path = let collect current_dir (accu, dirs) path =

@ -29,50 +29,6 @@ val initial_timeofday : float
(** Compare police: generic compare disabled. *) (** Compare police: generic compare disabled. *)
val compare : unit 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. *) (** Return the first component of a triple. *)
val fst3 : 'a * 'b * 'c -> 'a 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 *) (** [join_strings sep parts] contatenates the elements of [parts] using [sep] as separator *)
val join_strings : string -> string list -> string 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 *) (** Functional fold function over all the file of a directory *)
val directory_fold : ('a -> string -> 'a) -> 'a -> string -> 'a val directory_fold : ('a -> string -> 'a) -> 'a -> string -> 'a

@ -16,7 +16,7 @@ let patch = @INFER_PATCH@
let commit = "@INFER_GIT_COMMIT@" let commit = "@INFER_GIT_COMMIT@"
let branch = "@INFER_GIT_BRANCH@" 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 tag = Printf.sprintf "v%d.%d.%d" major minor patch
let versionString = let versionString =

@ -116,11 +116,11 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let matches_proc frame = let matches_proc frame =
let matches_class pname = match pname with let matches_class pname = match pname with
| Procname.Java java_proc -> | Procname.Java java_proc ->
string_equal Core.Std.String.equal
frame.Stacktrace.class_str frame.Stacktrace.class_str
(Procname.java_get_class_name java_proc) (Procname.java_get_class_name java_proc)
| Procname.ObjC_Cpp objc_cpp_prod -> | Procname.ObjC_Cpp objc_cpp_prod ->
string_equal Core.Std.String.equal
frame.Stacktrace.class_str frame.Stacktrace.class_str
(Procname.objc_cpp_get_class_name objc_cpp_prod) (Procname.objc_cpp_get_class_name objc_cpp_prod)
| Procname.C _ -> true (* Needed for test code. *) | Procname.C _ -> true (* Needed for test code. *)

@ -94,7 +94,7 @@ let is_foreign tu_opt v =
let is_orig_file f = match tu_opt with let is_orig_file f = match tu_opt with
| Some orig_file -> | Some orig_file ->
let orig_path = DB.source_file_to_abs_path orig_file in 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 | None -> assert false in
Option.map_default (fun f -> not (is_orig_file f)) false (Pvar.get_source_file v) Option.map_default (fun f -> not (is_orig_file f)) false (Pvar.get_source_file v)

@ -60,7 +60,7 @@ let parse_stack_frame frame_str =
let class_str = Str.matched_group 1 qualified_procname in let class_str = Str.matched_group 1 qualified_procname in
let method_str = Str.matched_group 2 qualified_procname in let method_str = Str.matched_group 2 qualified_procname in
(* Native methods don't have debugging info *) (* 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 make_frame class_str method_str "Native Method" None
else begin else begin
(* Separate the filename and line number. (* Separate the filename and line number.

@ -75,7 +75,7 @@ let ia_get ia ann_name =
let ma_contains ma ann_names = let ma_contains ma ann_names =
let found = ref false in let found = ref false in
ma_iter (fun a -> 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; ) ma;
!found !found

@ -152,7 +152,7 @@ module State = struct
let elem' = Elem.set_env elem env' in let elem' = Elem.set_env elem env' in
[elem'] [elem']
| Some b' -> | Some b' ->
if bool_equal b b' then [elem] if Core.Std.Bool.equal b b' then [elem]
else [] in else [] in
map2 f s map2 f s
@ -230,7 +230,7 @@ module BooleanVars = struct
let exp_boolean_var exp = match exp with let exp_boolean_var exp = match exp with
| Exp.Lvar pvar when Pvar.is_local pvar -> | Exp.Lvar pvar when Pvar.is_local pvar ->
let name = Mangled.to_string (Pvar.get_name pvar) in 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 then Some name
else None else None
| _ -> None | _ -> None

@ -95,10 +95,10 @@ module ST = struct
let drop_prefix str = let drop_prefix str =
Str.replace_first (Str.regexp "^[A-Za-z]+_") "" str in Str.replace_first (Str.regexp "^[A-Za-z]+_") "" str in
let normalized_equal s1 s2 = 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 = 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 IList.mem normalized_equal kind a.parameters in
let is_annotation_suppressed = let is_annotation_suppressed =
string_is_suffix (normalize (drop_prefix kind)) (normalize a.class_name) in string_is_suffix (normalize (drop_prefix kind)) (normalize a.class_name) in

@ -27,7 +27,9 @@ module ConstantMap = Exp.Map
(** Dataflow struct *) (** Dataflow struct *)
module ConstantFlow = Dataflow.MakeDF(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 fmt constants =
let pp_key fmt = Exp.pp fmt in let pp_key fmt = Exp.pp fmt in
@ -38,11 +40,6 @@ module ConstantFlow = Dataflow.MakeDF(struct
ConstantMap.iter print_kv constants; ConstantMap.iter print_kv constants;
Format.fprintf fmt "]@." 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 join = ConstantMap.merge merge_values
let proc_throws _ = Dataflow.DontKnow let proc_throws _ = Dataflow.DontKnow

@ -175,7 +175,7 @@ let callback_test_dataflow { Callbacks.proc_desc; tenv } =
let verbose = false in let verbose = false in
let module DFCount = MakeDF(struct let module DFCount = MakeDF(struct
type t = int 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 join n m = if n = 0 then m else n
let do_node _ n s = let do_node _ n s =
if verbose then L.stdout "visiting node %a with state %d@." Procdesc.Node.pp n s; if verbose then L.stdout "visiting node %a with state %d@." Procdesc.Node.pp n s;

@ -25,7 +25,8 @@ let check_immutable_cast tenv curr_pname curr_pdesc typ_expected typ_found_opt l
] in ] in
let in_casts expected given = let in_casts expected given =
IList.exists (fun (x, y) -> 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 ) casts in
match PatternMatch.type_get_class_name typ_expected, match PatternMatch.type_get_class_name typ_expected,
PatternMatch.type_get_class_name typ_found with PatternMatch.type_get_class_name typ_found with

@ -273,7 +273,7 @@ let method_is_initializer
match proc_attributes.ProcAttributes.proc_name with match proc_attributes.ProcAttributes.proc_name with
| Procname.Java pname_java -> | Procname.Java pname_java ->
let mname = Procname.java_get_method pname_java in 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 false
else else

@ -49,7 +49,7 @@ let printf_like_function
try try
Some ( Some (
IList.find 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) !printf_like_functions)
with Not_found -> None with Not_found -> None
@ -70,15 +70,15 @@ let format_type_matches_given_type
match format_type with match format_type with
| "d" | "i" | "u" | "x" | "X" | "o" -> | "d" | "i" | "u" | "x" | "X" | "o" ->
IList.mem IList.mem
string_equal Core.Std.String.equal
given_type given_type
["java.lang.Integer"; "java.lang.Long"; "java.lang.Short"; "java.lang.Byte"] ["java.lang.Integer"; "java.lang.Long"; "java.lang.Short"; "java.lang.Byte"]
| "a" | "A" | "f" | "F" | "g" | "G" | "e" | "E" -> | "a" | "A" | "f" | "F" | "g" | "G" | "e" | "E" ->
IList.mem IList.mem
string_equal Core.Std.String.equal
given_type given_type
["java.lang.Double"; "java.lang.Float"] ["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 *) | "b" | "h" | "H" | "s" -> true (* accepts pretty much anything, even null *)
| _ -> false | _ -> false

@ -76,8 +76,8 @@ struct
!found in !found in
let module DFAllocCheck = Dataflow.MakeDF(struct let module DFAllocCheck = Dataflow.MakeDF(struct
type t = Location.t option type t = Location.t option [@@deriving compare]
let equal = opt_equal Location.equal let equal x y = compare x y = 0
let _join _paths l1o l2o = (* join with left priority *) let _join _paths l1o l2o = (* join with left priority *)
match l1o, l2o with match l1o, l2o with
| None, None -> | None, None ->

@ -38,7 +38,7 @@ let mk_structname n = Typename.TN_csu (Csu.Struct, Mangled.from_string n)
let is_class typ = let is_class typ =
match typ with match typ with
| Typ.Tptr (Tstruct ((TN_csu _) as name), _) -> | 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 | _ -> false
let rec return_type_of_function_type_ptr type_ptr = let rec return_type_of_function_type_ptr type_ptr =

@ -37,7 +37,7 @@ let value_of_argv_option argv opt_name =>
let result' = let result' =
if (Option.is_some result) { if (Option.is_some result) {
result result
} else if (string_equal opt_name prev_arg) { } else if (Core.Std.String.equal opt_name prev_arg) {
Some arg Some arg
} else { } else {
None 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 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 => let can_attach_ast_exporter cmd =>
has_flag cmd "-cc1" && ( 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 */ /* command line options not supported by the opensource compiler or the plugins */
let flags_blacklist = ["-fembed-bitcode-marker", "-fno-canonical-system-headers"]; let flags_blacklist = ["-fembed-bitcode-marker", "-fno-canonical-system-headers"];
let replace_option_arg option arg => 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" "armv7"
/* replace armv7k arch with armv7 */ /* replace armv7k arch with armv7 */
} else if ( } else if (
string_equal option "-isystem" Core.Std.String.equal option "-isystem"
) { ) {
switch Config.clang_include_to_override { 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" fcp_dir /\/ "clang" /\/ "install" /\/ "lib" /\/ "clang" /\/ "4.0.0" /\/ "include"
| _ => arg | _ => arg
} }
@ -110,7 +110,7 @@ let clang_cc1_cmd_sanitizer cmd => {
| [] => | [] =>
/* return non-reversed list */ /* return non-reversed list */
IList.rev (post_args_rev @ res_rev) 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 filter_unsupported_args_and_swap_includes (flag, res_rev) tl
| [arg, ...tl] => { | [arg, ...tl] => {
let res_rev' = [replace_option_arg prev arg, ...res_rev]; let res_rev' = [replace_option_arg prev arg, ...res_rev];

@ -99,9 +99,9 @@ let mutable_local_vars_advice context an =
let objc_whitelist = ["NSError"] in let objc_whitelist = ["NSError"] in
match get_referenced_type qual_type with match get_referenced_type qual_type with
| Some CXXRecordDecl (_, ndi, _, _, _, _, _, _) -> | 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, _, _, _) -> | 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 | _ -> false in
match an with match an with
@ -170,7 +170,7 @@ let component_with_unconventional_superclass_advice context an =
let has_conventional_superclass = let has_conventional_superclass =
let open CFrontend_config in let open CFrontend_config in
match superclass_name with match superclass_name with
| Some name when IList.mem string_equal name [ | Some name when IList.mem Core.Std.String.equal name [
ckcomponent_cl; ckcomponent_cl;
ckcomponentcontroller_cl; ckcomponentcontroller_cl;
"CKCompositeComponent"; "CKCompositeComponent";

@ -418,7 +418,8 @@ struct
else else
match if_decl with match if_decl with
| Some Clang_ast_t.ObjCInterfaceDecl (_, ndi, _, _, _) -> | 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) not (in_list blacklist)
&& (in_list ancestors && (in_list ancestors
|| is_objc_if_descendant ~blacklist:blacklist (get_super_if if_decl) ancestors) || is_objc_if_descendant ~blacklist:blacklist (get_super_if if_decl) ancestors)

@ -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 *) (* true iff an ast node is a node of type among the list tl *)
let node_has_type tl an = let node_has_type tl an =
let an_str = node_to_string an in 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 *) (* given a decl returns a stmt such that decl--->stmt via label trs *)
let transition_decl_to_stmt d 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 = let holds_for_one_node n =
match lctx.CLintersContext.et_evaluation_node with match lctx.CLintersContext.et_evaluation_node with
| Some id -> | 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 -> | None ->
(node_has_type [n] an) && (eval_formula phi an lctx) in (node_has_type [n] an) && (eval_formula phi an lctx) in
IList.exists holds_for_one_node node_type_list IList.exists holds_for_one_node node_type_list

@ -67,7 +67,7 @@ let is_modeled_builtin funct =
funct = CFrontend_config.builtin_memset_chk funct = CFrontend_config.builtin_memset_chk
let is_modeled_attribute attr_name = 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 = let get_first_param_typedef_string_opt type_ptr =
match Ast_utils.get_desugared_type type_ptr with match Ast_utils.get_desugared_type type_ptr with

@ -88,7 +88,7 @@ struct
| Some (typ_found, _, _) -> Some typ_found | Some (typ_found, _, _) -> Some typ_found
| None -> None in | None -> None in
let ret_implicitly_nullable = 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; State.set_node exit_node;
if checks.TypeCheck.check_ret_type <> [] then if checks.TypeCheck.check_ret_type <> [] then

@ -116,7 +116,7 @@ let check_condition tenv case_zero find_canonical_duplicate curr_pdesc
let throwable_found = ref false in let throwable_found = ref false in
let typ_is_throwable = function let typ_is_throwable = function
| Typ.Tstruct (TN_csu (Class Java, _) as name) -> | 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 | _ -> false in
let do_instr = function let do_instr = function
| Sil.Call (_, Exp.Const (Const.Cfun pn), [_; (Exp.Sizeof(t, _, _), _)], _, _) when | 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 should_check_field_initialization =
let in_current_class = let in_current_class =
let fld_cname = Ident.java_fieldname_get_class fn in 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 && not injector_readonly_annotated &&
PatternMatch.type_is_class ft && PatternMatch.type_is_class ft &&
in_current_class && in_current_class &&

@ -22,7 +22,8 @@ let is_destroy_method pname =
match pname with match pname with
| Procname.Java pname_java -> | Procname.Java pname_java ->
let method_name = Procname.java_get_method pname_java in 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 false

@ -82,7 +82,7 @@ let run_compilation_file compilation_database file =
let found = ref false in let found = ref false in
Array.iteri (fun i key_val -> Array.iteri (fun i key_val ->
match string_split_character key_val '=' with 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 ; found := true ;
env0.(i) <- env0.(i) <-
F.sprintf "%s=%s%c--fcp-syntax-only" CLOpt.args_env_var args CLOpt.env_var_sep F.sprintf "%s=%s%c--fcp-syntax-only" CLOpt.args_env_var args CLOpt.env_var_sep

@ -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 *) (** return true if [field_name] is the autogenerated C.$assertionsDisabled field for class C *)
let is_autogenerated_assert_field field_name = 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 is_closeable program tenv typ =
let closeable_cn = JBasics.make_cn "java.io.Closeable" in let closeable_cn = JBasics.make_cn "java.io.Closeable" in

@ -25,7 +25,7 @@ module MockNode = struct
let loc _ = assert false let loc _ = assert false
let underlying_id _ = assert false let underlying_id _ = assert false
let kind _ = Procdesc.Node.Stmt_node "" let kind _ = Procdesc.Node.Stmt_node ""
let compare_id = int_compare let compare_id = Core.Std.Int.compare
let pp_id fmt i = let pp_id fmt i =
F.fprintf fmt "%i" i F.fprintf fmt "%i" i
end end
@ -35,7 +35,7 @@ module MockProcCfg = struct
include (MockNode : module type of MockNode with type t := node) include (MockNode : module type of MockNode with type t := node)
type t = (node * node list) list type t = (node * node list) list
let compare_id = int_compare let compare_id = Core.Std.Int.compare
let succs t n = let succs t n =
try try

Loading…
Cancel
Save