From 5c12d98d374395b7c181fb7653634519bc4c7251 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 2 Feb 2017 02:03:55 -0800 Subject: [PATCH] Deprecate IList module in favour of Core List Reviewed By: jberdine Differential Revision: D4462130 fbshipit-source-id: e58bef0 --- infer/src/IR/Cfg.re | 16 ++-- infer/src/IR/DecompiledExp.re | 2 +- infer/src/IR/Localise.ml | 2 +- infer/src/IR/Mleak_buckets.ml | 12 +-- infer/src/IR/Objc_models.ml | 6 +- infer/src/IR/Procdesc.re | 4 +- infer/src/IR/Sil.re | 10 +-- infer/src/IR/Subtype.re | 4 +- infer/src/backend/Attribute.ml | 16 ++-- infer/src/backend/BuiltinDefn.ml | 4 +- infer/src/backend/InferPrint.re | 12 +-- infer/src/backend/PropUtil.re | 2 +- infer/src/backend/abs.ml | 38 ++++----- infer/src/backend/absarray.ml | 8 +- infer/src/backend/buckets.ml | 8 +- infer/src/backend/dom.ml | 20 +++-- infer/src/backend/dotty.ml | 79 ++++--------------- infer/src/backend/errdesc.ml | 12 +-- infer/src/backend/infer.ml | 4 +- infer/src/backend/inferconfig.ml | 34 ++++---- infer/src/backend/interproc.ml | 8 +- infer/src/backend/match.ml | 42 +++++----- infer/src/backend/preanal.ml | 4 +- infer/src/backend/prop.ml | 27 +++---- infer/src/backend/propgraph.ml | 2 +- infer/src/backend/prover.ml | 34 ++++---- infer/src/backend/rearrange.ml | 44 +++++------ infer/src/backend/state.ml | 2 +- infer/src/backend/symExec.ml | 28 +++---- infer/src/backend/tabulation.ml | 58 ++++---------- infer/src/backend/taint.ml | 4 +- infer/src/base/CommandLineOption.ml | 4 +- infer/src/base/DB.ml | 4 +- infer/src/base/IList.ml | 28 ------- infer/src/base/IList.mli | 16 ---- infer/src/base/SourceFile.ml | 2 +- .../src/bufferoverrun/bufferOverrunDomain.ml | 2 +- .../bufferoverrun/bufferOverrunSemantics.ml | 5 +- infer/src/bufferoverrun/itv.ml | 2 +- infer/src/checkers/Siof.ml | 4 +- infer/src/checkers/ThreadSafety.ml | 9 ++- infer/src/checkers/annotations.ml | 30 +++---- infer/src/checkers/checkTraceCallSequence.ml | 6 +- infer/src/checkers/checkers.ml | 4 +- infer/src/checkers/immutableChecker.ml | 2 +- infer/src/checkers/patternMatch.ml | 22 +++--- infer/src/checkers/printfArgs.ml | 12 +-- infer/src/checkers/procCfg.ml | 2 +- infer/src/checkers/sqlChecker.ml | 2 +- infer/src/clang/ClangCommand.re | 4 +- infer/src/clang/ComponentKit.ml | 26 +++--- infer/src/clang/cAst_utils.ml | 4 +- infer/src/clang/cContext.ml | 4 +- infer/src/clang/cFrontend_decl.ml | 2 +- infer/src/clang/cGeneral_utils.ml | 2 +- infer/src/clang/cLocation.ml | 8 +- infer/src/clang/cPredicates.ml | 4 +- infer/src/clang/cTL.ml | 8 +- infer/src/clang/cTrans.ml | 16 ++-- infer/src/clang/cTrans_models.ml | 2 +- infer/src/clang/objcProperty_decl.ml | 4 +- infer/src/eradicate/eradicateChecks.ml | 14 ++-- infer/src/eradicate/typeCheck.ml | 2 +- .../integration/CaptureCompilationDatabase.ml | 2 +- infer/src/java/jMain.ml | 4 +- infer/src/quandary/JavaTrace.ml | 10 ++- infer/src/unit/TraceTests.ml | 10 ++- infer/src/unit/accessTreeTests.ml | 4 +- infer/src/unit/procCfgTests.ml | 2 +- infer/src/unit/schedulerTests.ml | 2 +- 70 files changed, 362 insertions(+), 474 deletions(-) diff --git a/infer/src/IR/Cfg.re b/infer/src/IR/Cfg.re index 1205bceef..86acc2085 100644 --- a/infer/src/IR/Cfg.re +++ b/infer/src/IR/Cfg.re @@ -107,7 +107,7 @@ let check_cfg_connectedness cfg => { let do_pdesc pd => { let pname = Procname.to_string (Procdesc.get_proc_name pd); let nodes = Procdesc.get_nodes pd; - let broken = IList.exists broken_node nodes; + let broken = List.exists f::broken_node nodes; if broken { L.out "\n ***BROKEN CFG: '%s'\n" pname } else { @@ -262,7 +262,7 @@ let mark_unchanged_pdescs cfg_new cfg_old => { let node_map = ref Procdesc.NodeMap.empty; /* formals are the same if their types are the same */ let formals_eq formals1 formals2 => - IList.equal (fun (_, typ1) (_, typ2) => Typ.compare typ1 typ2) formals1 formals2; + List.equal equal::(fun (_, typ1) (_, typ2) => Typ.equal typ1 typ2) formals1 formals2; let nodes_eq n1s n2s => { /* nodes are the same if they have the same id, instructions, and succs/preds up to renaming with [exp_map] and [id_map] */ @@ -278,19 +278,21 @@ let mark_unchanged_pdescs cfg_new cfg_old => { 0 }; let instrs_eq instrs1 instrs2 => - IList.equal - ( + List.equal + equal::( fun i1 i2 => { let (n, exp_map') = Sil.compare_structural_instr i1 i2 !exp_map; exp_map := exp_map'; - n + Int.equal n 0 } ) instrs1 instrs2; Int.equal (compare_id n1 n2) 0 && - IList.equal Procdesc.Node.compare (Procdesc.Node.get_succs n1) (Procdesc.Node.get_succs n2) && - IList.equal Procdesc.Node.compare (Procdesc.Node.get_preds n1) (Procdesc.Node.get_preds n2) && + List.equal + equal::Procdesc.Node.equal (Procdesc.Node.get_succs n1) (Procdesc.Node.get_succs n2) && + List.equal + equal::Procdesc.Node.equal (Procdesc.Node.get_preds n1) (Procdesc.Node.get_preds n2) && instrs_eq (Procdesc.Node.get_instrs n1) (Procdesc.Node.get_instrs n2) }; try (IList.for_all2 node_eq n1s n2s) { diff --git a/infer/src/IR/DecompiledExp.re b/infer/src/IR/DecompiledExp.re index 4978a8ae6..52f56ab24 100644 --- a/infer/src/IR/DecompiledExp.re +++ b/infer/src/IR/DecompiledExp.re @@ -169,7 +169,7 @@ let rec has_tmp_var = | Darray dexp1 dexp2 | Dbinop _ dexp1 dexp2 => has_tmp_var dexp1 || has_tmp_var dexp2 | Dretcall dexp dexp_list _ _ - | Dfcall dexp dexp_list _ _ => has_tmp_var dexp || IList.exists has_tmp_var dexp_list + | Dfcall dexp dexp_list _ _ => has_tmp_var dexp || List.exists f::has_tmp_var dexp_list | Dconst _ | Dunknown | Dsizeof _ None _ => false; diff --git a/infer/src/IR/Localise.ml b/infer/src/IR/Localise.ml index acf299734..3a972b350 100644 --- a/infer/src/IR/Localise.ml +++ b/infer/src/IR/Localise.ml @@ -552,7 +552,7 @@ let parameter_field_not_null_checked_desc (desc : error_desc) exp = | _ -> desc let has_tag (desc : error_desc) tag = - IList.exists (fun (tag', _) -> String.equal tag tag') desc.tags + List.exists ~f:(fun (tag', _) -> String.equal tag tag') desc.tags let is_parameter_not_null_checked_desc desc = has_tag desc Tags.parameter_not_null_checked diff --git a/infer/src/IR/Mleak_buckets.ml b/infer/src/IR/Mleak_buckets.ml index 7a28e5fc7..0278686a8 100644 --- a/infer/src/IR/Mleak_buckets.ml +++ b/infer/src/IR/Mleak_buckets.ml @@ -24,22 +24,22 @@ let bucket_to_message bucket = | `MLeak_unknown -> "[UNKNOWN ORIGIN]" let contains_all = - IList.mem PVariant.(=) `MLeak_all Config.ml_buckets + List.mem ~equal:PVariant.(=) Config.ml_buckets `MLeak_all let contains_cf = - IList.mem PVariant.(=) `MLeak_cf Config.ml_buckets + List.mem ~equal:PVariant.(=) Config.ml_buckets `MLeak_cf let contains_arc = - IList.mem PVariant.(=) `MLeak_arc Config.ml_buckets + List.mem ~equal:PVariant.(=) Config.ml_buckets `MLeak_arc let contains_narc = - IList.mem PVariant.(=) `MLeak_no_arc Config.ml_buckets + List.mem ~equal:PVariant.(=) Config.ml_buckets `MLeak_no_arc let contains_cpp = - IList.mem PVariant.(=) `MLeak_cpp Config.ml_buckets + List.mem ~equal:PVariant.(=) Config.ml_buckets `MLeak_cpp let contains_unknown_origin = - IList.mem PVariant.(=) `MLeak_unknown Config.ml_buckets + List.mem ~equal:PVariant.(=) Config.ml_buckets `MLeak_unknown let should_raise_leak_cf typ = if contains_cf then diff --git a/infer/src/IR/Objc_models.ml b/infer/src/IR/Objc_models.ml index 7e835d5ab..5c2e1c2b5 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 + List.mem ~equal:String.equal core_foundation_types o || + List.mem ~equal:String.equal core_graphics_types o 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 + List.mem ~equal:String.equal core_lib_types (Typename.name name) | _ -> false let is_core_foundation_type typ = diff --git a/infer/src/IR/Procdesc.re b/infer/src/IR/Procdesc.re index 556d93abc..a826dd309 100644 --- a/infer/src/IR/Procdesc.re +++ b/infer/src/IR/Procdesc.re @@ -538,9 +538,9 @@ let get_loop_heads pdesc => { } } else { let ancester = NodeSet.add n ancester; - let succs = IList.append (Node.get_succs n) (Node.get_exn n); + let succs = List.append (Node.get_succs n) (Node.get_exn n); let works = IList.map (fun m => (m, ancester)) succs; - set_loop_head_rec (NodeSet.add n visited) heads (IList.append works wl') + set_loop_head_rec (NodeSet.add n visited) heads (List.append works wl') } }; let start_wl = [(get_start_node pdesc, NodeSet.empty)]; diff --git a/infer/src/IR/Sil.re b/infer/src/IR/Sil.re index 96e44eea4..486fe5093 100644 --- a/infer/src/IR/Sil.re +++ b/infer/src/IR/Sil.re @@ -232,7 +232,7 @@ let has_objc_ref_counter tenv hpred => switch hpred { | Hpointsto _ _ (Sizeof (Tstruct name) _ _) => switch (Tenv.lookup tenv name) { - | Some {fields} => IList.exists StructTyp.is_objc_ref_counter_field fields + | Some {fields} => List.exists f::StructTyp.is_objc_ref_counter_field fields | _ => false } | _ => false @@ -1327,7 +1327,7 @@ let fav_for_all fav predicate => IList.for_all predicate !fav; /** Check whether a predicate holds for some elements. */ -let fav_exists fav predicate => IList.exists predicate !fav; +let fav_exists fav predicate => List.exists f::predicate !fav; /** flag to indicate whether fav's are stored in duplicate form. @@ -1337,7 +1337,7 @@ let fav_duplicates = ref false; /** extend [fav] with a [id] */ let (++) fav id => - if (!fav_duplicates || not (IList.exists (Ident.equal id) !fav)) { + if (!fav_duplicates || not (List.exists f::(Ident.equal id) !fav)) { fav := [id, ...!fav] }; @@ -1419,7 +1419,7 @@ let rec ident_sorted_list_subset l1 l2 => is in [fav2].*/ let fav_subset_ident fav1 fav2 => ident_sorted_list_subset (fav_to_list fav1) (fav_to_list fav2); -let fav_mem fav id => IList.exists (Ident.equal id) !fav; +let fav_mem fav id => List.exists f::(Ident.equal id) !fav; let rec exp_fav_add fav e => switch (e: Exp.t) { @@ -1769,7 +1769,7 @@ let sub_range_map f sub => sub_of_list (IList.map (fun (i, e) => (i, f e)) sub); of [sub] and the substitution [g] to the expressions in the range of [sub]. */ let sub_map f g sub => sub_of_list (IList.map (fun (i, e) => (f i, g e)) sub); -let mem_sub id sub => IList.exists (fun (id1, _) => Ident.equal id id1) sub; +let mem_sub id sub => List.exists f::(fun (id1, _) => Ident.equal id id1) sub; /** Extend substitution and return [None] if not possible. */ diff --git a/infer/src/IR/Subtype.re b/infer/src/IR/Subtype.re index 5f4bf4e92..7f020e9f3 100644 --- a/infer/src/IR/Subtype.re +++ b/infer/src/IR/Subtype.re @@ -152,7 +152,7 @@ let is_cast t => equal_kind (snd t) CAST; let is_instof t => equal_kind (snd t) INSTOF; let list_intersect equal l1 l2 => { - let in_l2 a => IList.mem equal a l2; + let in_l2 a => List.mem equal::equal l2 a; IList.filter in_l2 l1 }; @@ -218,7 +218,7 @@ let subtypes_to_string t => }; /* c is a subtype when it does not appear in the list l of no-subtypes */ -let no_subtype_in_list tenv c l => not (IList.exists (is_known_subtype tenv c) l); +let no_subtype_in_list tenv c l => not (List.exists f::(is_known_subtype tenv c) l); let is_strict_subtype tenv c1 c2 => is_known_subtype tenv c1 c2 && not (Typename.equal c1 c2); diff --git a/infer/src/backend/Attribute.ml b/infer/src/backend/Attribute.ml index 4b46b0e47..1fdd239e9 100644 --- a/infer/src/backend/Attribute.ml +++ b/infer/src/backend/Attribute.ml @@ -36,9 +36,10 @@ let attributes_in_same_category attr1 attr2 = let add_or_replace_check_changed tenv check_attribute_change prop atom0 = match atom0 with | Sil.Apred (att0, ((_ :: _) as exps0)) | Anpred (att0, ((_ :: _) as exps0)) -> - let nexps = IList.map (fun e -> Prop.exp_normalize_prop tenv prop e) exps0 in - let nexp = IList.hd nexps in (* len nexps = len exps0 > 0 by match *) - let natom = Sil.atom_replace_exp (IList.combine exps0 nexps) atom0 in + let pairs = + IList.map (fun e -> (e, Prop.exp_normalize_prop tenv prop e)) exps0 in + let _, nexp = IList.hd pairs in (* len exps0 > 0 by match *) + let natom = Sil.atom_replace_exp pairs atom0 in let atom_map = function | Sil.Apred (att, exp :: _) | Anpred (att, exp :: _) when Exp.equal nexp exp && attributes_in_same_category att att0 -> @@ -78,7 +79,8 @@ let get_for_exp tenv (prop: 'a Prop.t) exp = let nexp = Prop.exp_normalize_prop tenv prop exp in let atom_get_attr attributes atom = match atom with - | Sil.Apred (_, es) | Anpred (_, es) when IList.mem Exp.equal nexp es -> atom :: attributes + | Sil.Apred (_, es) | Anpred (_, es) + when List.mem ~equal:Exp.equal es nexp -> atom :: attributes | _ -> attributes in IList.fold_left atom_get_attr [] prop.pi @@ -119,7 +121,7 @@ let get_retval tenv prop exp = let has_dangling_uninit tenv prop exp = let la = get_for_exp tenv prop exp in - IList.exists (function + List.exists ~f:(function | Sil.Apred (a, _) -> PredSymb.equal a (Adangling DAuninit) | _ -> false ) la @@ -257,7 +259,7 @@ let find_arithmetic_problem tenv proc_node_session prop exp = let deallocate_stack_vars tenv (p: 'a Prop.t) pvars = let filter = function | Sil.Hpointsto (Exp.Lvar v, _, _) -> - IList.exists (Pvar.equal v) pvars + List.exists ~f:(Pvar.equal v) pvars | _ -> false in let sigma_stack, sigma_other = IList.partition filter p.sigma in let fresh_address_vars = ref [] in (* fresh vars substituted for the address of stack vars *) @@ -296,7 +298,7 @@ let find_equal_formal_path tenv e prop = let rec find_in_sigma e seen_hpreds = IList.fold_right ( fun hpred res -> - if IList.mem Sil.equal_hpred hpred seen_hpreds then None + if List.mem ~equal:Sil.equal_hpred seen_hpreds hpred then None else let seen_hpreds = hpred :: seen_hpreds in match res with diff --git a/infer/src/backend/BuiltinDefn.ml b/infer/src/backend/BuiltinDefn.ml index 73472a86a..244094ad5 100644 --- a/infer/src/backend/BuiltinDefn.ml +++ b/infer/src/backend/BuiltinDefn.ml @@ -387,7 +387,7 @@ let execute___get_hidden_field { Builtin.tenv; pdesc; prop_; path; ret_id; args; | None -> p in let foot_var = lazy (Exp.Var (Ident.create_fresh Ident.kfootprint)) in let filter_fld_hidden (f, _ ) = Ident.fieldname_is_hidden f in - let has_fld_hidden fsel = IList.exists filter_fld_hidden fsel in + let has_fld_hidden fsel = List.exists ~f:filter_fld_hidden fsel in let do_hpred in_foot hpred = match hpred with | Sil.Hpointsto(e, Sil.Estruct (fsel, inst), texp) when Exp.equal e n_lexp && (not (has_fld_hidden fsel)) -> @@ -423,7 +423,7 @@ let execute___set_hidden_field { Builtin.tenv; pdesc; prop_; path; args; } let n_lexp2, prop = check_arith_norm_exp tenv pname lexp2 prop__ in let foot_var = lazy (Exp.Var (Ident.create_fresh Ident.kfootprint)) in let filter_fld_hidden (f, _ ) = Ident.fieldname_is_hidden f in - let has_fld_hidden fsel = IList.exists filter_fld_hidden fsel in + let has_fld_hidden fsel = List.exists ~f:filter_fld_hidden fsel in let do_hpred in_foot hpred = match hpred with | Sil.Hpointsto(e, Sil.Estruct (fsel, inst), texp) when Exp.equal e n_lexp1 && not in_foot -> diff --git a/infer/src/backend/InferPrint.re b/infer/src/backend/InferPrint.re index 1fd26bce6..3b4506e29 100644 --- a/infer/src/backend/InferPrint.re +++ b/infer/src/backend/InferPrint.re @@ -346,19 +346,15 @@ let should_report (issue_kind: Exceptions.err_kind) issue_type error_desc eclass parameter_not_null_checked, premature_nil_termination ]; - IList.mem Localise.equal issue_type null_deref_issue_types + List.mem equal::Localise.equal null_deref_issue_types issue_type }; let issue_type_is_buffer_overrun = Localise.equal issue_type Localise.buffer_overrun; if (issue_type_is_null_deref || issue_type_is_buffer_overrun) { let issue_bucket_is_high = { let issue_bucket = Localise.error_desc_get_bucket error_desc; let high_buckets = Localise.BucketLevel.[b1, b2]; - let eq o y => - switch (o, y) { - | (None, _) => false - | (Some x, y) => String.equal x y - }; - IList.mem eq issue_bucket high_buckets + Option.value_map + issue_bucket default::false f::(fun b => List.mem equal::String.equal high_buckets b) }; issue_bucket_is_high } else { @@ -377,7 +373,7 @@ let should_report (issue_kind: Exceptions.err_kind) issue_type error_desc eclass thread_safety_violation, unsafe_guarded_by_access ]; - IList.mem Localise.equal issue_type reportable_issue_types + List.mem equal::Localise.equal reportable_issue_types issue_type }; issue_type_is_reportable } diff --git a/infer/src/backend/PropUtil.re b/infer/src/backend/PropUtil.re index 829b97e61..43bd51143 100644 --- a/infer/src/backend/PropUtil.re +++ b/infer/src/backend/PropUtil.re @@ -107,7 +107,7 @@ let remove_abduced_retvars tenv p => { | Sil.Aeq lhs rhs | Sil.Aneq lhs rhs => exp_contains lhs || exp_contains rhs | Sil.Apred _ es - | Sil.Anpred _ es => IList.exists exp_contains es + | Sil.Anpred _ es => List.exists f::exp_contains es ) pi }; diff --git a/infer/src/backend/abs.ml b/infer/src/backend/abs.ml index 523be1708..a84c32057 100644 --- a/infer/src/backend/abs.ml +++ b/infer/src/backend/abs.ml @@ -65,7 +65,7 @@ let create_fresh_primeds_ls para = let create_condition_ls ids_private id_base p_leftover (inst: Sil.subst) = let (insts_of_private_ids, insts_of_public_ids, inst_of_base) = - let f id' = IList.exists (fun id'' -> Ident.equal id' id'') ids_private in + let f id' = List.exists ~f:(fun id'' -> Ident.equal id' id'') ids_private in let (inst_private, inst_public) = Sil.sub_domain_partition f inst in let insts_of_public_ids = Sil.sub_range inst_public in let inst_of_base = try Sil.sub_find (Ident.equal id_base) inst_public with Not_found -> assert false in @@ -87,7 +87,7 @@ let create_condition_ls ids_private id_base p_leftover (inst: Sil.subst) = (* (not (IList.intersect compare fav_inst_of_base fav_in_pvars)) && *) (List.is_empty fpv_inst_of_base) && (List.is_empty fpv_insts_of_private_ids) && - (not (IList.exists Ident.is_normal fav_insts_of_private_ids)) && + (not (List.exists ~f:Ident.is_normal fav_insts_of_private_ids)) && (not (IList.intersect Ident.compare fav_insts_of_private_ids fav_p_leftover)) && (not (IList.intersect Ident.compare fav_insts_of_private_ids fav_insts_of_public_ids)) @@ -469,7 +469,7 @@ let discover_para_candidates tenv p = let edges = ref [] in let add_edge edg = edges := edg :: !edges in let get_edges_strexp rec_flds root se = - let is_rec_fld fld = IList.exists (Ident.equal_fieldname fld) rec_flds in + let is_rec_fld fld = List.exists ~f:(Ident.equal_fieldname fld) rec_flds in match se with | Sil.Eexp _ | Sil.Earray _ -> () | Sil.Estruct (fsel, _) -> @@ -505,7 +505,7 @@ let discover_para_dll_candidates tenv p = let edges = ref [] in let add_edge edg = (edges := edg :: !edges) in let get_edges_strexp rec_flds root se = - let is_rec_fld fld = IList.exists (Ident.equal_fieldname fld) rec_flds in + let is_rec_fld fld = List.exists ~f:(Ident.equal_fieldname fld) rec_flds in match se with | Sil.Eexp _ | Sil.Earray _ -> () | Sil.Estruct (fsel, _) -> @@ -544,7 +544,7 @@ let discover_para_dll_candidates tenv p = let discover_para tenv p = let candidates = discover_para_candidates tenv p in let already_defined para paras = - IList.exists (fun para' -> Match.hpara_iso tenv para para') paras in + List.exists ~f:(fun para' -> Match.hpara_iso tenv para para') paras in let f paras (root, next, out) = match (discover_para_roots tenv p root next next out) with | None -> paras @@ -558,7 +558,7 @@ let discover_para_dll tenv p = *) let candidates = discover_para_dll_candidates tenv p in let already_defined para paras = - IList.exists (fun para' -> Match.hpara_dll_iso tenv para para') paras in + List.exists ~f:(fun para' -> Match.hpara_dll_iso tenv para para') paras in let f paras (iF, oB, iF', oF) = match (discover_para_dll_roots tenv p iF oB iF' iF' iF oF) with | None -> paras @@ -599,7 +599,7 @@ let eqs_sub subst eqs = let eqs_solve ids_in eqs_in = let rec solve (sub: Sil.subst) (eqs: (Exp.t * Exp.t) list) : Sil.subst option = let do_default id e eqs_rest = - if not (IList.exists (fun id' -> Ident.equal id id') ids_in) then None + if not (List.exists ~f:(fun id' -> Ident.equal id id') ids_in) then None else let sub' = match Sil.extend_sub sub id e with | None -> L.out "@.@.ERROR : Buggy Implementation.@.@."; assert false @@ -626,7 +626,7 @@ let eqs_solve ids_in eqs_in = let sub_list = Sil.sub_to_list sub in let sub_dom = IList.map fst sub_list in let filter id = - not (IList.exists (fun id' -> Ident.equal id id') sub_dom) in + not (List.exists ~f:(fun id' -> Ident.equal id id') sub_dom) in IList.filter filter ids_in in match solve Sil.sub_empty eqs_in with | None -> None @@ -728,11 +728,11 @@ let abs_rules_apply_lists tenv (p_in: Prop.normal Prop.t) : Prop.normal Prop.t = | (DLL para', _) -> Match.hpara_dll_iso tenv para para' | _ -> false in let filter_sll para = - not (IList.exists (eq_sll para) old_rsets) && - not (IList.exists (eq_sll para) !new_rsets) in + not (List.exists ~f:(eq_sll para) old_rsets) && + not (List.exists ~f:(eq_sll para) !new_rsets) in let filter_dll para = - not (IList.exists (eq_dll para) old_rsets) && - not (IList.exists (eq_dll para) !new_rsets) in + not (List.exists ~f:(eq_dll para) old_rsets) && + not (List.exists ~f:(eq_dll para) !new_rsets) in let todo_paras_sll = IList.filter filter_sll closed_paras_sll in let todo_paras_dll = IList.filter filter_dll closed_paras_dll in (todo_paras_sll, todo_paras_dll) in @@ -906,7 +906,7 @@ let get_cycle root prop = | (f, e):: el' -> if Sil.equal_strexp e e_root then (et_src, f, e):: path, true - else if IList.mem Sil.equal_strexp e visited then + else if List.mem ~equal:Sil.equal_strexp visited e then path, false else ( let visited' = (fst et_src):: visited in @@ -967,7 +967,7 @@ let get_var_retain_cycle prop_ = Some (Sil.hpred_get_lhs hp) with Not_found -> None in let find_block v = - if (IList.exists (is_hpred_block v) sigma) then + if (List.exists ~f:(is_hpred_block v) sigma) then Some (Exp.Lvar Sil.block_pvar) else None in let sexp e = Sil.Eexp (e, Sil.Inone) in @@ -1029,7 +1029,7 @@ let cycle_has_weak_or_unretained_or_assign_field tenv cycle = | [] -> false | ((_, t), fn, _):: c' -> let ia = get_item_annotation t fn in - if (IList.exists do_annotation ia) then true + if (List.exists ~f:do_annotation ia) then true else do_cycle c' in do_cycle cycle @@ -1083,7 +1083,7 @@ let check_junk ?original_prop pname tenv prop = Sil.strexp_fav_add fav se; Sil.fav_mem fav id | _ -> false in - hpred_is_loop || IList.exists predicate entries in + hpred_is_loop || List.exists ~f:predicate entries in let rec remove_junk_recursive sigma_done sigma_todo = match sigma_todo with | [] -> IList.rev sigma_done @@ -1172,7 +1172,7 @@ let check_junk ?original_prop pname tenv prop = | None, Some _ -> false in (is_none alloc_attribute && !leaks_reported <> []) || (* None attribute only reported if it's the first one *) - IList.mem attr_opt_equal alloc_attribute !leaks_reported in + List.mem ~equal:attr_opt_equal !leaks_reported alloc_attribute in let ignore_leak = !Config.allow_leak || ignore_resource || is_undefined || already_reported () in let report_and_continue = @@ -1239,7 +1239,7 @@ let get_local_stack cur_sigma init_sigma = | Sil.Hpointsto (Exp.Lvar pvar, _, _) -> pvar | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> assert false in let filter_local_stack olds = function - | Sil.Hpointsto (Exp.Lvar pvar, _, _) -> not (IList.exists (Pvar.equal pvar) olds) + | Sil.Hpointsto (Exp.Lvar pvar, _, _) -> not (List.exists ~f:(Pvar.equal pvar) olds) | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> false in let init_stack = IList.filter filter_stack init_sigma in let init_stack_pvars = IList.map get_stack_var init_stack in @@ -1259,7 +1259,7 @@ let extract_footprint_for_abs (p : 'a Prop.t) : Prop.exposed Prop.t * Pvar.t lis let remove_local_stack sigma pvars = let filter_non_stack = function - | Sil.Hpointsto (Exp.Lvar pvar, _, _) -> not (IList.exists (Pvar.equal pvar) pvars) + | Sil.Hpointsto (Exp.Lvar pvar, _, _) -> not (List.exists ~f:(Pvar.equal pvar) pvars) | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> true in IList.filter filter_non_stack sigma diff --git a/infer/src/backend/absarray.ml b/infer/src/backend/absarray.ml index 6235b2adb..cb55a96aa 100644 --- a/infer/src/backend/absarray.ml +++ b/infer/src/backend/absarray.ml @@ -227,7 +227,7 @@ end = struct match se', se_in with | Sil.Earray (len, esel, _), Sil.Earray (_, esel_in, inst2) -> let orig_indices = IList.map fst esel in - let index_is_not_new idx = IList.exists (Exp.equal idx) orig_indices in + let index_is_not_new idx = List.exists ~f:(Exp.equal idx) orig_indices in let process_index idx = if index_is_not_new idx then idx else (Sil.array_clean_new_index footprint_part idx) in let esel_in' = IList.map (fun (idx, se) -> process_index idx, se) esel_in in @@ -378,9 +378,9 @@ let index_is_pointed_to tenv (p: Prop.normal Prop.t) (path: StrexpMatch.path) (i fun i -> IList.map (add_index i) elist_path in let pointers = IList.flatten (IList.map add_index_to_paths indices) in let filter = function - | Sil.Hpointsto (_, Sil.Eexp (e, _), _) -> IList.exists (Exp.equal e) pointers + | Sil.Hpointsto (_, Sil.Eexp (e, _), _) -> List.exists ~f:(Exp.equal e) pointers | _ -> false in - IList.exists filter p.Prop.sigma + List.exists ~f:filter p.Prop.sigma (** Given [p] containing an array at [path], blur [index] in it *) @@ -440,7 +440,7 @@ let keep_only_indices tenv match se with | Sil.Earray (len, esel, inst) -> let esel', esel_leftover' = - IList.partition (fun (e, _) -> IList.exists (Exp.equal e) indices) esel in + IList.partition (fun (e, _) -> List.exists ~f:(Exp.equal e) indices) esel in if List.is_empty esel_leftover' then (sigma, false) else begin let se' = Sil.Earray (len, esel', inst) in diff --git a/infer/src/backend/buckets.ml b/infer/src/backend/buckets.ml index 2e3a3179e..69c3ec076 100644 --- a/infer/src/backend/buckets.ml +++ b/infer/src/backend/buckets.ml @@ -62,7 +62,7 @@ let check_access access_opt de_opt = let formal_names = IList.map fst formals in let is_formal pvar = let name = Pvar.get_name pvar in - IList.exists (Mangled.equal name) formal_names in + List.exists ~f:(Mangled.equal name) formal_names in let formal_ids = ref [] in let process_formal_letref = function | Sil.Load (id, Exp.Lvar pvar, _, _) -> @@ -90,14 +90,14 @@ let check_access access_opt de_opt = | Sil.Call (_, _, etl, _, _) -> let formal_ids = find_formal_ids node in let arg_is_formal_param (e, _) = match e with - | Exp.Var id -> IList.exists (Ident.equal id) formal_ids + | Exp.Var id -> List.exists ~f:(Ident.equal id) formal_ids | _ -> false in - if IList.exists arg_is_formal_param etl then formal_param_used_in_call := true; + if List.exists ~f:arg_is_formal_param etl then formal_param_used_in_call := true; true | Sil.Store (_, _, e, _) -> exp_is_null e | _ -> false in - IList.exists filter (Procdesc.Node.get_instrs node) in + List.exists ~f:filter (Procdesc.Node.get_instrs node) in let local_access_found = ref false in let do_node node = if Int.equal (Procdesc.Node.get_loc node).Location.line line_number && diff --git a/infer/src/backend/dom.ml b/infer/src/backend/dom.ml index 51de0f6ba..d443852cf 100644 --- a/infer/src/backend/dom.ml +++ b/infer/src/backend/dom.ml @@ -252,10 +252,10 @@ module CheckJoinPre : InfoLossCheckerSig = struct | Exp.Var id when Ident.is_normal id -> IList.length es >= 1 | Exp.Var _ -> if Int.equal Config.join_cond 0 then - IList.exists (Exp.equal Exp.zero) es + List.exists ~f:(Exp.equal Exp.zero) es else if Dangling.check side e then begin - let r = IList.exists (fun e' -> not (Dangling.check side_op e')) es in + let r = List.exists ~f:(fun e' -> not (Dangling.check side_op e')) es in if r then begin L.d_str ".... Dangling Check (dang e:"; Sil.d_exp e; L.d_str ") (? es:"; Sil.d_exp_list es; L.d_strln ") ...."; @@ -265,7 +265,7 @@ module CheckJoinPre : InfoLossCheckerSig = struct end else begin - let r = IList.exists (Dangling.check side_op) es in + let r = List.exists ~f:(Dangling.check side_op) es in if r then begin L.d_str ".... Dangling Check (notdang e:"; Sil.d_exp e; L.d_str ") (? es:"; Sil.d_exp_list es; L.d_strln ") ...."; @@ -1641,11 +1641,17 @@ let pi_partial_join tenv mode | None -> begin match Prop.atom_const_lt_exp a_op with - | None -> Some a_res - | Some (n, e) -> if IList.exists (is_stronger_lt n e) pi_op then (widening_atom a_res) else Some a_res + | None -> + Some a_res + | Some (n, e) -> + if List.exists ~f:(is_stronger_lt n e) pi_op + then (widening_atom a_res) + else Some a_res end | Some (e, n) -> - if IList.exists (is_stronger_le e n) pi_op then (widening_atom a_res) else Some a_res + if List.exists ~f:(is_stronger_le e n) pi_op + then (widening_atom a_res) + else Some a_res end in let handle_atom_with_widening len p_op pi_op atom_list a = (* find a join for the atom, if it fails apply widening heuristing and try again *) @@ -1819,7 +1825,7 @@ let footprint_partial_join' tenv (p1: Prop.normal Prop.t) (p2: Prop.normal Prop. let sigma_fp = let sigma_fp0 = efp.Prop.sigma in let f a = Sil.fav_exists (Sil.hpred_fav a) (fun a -> not (Ident.is_footprint a)) in - if IList.exists f sigma_fp0 then (L.d_strln "failure reason 66"; raise IList.Fail); + if List.exists ~f sigma_fp0 then (L.d_strln "failure reason 66"; raise IList.Fail); sigma_fp0 in let ep1' = Prop.set p1 ~pi_fp ~sigma_fp in let ep2' = Prop.set p2 ~pi_fp ~sigma_fp in diff --git a/infer/src/backend/dotty.ml b/infer/src/backend/dotty.ml index 9110f7da7..dc01254b1 100644 --- a/infer/src/backend/dotty.ml +++ b/infer/src/backend/dotty.ml @@ -268,7 +268,7 @@ let make_dangling_boxes pe allocated_nodes (sigma_lambda: (Sil.hpred * int) list let is_allocated d = match d with | Dotdangling(_, e, _) -> - IList.exists (fun a -> match a with + List.exists ~f:(fun a -> match a with | Dotpointsto(_, e', _) | Dotarray(_, _, e', _, _, _) | Dotlseg(_, e', _, _, _, _) @@ -280,7 +280,7 @@ let make_dangling_boxes pe allocated_nodes (sigma_lambda: (Sil.hpred * int) list match l with | [] -> [] | Dotdangling(coo, e, color):: l' -> - if (IList.exists (Exp.equal e) seen_exp) then filter_duplicate l' seen_exp + if (List.exists ~f:(Exp.equal e) seen_exp) then filter_duplicate l' seen_exp else Dotdangling(coo, e, color):: filter_duplicate l' (e:: seen_exp) | box:: l' -> box:: filter_duplicate l' seen_exp (* this case cannot happen*) in let rec subtract_allocated candidate_dangling = @@ -311,7 +311,7 @@ let rec dotty_mk_node pe sigma = Dotstruct((mk_coordinate (n + 1) lambda), e, l, e_color_str, te);] | (Sil.Hpointsto (e, _, _), lambda) -> let e_color_str = color_to_str (exp_color e) in - if IList.mem Exp.equal e !struct_exp_nodes then [] else + if List.mem ~equal:Exp.equal !struct_exp_nodes e then [] else [Dotpointsto((mk_coordinate n lambda), e, e_color_str)] | (Sil.Hlseg (k, hpara, e1, e2, _), lambda) -> incr dotty_state_count; (* increment once more n+1 is the box for last element of the list *) @@ -357,8 +357,8 @@ let compute_fields_struct sigma = let rec do_strexp se in_struct = match se with | Sil.Eexp (e, _) -> if in_struct then fields_structs:= e ::!fields_structs else () - | Sil.Estruct (l, _) -> IList.iter (fun e -> do_strexp e true) (snd (IList.split l)) - | Sil.Earray (_, l, _) -> IList.iter (fun e -> do_strexp e false) (snd (IList.split l)) in + | Sil.Estruct (l, _) -> IList.iter (fun e -> do_strexp e true) (snd (List.unzip l)) + | Sil.Earray (_, l, _) -> IList.iter (fun e -> do_strexp e false) (snd (List.unzip l)) in let rec fs s = match s with | [] -> () @@ -385,14 +385,16 @@ let is_nil e prop = let in_cycle cycle edge = match cycle with | Some cycle' -> - IList.mem (fun (fn, se) (_,fn',se') -> - Ident.equal_fieldname fn fn' && Sil.equal_strexp se se') edge cycle' + let (fn, se) = edge in + List.exists + ~f:(fun (_,fn',se') -> Ident.equal_fieldname fn fn' && Sil.equal_strexp se se') + cycle' | _ -> false let node_in_cycle cycle node = match cycle, node with | Some _, Dotstruct(_, _, l, _,_) -> (* only struct nodes can be in cycle *) - IList.exists (in_cycle cycle) l + List.exists ~f:(in_cycle cycle) l | _ -> false @@ -416,7 +418,7 @@ let rec compute_target_struct_fields dotnodes list_fld p f lambda cycle = ) | [node] | [Dotpointsto _ ; node] | [node; Dotpointsto _] -> let n = get_coordinate_id node in - if IList.mem Exp.equal e !struct_exp_nodes then begin + if List.mem ~equal:Exp.equal !struct_exp_nodes e then begin let e_no_special_char = strip_special_chars (Exp.to_string e) in let link_kind = if (in_cycle cycle (fn, se)) && (not !print_full_prop) then LinkRetainCycle @@ -452,7 +454,7 @@ let rec compute_target_array_elements dotnodes list_elements p f lambda = ) | [node] | [Dotpointsto _ ; node] | [node; Dotpointsto _] -> let n = get_coordinate_id node in - if IList.mem Exp.equal e !struct_exp_nodes then begin + if List.mem ~equal:Exp.equal !struct_exp_nodes e then begin let e_no_special_char = strip_special_chars (Exp.to_string e) in [(LinkArrayToStruct, Exp.to_string idx, n, e_no_special_char)] end else @@ -634,7 +636,7 @@ let filter_useless_spec_dollar_box (nodes: dotty_node list) (links: link list) = let tmp_links = ref links in let remove_links_from ln = IList.filter - (fun n' -> not (IList.mem equal_link n' ln)) + (fun n' -> not (List.mem ~equal:equal_link ln n')) !tmp_links in let remove_node n ns = IList.filter (fun n' -> match n' with @@ -1188,7 +1190,7 @@ let make_set_dangling_nodes allocated_nodes (sigma: Sil.hpred list) = | _ -> [] (* arrays and struct do not give danglings. CHECK THIS!*) ) in let is_not_allocated e = - let allocated = IList.exists (fun a -> match a with + let allocated = List.exists ~f:(fun a -> match a with | VH_pointsto(_, e', _, _) | VH_lseg(_, e', _ , _) | VH_dllseg(_, e', _, _, _, _) -> Exp.equal e e' @@ -1198,7 +1200,7 @@ let make_set_dangling_nodes allocated_nodes (sigma: Sil.hpred list) = match l with | [] -> [] | e:: l' -> - if (IList.exists (Exp.equal e) seen_exp) then filter_duplicate l' seen_exp + if (List.exists ~f:(Exp.equal e) seen_exp) then filter_duplicate l' seen_exp else e:: filter_duplicate l' (e:: seen_exp) in let rhs_exp_list = IList.flatten (IList.map get_rhs_predicate sigma) in let candidate_dangling_exps = filter_duplicate rhs_exp_list [] in @@ -1411,54 +1413,3 @@ let print_specs_xml signature specs loc fmt = ("line", string_of_int loc.Location.line)] [xml_signature; xml_specifications] in Io_infer.Xml.pp_document true fmt proc_summary - -(* -let exp_is_neq_zero e = - IList.exists (fun e' -> Exp.equal e e') !exps_neq_zero - -let rec get_contents_range_single pe coo f range_se = - let (e1, e2), se = range_se in - let e1_no_special_char = strip_special_chars (Exp.to_string e1) in - F.fprintf f "{ <%s> [%a,%a] : %a }" - e1_no_special_char (Sil.pp_exp_printenv pe) e1 (Sil.pp_exp_printenv pe) e2 (get_contents_sexp pe coo) se - -and get_contents_range pe coo f = function - | [] -> () - | [range_se] -> - F.fprintf f "%a" (get_contents_range_single pe coo) range_se - | range_se:: l -> - F.fprintf f "%a | %a" - (get_contents_range_single pe coo) range_se (get_contents_range pe coo) l - -let pp_nesting fmt nesting = - if nesting > 1 then F.fprintf fmt "%d" nesting - -let max_map f l = - let curr_max = ref 0 in - IList.iter (fun x -> curr_max := max !curr_max (f x)) l; - ! curr_max - -let rec sigma_nesting_level sigma = - max_map (function - | Sil.Hpointsto _ -> 0 - | Sil.Hlseg (_, hpara, _, _, _) -> hpara_nesting_level hpara - | Sil.Hdllseg (_, hpara_dll, _, _, _, _, _) -> hpara_dll_nesting_level hpara_dll) sigma - -and hpara_nesting_level hpara = - 1 + sigma_nesting_level hpara.Sil.body - -and hpara_dll_nesting_level hpara_dll = - 1 + sigma_nesting_level hpara_dll.Sil.body_dll - -let rec get_color_exp dot_nodes e = - match dot_nodes with - | [] ->"" - | Dotnil(_):: l' -> get_color_exp l' e - | Dotpointsto(_, e', c):: l' - | Dotdangling(_, e', c):: l' - | Dotarray(_, _, e', _, _, c):: l' - | Dotlseg(_, e', _, _, _, c):: l' - | Dotstruct(_, e', _, c, _):: l' - | Dotdllseg(_, e', _, _, _, _, _, c):: l' -> - if (Exp.equal e e') then c else get_color_exp l' e -*) diff --git a/infer/src/backend/errdesc.ml b/infer/src/backend/errdesc.ml index f4bf9efab..4145e3aa1 100644 --- a/infer/src/backend/errdesc.ml +++ b/infer/src/backend/errdesc.ml @@ -19,7 +19,7 @@ module DExp = DecompiledExp let vector_class = ["std"; "vector"] let is_one_of_classes class_name classes = - IList.exists (fun wrapper_class -> + List.exists ~f:(fun wrapper_class -> IList.for_all (fun wrapper_class_substring -> String.is_substring ~substring:wrapper_class_substring class_name) wrapper_class) classes @@ -100,7 +100,7 @@ let find_nullify_after_instr node instr pvar : bool = | instr_ -> if Sil.equal_instr instr instr_ then found_instr := true; false in - IList.exists find_nullify node_instrs + List.exists ~f:find_nullify node_instrs (** Find the other prune node of a conditional (e.g. the false branch given the true branch of a conditional) *) @@ -198,7 +198,7 @@ let rec find_boolean_assignment node pvar true_branch : Procdesc.Node.t option = | Sil.Store (Exp.Lvar _pvar, _, Exp.Const (Const.Cint i), _) when Pvar.equal pvar _pvar -> IntLit.iszero i <> true_branch | _ -> false in - IList.exists filter (Procdesc.Node.get_instrs n) in + List.exists ~f:filter (Procdesc.Node.get_instrs n) in match Procdesc.Node.get_preds node with | [pred_node] -> find_boolean_assignment pred_node pvar true_branch | [n1; n2] -> @@ -235,7 +235,7 @@ let rec _find_normal_variable_load tenv (seen : Exp.Set.t) node id : DExp.t opti let fun_dexp = DExp.Dconst (Const.Cfun pname) in let args_dexp = let args_dexpo = IList.map (fun (e, _) -> _exp_rv_dexp tenv seen node e) args in - if IList.exists is_none args_dexpo + if List.exists ~f:is_none args_dexpo then [] else let unNone = function Some x -> x | None -> assert false in @@ -300,7 +300,7 @@ and _exp_lv_dexp tenv (_seen : Exp.Set.t) node e : DExp.t option = | Some (fun_exp, eargs, loc, call_flags) -> let fun_dexpo = _exp_rv_dexp tenv seen node' fun_exp in let blame_args = IList.map (_exp_rv_dexp tenv seen node') eargs in - if IList.exists is_none (fun_dexpo:: blame_args) then None + if List.exists ~f:is_none (fun_dexpo:: blame_args) then None else let unNone = function Some x -> x | None -> assert false in let args = IList.map unNone blame_args in @@ -631,7 +631,7 @@ let vpath_find tenv prop _exp : DExp.t option * Typ.t option = let filter = function | (ni, Exp.Var id') -> Ident.is_normal ni && Ident.equal id' id | _ -> false in - IList.exists filter (Sil.sub_to_list prop.Prop.sub) in + List.exists ~f:filter (Sil.sub_to_list prop.Prop.sub) in function | Sil.Hpointsto (Exp.Lvar pv, sexp, texp) when (Pvar.is_local pv || Pvar.is_global pv || Pvar.is_seed pv) -> diff --git a/infer/src/backend/infer.ml b/infer/src/backend/infer.ml index e7e51cbf1..bd4f82920 100644 --- a/infer/src/backend/infer.ml +++ b/infer/src/backend/infer.ml @@ -128,7 +128,7 @@ let clean_results_dir () = let rec cleandir dir = match Unix.readdir dir with | entry -> - if (IList.exists (String.equal entry) dirs) then ( + if (List.exists ~f:(String.equal entry) dirs) then ( rmtree (name ^/ entry) ) else if not (String.equal entry Filename.current_dir_name || String.equal entry Filename.parent_dir_name) then ( @@ -140,7 +140,7 @@ let clean_results_dir () = cleandir dir ) | exception Unix.Unix_error (Unix.ENOTDIR, _, _) -> - if IList.exists (Filename.check_suffix name) suffixes then + if List.exists ~f:(Filename.check_suffix name) suffixes then Unix.unlink name | exception Unix.Unix_error (Unix.ENOENT, _, _) -> () in diff --git a/infer/src/backend/inferconfig.ml b/infer/src/backend/inferconfig.ml index e20beb92e..f791088e8 100644 --- a/infer/src/backend/inferconfig.ml +++ b/infer/src/backend/inferconfig.ml @@ -46,11 +46,11 @@ type filter_config = let is_matching patterns = fun source_file -> let path = SourceFile.to_rel_path source_file in - IList.exists - (fun pattern -> - try - Int.equal (Str.search_forward pattern path 0) 0 - with Not_found -> false) + List.exists + ~f:(fun pattern -> + try + Int.equal (Str.search_forward pattern path 0) 0 + with Not_found -> false) patterns @@ -132,11 +132,11 @@ module FileOrProcMatcher = struct and method_name = Procname.java_get_method pname_java in try let class_patterns = String.Map.find_exn pattern_map class_name in - IList.exists - (fun p -> - match p.method_name with - | None -> true - | Some m -> String.equal m method_name) + List.exists + ~f:(fun p -> + match p.method_name with + | None -> true + | Some m -> String.equal m method_name) class_patterns with Not_found -> false in @@ -200,7 +200,7 @@ module OverridesMatcher = struct is_subtype mp.class_name && (Option.value_map ~f:(match_method language proc_name) ~default:false mp.method_name) | _ -> failwith "Expecting method pattern" in - IList.exists is_matching patterns + List.exists ~f:is_matching patterns end @@ -233,8 +233,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 = List.exists ~f:(String.equal key) ["class"; "method"] + and is_source_contains key = List.exists ~f:(String.equal key) ["source_contains"] in let rec loop = function | [] -> Error ("Unknown pattern for " ^ json_key ^ " in " ^ Config.inferconfig_file) @@ -334,7 +334,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 (List.exists ~f:(String.equal error_str) inferconfig.suppress_errors) in { path_filter = path_filter; error_filter = error_filter; @@ -349,10 +349,10 @@ let create_filters analyzer = (* Decide whether a checker or error type is enabled or disabled based on*) (* white/black listing in .inferconfig and the default value *) let is_checker_enabled checker_name = - match IList.mem String.(=) checker_name Config.disable_checks, - IList.mem String.(=) checker_name Config.enable_checks with + match List.mem ~equal:String.(=) Config.disable_checks checker_name, + List.mem ~equal:String.(=) Config.enable_checks checker_name with | false, false -> (* if it's not amond white/black listed then we use default value *) - not (IList.mem String.(=) checker_name Config.checks_disabled_by_default) + not (List.mem ~equal:String.(=) Config.checks_disabled_by_default checker_name) | true, false -> (* if it's blacklisted and not whitelisted then it should be disabled *) false | false, true -> (* if it is not blacklisted and it is whitelisted then it should be enabled *) diff --git a/infer/src/backend/interproc.ml b/infer/src/backend/interproc.ml index fe10fd23e..bf9904c63 100644 --- a/infer/src/backend/interproc.ml +++ b/infer/src/backend/interproc.ml @@ -369,7 +369,7 @@ let check_assignement_guard pdesc node = let is_call = function | Sil.Call _ -> true | _ -> false in - IList.exists is_call instrs in + List.exists ~f:is_call instrs in let is_set_instr i = match i with | Sil.Store _ -> true @@ -626,7 +626,7 @@ let get_fld_typ_path_opt src_exps sink_exp_ reachable_hpreds_ = (lhs, (Some fld, typ) :: path, reachable_hpreds') with Not_found -> (sink_exp, path, reachable_hpreds)) | Sil.Hpointsto (lhs, Sil.Earray (_, elems, _), Exp.Sizeof (typ, _, _)) -> - if IList.exists (fun pair -> strexp_matches sink_exp pair) elems + if List.exists ~f:(fun pair -> strexp_matches sink_exp pair) elems then let reachable_hpreds' = Sil.HpredSet.remove hpred reachable_hpreds in (* None means "no field name" ~=~ nameless array index *) @@ -1235,8 +1235,8 @@ let update_specs tenv proc_name phase (new_specs : Specs.NormSpec.t list) SpecMap.empty old_specs) in let re_exe_filter old_spec = (* filter out pres which failed re-exe *) if Specs.equal_phase phase Specs.RE_EXECUTION && - not (IList.exists - (fun new_spec -> Specs.Jprop.equal new_spec.Specs.pre old_spec.Specs.pre) + not (List.exists + ~f:(fun new_spec -> Specs.Jprop.equal new_spec.Specs.pre old_spec.Specs.pre) new_specs) then begin changed:= true; diff --git a/infer/src/backend/match.ml b/infer/src/backend/match.ml index 34a04be23..99e29c9d0 100644 --- a/infer/src/backend/match.ml +++ b/infer/src/backend/match.ml @@ -16,7 +16,7 @@ module L = Logging module F = Format let mem_idlist i l = - IList.exists (Ident.equal i) l + List.exists ~f:(Ident.equal i) l (** Type for a hpred pattern. flag=false means that the implication between hpreds is not considered, and flag = true means that it is @@ -87,9 +87,9 @@ let exp_list_match es1 sub vars es2 = let f res_acc (e1, e2) = match res_acc with | None -> None | Some (sub_acc, vars_leftover) -> exp_match e1 sub_acc vars_leftover e2 in - let es_combined = try IList.combine es1 es2 with Invalid_argument _ -> assert false in - let es_match_res = IList.fold_left f (Some (sub, vars)) es_combined - in es_match_res + Option.find_map + ~f:(fun es_combined -> IList.fold_left f (Some (sub, vars)) es_combined) + (List.zip es1 es2) (** Checks sexp1 = sexp2[sub ++ sub'] for some sub' with dom(sub') subseteq vars. Returns (sub ++ sub', vars - dom(sub')). @@ -140,7 +140,7 @@ and isel_match isel1 sub vars isel2 = | [], _ | _, [] -> None | (idx1, se1') :: isel1', (idx2, se2') :: isel2' -> let idx2 = Sil.exp_sub sub idx2 in - let sanity_check = not (IList.exists (fun id -> Sil.ident_in_exp id idx2) vars) in + let sanity_check = not (List.exists ~f:(fun id -> Sil.ident_in_exp id idx2) vars) in if (not sanity_check) then begin let pe = Pp.text in L.out "@[.... Sanity Check Failure while Matching Index-Strexps ....@."; @@ -158,13 +158,6 @@ and isel_match isel1 sub vars isel2 = (* extends substitution sub by creating a new substitution for vars *) let sub_extend_with_ren (sub: Sil.subst) vars = - (* - let check_precondition () = - let dom = Sil.sub_domain sub in - let overlap = IList.exists (fun id -> IList.exists (Ident.equal id) dom) vars in - if overlap then assert false in - check_precondition (); - *) let f id = (id, Exp.Var (Ident.create_fresh Ident.kprimed)) in let renaming_for_vars = Sil.sub_of_list (IList.map f vars) in Sil.sub_join sub renaming_for_vars @@ -187,7 +180,7 @@ let rec instantiate_to_emp p condition sub vars = function else match hpat.hpred with | Sil.Hpointsto _ | Sil.Hlseg (Sil.Lseg_NE, _, _, _, _) | Sil.Hdllseg (Sil.Lseg_NE, _, _, _, _, _, _) -> None | Sil.Hlseg (_, _, e1, e2, _) -> - let fully_instantiated = not (IList.exists (fun id -> Sil.ident_in_exp id e1) vars) + let fully_instantiated = not (List.exists ~f:(fun id -> Sil.ident_in_exp id e1) vars) in if (not fully_instantiated) then None else let e1' = Sil.exp_sub sub e1 in begin @@ -198,7 +191,7 @@ let rec instantiate_to_emp p condition sub vars = function end | Sil.Hdllseg (_, _, iF, oB, oF, iB, _) -> let fully_instantiated = - not (IList.exists (fun id -> Sil.ident_in_exp id iF || Sil.ident_in_exp id oB) vars) + not (List.exists ~f:(fun id -> Sil.ident_in_exp id iF || Sil.ident_in_exp id oB) vars) in if (not fully_instantiated) then None else let iF' = Sil.exp_sub sub iF in let oB' = Sil.exp_sub sub oB @@ -294,7 +287,8 @@ let rec iter_match_with_impl tenv iter condition sub vars hpat hpats = | Sil.Hlseg (k2, para2, e_start2, e_end2, es_shared2) -> let filter = gen_filter_lseg k2 para2 e_start2 e_end2 es_shared2 in let do_emp_lseg _ = - let fully_instantiated_start2 = not (IList.exists (fun id -> Sil.ident_in_exp id e_start2) vars) in + let fully_instantiated_start2 = + not (List.exists ~f:(fun id -> Sil.ident_in_exp id e_start2) vars) in if (not fully_instantiated_start2) then None else let e_start2' = Sil.exp_sub sub e_start2 in @@ -327,7 +321,7 @@ let rec iter_match_with_impl tenv iter condition sub vars hpat hpats = | None -> None | Some (sub_res, p_leftover) when condition p_leftover sub_res -> let not_in_para2_exist_vars id = - not (IList.exists (fun id' -> Ident.equal id id') para2_exist_vars) in + not (List.exists ~f:(fun id' -> Ident.equal id id') para2_exist_vars) in let sub_res' = Sil.sub_filter not_in_para2_exist_vars sub_res in Some (sub_res', p_leftover) | Some _ -> None @@ -352,7 +346,7 @@ let rec iter_match_with_impl tenv iter condition sub vars hpat hpats = let filter = gen_filter_dllseg k2 para2 iF2 oB2 oF2 iB2 es_shared2 in let do_emp_dllseg _ = let fully_instantiated_iFoB2 = - not (IList.exists (fun id -> Sil.ident_in_exp id iF2 || Sil.ident_in_exp id oB2) vars) + not (List.exists ~f:(fun id -> Sil.ident_in_exp id iF2 || Sil.ident_in_exp id oB2) vars) in if (not fully_instantiated_iFoB2) then None else let iF2' = Sil.exp_sub sub iF2 in let oB2' = Sil.exp_sub sub oB2 @@ -366,7 +360,7 @@ let rec iter_match_with_impl tenv iter condition sub vars hpat hpats = let p = Prop.prop_iter_to_prop tenv iter in prop_match_with_impl_sub tenv p condition sub_new vars_leftover hpat_next hpats_rest in let do_para_dllseg _ = - let fully_instantiated_iF2 = not (IList.exists (fun id -> Sil.ident_in_exp id iF2) vars) + let fully_instantiated_iF2 = not (List.exists ~f:(fun id -> Sil.ident_in_exp id iF2) vars) in if (not fully_instantiated_iF2) then None else let iF2' = Sil.exp_sub sub iF2 in match exp_match iF2' sub vars iB2 with @@ -384,7 +378,7 @@ let rec iter_match_with_impl tenv iter condition sub vars hpat hpats = | None -> None | Some (sub_res, p_leftover) when condition p_leftover sub_res -> let not_in_para2_exist_vars id = - not (IList.exists (fun id' -> Ident.equal id id') para2_exist_vars) in + not (List.exists ~f:(fun id' -> Ident.equal id id') para2_exist_vars) in let sub_res' = Sil.sub_filter not_in_para2_exist_vars sub_res in Some (sub_res', p_leftover) | Some _ -> None @@ -413,7 +407,7 @@ and prop_match_with_impl_sub tenv p condition sub vars hpat hpats = and hpara_common_match_with_impl tenv impl_ok ids1 sigma1 eids2 ids2 sigma2 = try let sub_ids = - let ren_ids = IList.combine ids2 ids1 in + let ren_ids = List.zip_exn ids2 ids1 in let f (id2, id1) = (id2, Exp.Var id1) in IList.map f ren_ids in let (sub_eids, eids_fresh) = @@ -558,7 +552,7 @@ let corres_extend_front e1 e2 corres = let corres_extensible corres e1 e2 = let predicate (e1', e2') = (Exp.equal e1 e1') || (Exp.equal e2 e2') - in not (IList.exists predicate corres) && not (Exp.equal e1 e2) + in not (List.exists ~f:predicate corres) && not (Exp.equal e1 e2) let corres_related corres e1 e2 = let filter (e1', e2') = (Exp.equal e1 e1') || (Exp.equal e2 e2') in @@ -639,7 +633,7 @@ let rec generic_find_partial_iso tenv mode update corres sigma_corres todos sigm let new_sigma2 = hpred2 :: sigma2 in (new_sigma1, new_sigma2) in let new_todos = - let shared12 = IList.combine shared1 shared2 in + let shared12 = List.zip_exn shared1 shared2 in (root1, root2) :: (next1, next2) :: shared12 @ todos' in generic_find_partial_iso tenv mode update new_corres new_sigma_corres new_todos new_sigma_todo with Invalid_argument _ -> None) @@ -657,7 +651,7 @@ let rec generic_find_partial_iso tenv mode update corres sigma_corres todos sigm let new_sigma2 = hpred2 :: sigma2 in (new_sigma1, new_sigma2) in let new_todos = - let shared12 = IList.combine shared1 shared2 in + let shared12 = List.zip_exn shared1 shared2 in (iF1, iF2):: (oB1, oB2):: (oF1, oF2):: (iB1, iB2):: shared12@todos' in generic_find_partial_iso tenv mode update new_corres new_sigma_corres new_todos new_sigma_todo with Invalid_argument _ -> None) @@ -724,7 +718,7 @@ let generic_para_create tenv corres sigma1 elist1 = let add_fresh_id pair = (pair, Ident.create_fresh Ident.kprimed) in IList.map add_fresh_id new_corres' in let (es_shared, ids_shared, ids_exists) = - let not_in_elist1 ((e1, _), _) = not (IList.exists (Exp.equal e1) elist1) in + let not_in_elist1 ((e1, _), _) = not (List.exists ~f:(Exp.equal e1) elist1) in let corres_ids_no_elist1 = IList.filter not_in_elist1 corres_ids in let should_be_shared ((e1, e2), _) = Exp.equal e1 e2 in let shared, exists = IList.partition should_be_shared corres_ids_no_elist1 in diff --git a/infer/src/backend/preanal.ml b/infer/src/backend/preanal.ml index bc9832c47..379868e77 100644 --- a/infer/src/backend/preanal.ml +++ b/infer/src/backend/preanal.ml @@ -23,7 +23,7 @@ let add_dispatch_calls pdesc cg tenv = | Sil.Call (_, _, _, _, call_flags) -> call_flags_is_dispatch call_flags | _ -> false in let has_dispatch_call instrs = - IList.exists instr_is_dispatch_call instrs in + List.exists ~f:instr_is_dispatch_call instrs in let replace_dispatch_calls = function | Sil.Call (ret_id, (Exp.Const (Const.Cfun callee_pname) as call_exp), (((_, receiver_typ) :: _) as args), loc, call_flags) as instr @@ -71,7 +71,7 @@ let add_abstraction_instructions pdesc = | Node.Exit_node _ -> true | _ -> false in let succ_nodes = Node.get_succs node in - if IList.exists is_exit succ_nodes then true + if List.exists ~f:is_exit succ_nodes then true else match succ_nodes with | [] -> false | [h] -> IList.length (Node.get_preds h) > 1 diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index 2a70d7698..5c4a61798 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -1285,13 +1285,13 @@ module Normalize = struct when IntLit.isone i -> let lower = Exp.int (n -- IntLit.one) in let a_lower : Sil.atom = Aeq (BinOp (Lt, lower, Var id), Exp.one) in - if not (IList.mem Sil.equal_atom a_lower p.pi) then a' + if not (List.mem ~equal:Sil.equal_atom p.pi a_lower) then a' else Aeq (Var id, Exp.int n) | Aeq (BinOp (Lt, Const (Cint n), Var id), Const (Cint i)) when IntLit.isone i -> let upper = Exp.int (n ++ IntLit.one) in let a_upper : Sil.atom = Aeq (BinOp (Le, Var id, upper), Exp.one) in - if not (IList.mem Sil.equal_atom a_upper p.pi) then a' + if not (List.mem ~equal:Sil.equal_atom p.pi a_upper) then a' else Aeq (Var id, upper) | Aeq (BinOp (Ne, e1, e2), Const (Cint i)) when IntLit.isone i -> Aneq (e1, e2) @@ -1427,7 +1427,7 @@ module Normalize = struct | _ -> acc in IList.fold_left get_disequality_info [] nonineq_list in let is_neq e n = - IList.exists (fun (e', n') -> Exp.equal e e' && IntLit.eq n n') diseq_list in + List.exists ~f:(fun (e', n') -> Exp.equal e e' && IntLit.eq n n') diseq_list in let le_list_tightened = let get_le_inequality_info acc a = match atom_exp_le_const a with @@ -1469,11 +1469,11 @@ module Normalize = struct (fun (a : Sil.atom) -> match a with | Aneq (Const (Cint n), e) | Aneq (e, Const (Cint n)) -> - (not (IList.exists - (fun (e', n') -> Exp.equal e e' && IntLit.lt n' n) + (not (List.exists + ~f:(fun (e', n') -> Exp.equal e e' && IntLit.lt n' n) le_list_tightened)) && - (not (IList.exists - (fun (n', e') -> Exp.equal e e' && IntLit.leq n n') + (not (List.exists + ~f:(fun (n', e') -> Exp.equal e e' && IntLit.leq n n') lt_list_tightened)) | _ -> true) nonineq_list in @@ -1503,7 +1503,7 @@ module Normalize = struct let unsigned_exps = lazy (sigma_get_unsigned_exps sigma) in function | Aneq ((Var _) as e, Const (Cint n)) when IntLit.isnegative n -> - not (IList.exists (Exp.equal e) (Lazy.force unsigned_exps)) + not (List.exists ~f:(Exp.equal e) (Lazy.force unsigned_exps)) | Aneq (e1, e2) -> not (syntactically_different (e1, e2)) | Aeq (Const c1, Const c2) -> @@ -1556,7 +1556,7 @@ module Normalize = struct (** Conjoin a pure atomic predicate by normal conjunction. *) let rec prop_atom_and tenv ?(footprint=false) (p : normal t) a : normal t = let a' = normalize_and_strengthen_atom tenv p a in - if IList.mem Sil.equal_atom a' p.pi then p + if List.mem ~equal:Sil.equal_atom p.pi a' then p else begin let p' = match a' with @@ -1896,7 +1896,7 @@ let apply_reindexing tenv subst prop = let npi = Normalize.pi_normalize tenv subst nsigma prop.pi in let nsub, atoms = let dom_subst = IList.map fst (Sil.sub_to_list subst) in - let in_dom_subst id = IList.exists (Ident.equal id) dom_subst in + let in_dom_subst id = List.exists ~f:(Ident.equal id) dom_subst in let sub' = Sil.sub_filter (fun id -> not (in_dom_subst id)) prop.sub in let contains_substituted_id e = Sil.fav_exists (Sil.exp_fav e) in_dom_subst in let sub_eqs, sub_keep = Sil.sub_range_partition contains_substituted_id sub' in @@ -2115,13 +2115,13 @@ let prop_ren_sub tenv (ren_sub: Sil.subst) (prop: normal t) : normal t = [fav] should not contain any primed variables. *) let exist_quantify tenv fav (prop : normal t) : normal t = let ids = Sil.fav_to_list fav in - if IList.exists Ident.is_primed ids then assert false; (* sanity check *) + if List.exists ~f:Ident.is_primed ids then assert false; (* sanity check *) if List.is_empty ids then prop else let gen_fresh_id_sub id = (id, Exp.Var (Ident.create_fresh Ident.kprimed)) in let ren_sub = Sil.sub_of_list (IList.map gen_fresh_id_sub ids) in let prop' = (* throw away x=E if x becomes _x *) - let mem_idlist i = IList.exists (fun id -> Ident.equal i id) in + let mem_idlist i = List.exists ~f:(fun id -> Ident.equal i id) in let sub = Sil.sub_filter (fun i -> not (mem_idlist i ids)) prop.sub in if Sil.equal_subst sub prop.sub then prop else unsafe_cast_to_normal (set prop ~sub) in @@ -2182,12 +2182,11 @@ let prop_rename_fav_with_existentials tenv (p : normal t) : normal t = (** Removes seeds variables from a prop corresponding to captured variables in an objc block *) let remove_seed_captured_vars_block tenv captured_vars prop = - let is_captured pname vn = Mangled.equal pname vn in let hpred_seed_captured = function | Sil.Hpointsto (Exp.Lvar pv, _, _) -> let pname = Pvar.get_name pv in - (Pvar.is_seed pv) && (IList.mem is_captured pname captured_vars) + (Pvar.is_seed pv) && (List.mem ~equal:Mangled.equal captured_vars pname) | _ -> false in let sigma = prop.sigma in let sigma' = diff --git a/infer/src/backend/propgraph.ml b/infer/src/backend/propgraph.ml index 0fb2a0d95..f7ab1359e 100644 --- a/infer/src/backend/propgraph.ml +++ b/infer/src/backend/propgraph.ml @@ -193,7 +193,7 @@ let compute_diff default_color oldgraph newgraph : diff = () in IList.iter build_changed newedges; let colormap (o: Obj.t) = - if IList.exists (fun x -> phys_equal x o) !changed then Pp.Red + if List.exists ~f:(fun x -> phys_equal x o) !changed then Pp.Red else default_color in !changed, colormap in let changed_norm, colormap_norm = compute_changed false in diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index cd6aa1ec2..cac9951c7 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -129,7 +129,7 @@ end = struct let remove_redundancy constraints = let constraints' = sort_then_remove_redundancy constraints in - IList.filter (fun entry -> IList.exists (equal entry) constraints') constraints + IList.filter (fun entry -> List.exists ~f:(equal entry) constraints') constraints let rec combine acc_todos acc_seen constraints_new constraints_old = match constraints_new, constraints_old with @@ -442,11 +442,11 @@ end = struct (* [ sizeof(t1) - sizeof(t2) <= -1 ] *) check_type_size_lt t1 t2 | e, Exp.Const (Const.Cint n) -> (* [e <= n' <= n |- e <= n] *) - IList.exists (function + List.exists ~f:(function | e', Exp.Const (Const.Cint n') -> Exp.equal e e' && IntLit.leq n' n | _, _ -> false) leqs | Exp.Const (Const.Cint n), e -> (* [ n-1 <= n' < e |- n <= e] *) - IList.exists (function + List.exists ~f:(function | Exp.Const (Const.Cint n'), e' -> Exp.equal e e' && IntLit.leq (n -- IntLit.one) n' | _, _ -> false) lts | _ -> Exp.equal e1 e2 @@ -457,11 +457,11 @@ end = struct match e1, e2 with | Exp.Const (Const.Cint n1), Exp.Const (Const.Cint n2) -> IntLit.lt n1 n2 | Exp.Const (Const.Cint n), e -> (* [n <= n' < e |- n < e] *) - IList.exists (function + List.exists ~f:(function | Exp.Const (Const.Cint n'), e' -> Exp.equal e e' && IntLit.leq n n' | _, _ -> false) lts | e, Exp.Const (Const.Cint n) -> (* [e <= n' <= n-1 |- e < n] *) - IList.exists (function + List.exists ~f:(function | e', Exp.Const (Const.Cint n') -> Exp.equal e e' && IntLit.leq n' (n -- IntLit.one) | _, _ -> false) leqs | _ -> false @@ -469,7 +469,7 @@ end = struct (** Check [prop |- e1!=e2]. Result [false] means "don't know". *) let check_ne ineq _e1 _e2 = let e1, e2 = if Exp.compare _e1 _e2 <= 0 then _e1, _e2 else _e2, _e1 in - IList.exists (exp_pair_eq (e1, e2)) ineq.neqs || check_lt ineq e1 e2 || check_lt ineq e2 e1 + List.exists ~f:(exp_pair_eq (e1, e2)) ineq.neqs || check_lt ineq e1 e2 || check_lt ineq e2 e1 (** Find a IntLit.t n such that [t |- e<=n] if possible. *) let compute_upper_bound { leqs = leqs; lts = _; neqs = _ } e1 = @@ -510,9 +510,9 @@ end = struct check_le ineq e1 e2 && check_le ineq e2 e1 in let inconsistent_leq (e1, e2) = check_lt ineq e2 e1 in let inconsistent_lt (e1, e2) = check_le ineq e2 e1 in - IList.exists inconsistent_neq neqs || - IList.exists inconsistent_leq leqs || - IList.exists inconsistent_lt lts + List.exists ~f:inconsistent_neq neqs || + List.exists ~f:inconsistent_leq leqs || + List.exists ~f:inconsistent_lt lts (* (** Pretty print inequalities and disequalities *) @@ -558,7 +558,7 @@ let check_equal tenv prop e1 e2 = let eq = Sil.Aeq(n_e1, n_e2) in let n_eq = Prop.atom_normalize_prop tenv prop eq in let pi = prop.Prop.pi in - IList.exists (Sil.equal_atom n_eq) pi in + List.exists ~f:(Sil.equal_atom n_eq) pi in check_equal () || check_equal_const () || check_equal_pi () (** Check [ |- e=0]. Result [false] means "don't know". *) @@ -767,7 +767,7 @@ let check_atom tenv prop a0 = when IntLit.isone i -> check_lt_normalized tenv prop e1 e2 | Sil.Aeq (e1, e2) -> check_equal tenv prop e1 e2 | Sil.Aneq (e1, e2) -> check_disequal tenv prop e1 e2 - | Sil.Apred _ | Anpred _ -> IList.exists (Sil.equal_atom a) prop.Prop.pi + | Sil.Apred _ | Anpred _ -> List.exists ~f:(Sil.equal_atom a) prop.Prop.pi (** Check [prop |- e1<=e2]. Result [false] means "don't know". *) let check_le tenv prop e1 e2 = @@ -794,7 +794,7 @@ let check_allocatedness tenv prop e = is_root tenv prop iF n_e <> None || is_root tenv prop iB n_e <> None else false - in IList.exists f spatial_part + in List.exists ~f spatial_part (** Compute an upper bound of an expression *) let compute_upper_bound_of_exp tenv p e = @@ -882,7 +882,7 @@ let check_inconsistency_base tenv prop = Pvar.is_seed pv && (is_java_this pv || is_cpp_this pv || is_objc_instance_self pv) | _ -> false in - IList.exists do_hpred sigma in + List.exists ~f:do_hpred sigma in let inconsistent_atom = function | Sil.Aeq (e1, e2) -> (match e1, e2 with @@ -905,7 +905,7 @@ let check_inconsistency_base tenv prop = Inequalities.inconsistent ineq in inconsistent_ptsto () || check_inconsistency_two_hpreds tenv prop - || IList.exists inconsistent_atom pi + || List.exists ~f:inconsistent_atom pi || inconsistent_inequalities () || inconsistent_this_self_var () @@ -1638,7 +1638,7 @@ let get_overrides_of tenv supertype pname = | Tstruct name -> ( match Tenv.lookup tenv name with | Some { methods } -> - IList.exists (fun m -> Procname.equal pname m) methods + List.exists ~f:(fun m -> Procname.equal pname m) methods | None -> false ) @@ -1724,7 +1724,7 @@ let handle_parameter_subtype tenv prop1 sigma2 subs (e1, se1, texp1) (se2, texp2 let filter = function | Sil.Hpointsto(e', _, _) -> Exp.equal e' e | _ -> false in - IList.exists filter prop1.Prop.sigma in + List.exists ~f:filter prop1.Prop.sigma in let type_rhs e = let sub_opt = ref None in let filter = function @@ -1732,7 +1732,7 @@ let handle_parameter_subtype tenv prop1 sigma2 subs (e1, se1, texp1) (se2, texp2 sub_opt := Some (t, len, sub); true | _ -> false in - if IList.exists filter sigma2 then !sub_opt else None in + if List.exists ~f:filter sigma2 then !sub_opt else None in let add_subtype () = match texp1, texp2, se1, se2 with | Exp.Sizeof (Tptr (t1, _), None, _), Exp.Sizeof (Tptr (t2, _), None, _), Sil.Eexp (e1', _), Sil.Eexp (e2', _) diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index 11193a5f0..45d825a09 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -296,7 +296,7 @@ and array_case_analysis_index pname tenv orig_prop if not (Typ.equal typ_cont t' || List.is_empty array_cont) then raise (Exceptions.Bad_footprint __POS__) in let index_in_array = - IList.exists (fun (i, _) -> Prover.check_equal tenv Prop.prop_emp index i) array_cont in + List.exists ~f:(fun (i, _) -> Prover.check_equal tenv Prop.prop_emp index i) array_cont in let array_is_full = match array_len with | Exp.Const (Const.Cint n') -> IntLit.geq (IntLit.of_int (IList.length array_cont)) n' @@ -396,7 +396,7 @@ let strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se typ off' inst in let atoms_se_typ_list_filtered = let check_neg_atom atom = Prover.check_atom tenv Prop.prop_emp (Prover.atom_negate tenv atom) in - let check_not_inconsistent (atoms, _, _) = not (IList.exists check_neg_atom atoms) in + let check_not_inconsistent (atoms, _, _) = not (List.exists ~f:check_neg_atom atoms) in IList.filter check_not_inconsistent atoms_se_typ_list in if Config.trace_rearrange then L.d_strln "exiting strexp_extend_values"; let len, st = match te with @@ -805,10 +805,10 @@ let add_guarded_by_constraints tenv prop lexp pdesc = (guarded_by_str_is_current_class guarded_by_str pname && Procdesc.is_java_synchronized pdesc && Procname.java_is_static pname) || (* or the prop says we already have the lock *) - IList.exists - (function - | Sil.Apred (Alocked, _) -> true - | _ -> false) + List.exists + ~f:(function + | Sil.Apred (Alocked, _) -> true + | _ -> false) (Attribute.get_for_exp tenv prop guarded_by_exp) in let guardedby_is_self_referential = String.equal "itself" (String.lowercase guarded_by_str) || @@ -824,19 +824,19 @@ let add_guarded_by_constraints tenv prop lexp pdesc = (where f is not the @GuardedBy field!), we will not warn. *) let is_accessible_through_local_ref exp = - IList.exists - (function - | Sil.Hpointsto (Lvar _, Eexp (rhs_exp, _), _) -> - Exp.equal exp rhs_exp - | Sil.Hpointsto (_, Estruct (flds, _), _) -> - IList.exists - (fun (fld, strexp) -> match strexp with - | Sil.Eexp (rhs_exp, _) -> - Exp.equal exp rhs_exp && not (Ident.equal_fieldname fld accessed_fld) - | _ -> - false) - flds - | _ -> false) + List.exists + ~f:(function + | Sil.Hpointsto (Lvar _, Eexp (rhs_exp, _), _) -> + Exp.equal exp rhs_exp + | Sil.Hpointsto (_, Estruct (flds, _), _) -> + List.exists + ~f:(fun (fld, strexp) -> match strexp with + | Sil.Eexp (rhs_exp, _) -> + Exp.equal exp rhs_exp && not (Ident.equal_fieldname fld accessed_fld) + | _ -> + false) + flds + | _ -> false) prop.Prop.sigma in Procdesc.get_access pdesc <> PredSymb.Private && not (Annotations.pdesc_return_annot_ends_with pdesc Annotations.visibleForTesting) && @@ -1266,7 +1266,7 @@ let is_weak_captured_var pdesc pvar = | Typ.Tptr (_, Pk_objc_weak) -> Mangled.equal (Pvar.get_name pvar) var | _ -> false in - IList.exists is_weak_captured (Procdesc.get_captured pdesc) + List.exists ~f:is_weak_captured (Procdesc.get_captured pdesc) | _ -> false @@ -1299,7 +1299,7 @@ let check_dereference_error tenv pdesc (prop : Prop.normal Prop.t) lexp loc = nullable_obj_str := Some (Procname.to_string pname); true | _ -> false in - IList.exists is_nullable_attr (Attribute.get_for_exp tenv prop exp) in + List.exists ~f:is_nullable_attr (Attribute.get_for_exp tenv prop exp) in (* it's ok for a non-nullable local to point to deref_exp *) is_nullable || Pvar.is_local pvar | Sil.Hpointsto (_, Sil.Estruct (flds, _), Exp.Sizeof (typ, _, _)) -> @@ -1407,7 +1407,7 @@ let check_call_to_objc_block_error tenv pdesc prop fun_exp loc = match get_exp_called () with | Some (_, Exp.Lvar pvar) -> (* pvar is the block *) let name = Pvar.get_name pvar in - IList.exists (fun (cn, _) -> (Mangled.equal name cn)) (Procdesc.get_captured pdesc) + List.exists ~f:(fun (cn, _) -> (Mangled.equal name cn)) (Procdesc.get_captured pdesc) | _ -> false in let is_field_deref () = (*Called expression is a field *) match get_exp_called () with diff --git a/infer/src/backend/state.ml b/infer/src/backend/state.ml index 7a039bcdc..eb5356453 100644 --- a/infer/src/backend/state.ml +++ b/infer/src/backend/state.ml @@ -214,7 +214,7 @@ let mk_find_duplicate_nodes proc_desc : (Procdesc.Node.t -> Procdesc.NodeSet.t) | _ -> raise Not_found in let duplicates = let equal_normalized_instrs (_, normalized_instrs') = - IList.equal Sil.compare_instr node_normalized_instrs normalized_instrs' in + List.equal ~equal:Sil.equal_instr node_normalized_instrs normalized_instrs' in IList.filter equal_normalized_instrs elements in IList.fold_left (fun nset (node', _) -> Procdesc.NodeSet.add node' nset) diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index d50a18620..c949120da 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -59,7 +59,7 @@ let check_block_retain_cycle tenv caller_pname prop block_nullified = let block_captured = match AttributesTable.load_attributes block_pname with | Some attributes -> - fst (IList.split attributes.ProcAttributes.captured) + fst (List.unzip attributes.ProcAttributes.captured) | None -> [] in let prop' = Prop.remove_seed_captured_vars_block tenv block_captured prop in @@ -370,7 +370,7 @@ let dangerous_functions = ref ((IList.map Procname.from_string_c_fun) dangerous_list) let check_inherently_dangerous_function caller_pname callee_pname = - if IList.exists (Procname.equal callee_pname) !dangerous_functions then + if List.exists ~f:(Procname.equal callee_pname) !dangerous_functions then let exn = Exceptions.Inherently_dangerous_function (Localise.desc_inherently_dangerous_function callee_pname) in @@ -474,7 +474,7 @@ let check_deallocate_static_memory prop_after = let method_exists right_proc_name methods = if Config.curr_language_is Config.Java then - IList.exists (fun meth_name -> Procname.equal right_proc_name meth_name) methods + List.exists ~f:(fun meth_name -> Procname.equal right_proc_name meth_name) methods else (* ObjC/C++ case : The attribute map will only exist when we have code for the method or the method has been called directly somewhere. It can still be that this is not the case but we have a model for the method. *) @@ -570,7 +570,7 @@ let resolve_virtual_pname tenv prop actuals callee_pname call_flags : Procname.t let resolved_pname = do_resolve callee_pname receiver_exp actual_receiver_typ in let feasible_targets = IList.filter may_dispatch_to targets in (* make sure [resolved_pname] is not a duplicate *) - if IList.mem Procname.equal resolved_pname feasible_targets + if List.mem ~equal:Procname.equal feasible_targets resolved_pname then feasible_targets else resolved_pname :: feasible_targets else @@ -806,10 +806,10 @@ let add_constraints_on_retval tenv pdesc prop ret_exp ~has_nullable_annot typ ca let is_rec_call pname = (* TODO: (t7147096) extend this to detect mutual recursion *) Procname.equal pname (Procdesc.get_proc_name pdesc) in let already_has_abduced_retval p abduced_ret_pv = - IList.exists - (fun hpred -> match hpred with - | Sil.Hpointsto (Exp.Lvar pv, _, _) -> Pvar.equal pv abduced_ret_pv - | _ -> false) + List.exists + ~f:(fun hpred -> match hpred with + | Sil.Hpointsto (Exp.Lvar pv, _, _) -> Pvar.equal pv abduced_ret_pv + | _ -> false) p.Prop.sigma_fp in (* find an hpred [abduced] |-> A in [prop] and add [exp] = A to prop *) let bind_exp_to_abduced_val exp_to_bind abduced prop = @@ -1264,10 +1264,10 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call let abduced_ref_pv = Pvar.mk_abduced_ref_param callee_pname actual_pv callee_loc in let already_has_abduced_retval p = - IList.exists - (fun hpred -> match hpred with - | Sil.Hpointsto (Exp.Lvar pv, _, _) -> Pvar.equal pv abduced_ref_pv - | _ -> false) + List.exists + ~f:(fun hpred -> match hpred with + | Sil.Hpointsto (Exp.Lvar pv, _, _) -> Pvar.equal pv abduced_ref_pv + | _ -> false) p.Prop.sigma_fp in (* prevent introducing multiple abduced retvals for a single call site in a loop *) if already_has_abduced_retval prop then prop @@ -1332,7 +1332,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 = List.mem ~equal:Int.equal attrs.ProcAttributes.const_formals i in if is_const then ( L.d_str (Printf.sprintf "Not havocing const argument number %d: " i); Sil.d_exp e; @@ -1621,7 +1621,7 @@ and sym_exec_wrapper handle_exn tenv pdesc instr ((prop: Prop.normal Prop.t), pa let instr_is_abstraction = function | Sil.Abstract _ -> true | _ -> false in - IList.exists instr_is_abstraction (Procdesc.Node.get_instrs node) in + List.exists ~f:instr_is_abstraction (Procdesc.Node.get_instrs node) in let curr_node = State.get_node () in match Procdesc.Node.get_kind curr_node with | Procdesc.Node.Prune_node _ when not (node_has_abstraction curr_node) -> diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index 993b7b292..29982ad8d 100644 --- a/infer/src/backend/tabulation.ml +++ b/infer/src/backend/tabulation.ml @@ -624,7 +624,7 @@ let prop_is_exn pname prop = | Sil.Hpointsto (e1, Sil.Eexp(e2, _), _) when Exp.equal e1 ret_pvar -> exp_is_exn e2 | _ -> false in - IList.exists is_exn prop.Prop.sigma + List.exists ~f:is_exn prop.Prop.sigma (** when prop is an exception, return the exception name *) let prop_get_exn_name pname prop = @@ -728,7 +728,7 @@ let combine tenv | Sil.Aeq (Exp.Var id', Exp.Const (Const.Cint i)) -> Ident.equal id id' && IntLit.isnull i | _ -> false in - IList.exists filter split.missing_pi in + List.exists ~f:filter split.missing_pi in let f (e, inst_opt) = match e, inst_opt with | Exp.Var id, Some inst when id_assigned_to_null id -> let inst' = Sil.inst_set_null_case_flag inst in @@ -789,7 +789,7 @@ let combine tenv else Some post_p3 in post_p4 in let _results = IList.map (fun (p, path) -> (compute_result p, path)) instantiated_post in - if IList.exists (fun (x, _) -> is_none x) _results then (* at least one combine failed *) + if List.exists ~f:(fun (x, _) -> is_none x) _results then (* at least one combine failed *) None else let results = @@ -889,19 +889,19 @@ let mk_posts tenv ret_id prop callee_pname callee_attrs posts = nullness. meant to eliminate false NPE warnings from the common "if (get() != null) get().something()" pattern *) let last_call_ret_non_null = - IList.exists - (function - | Sil.Apred (Aretval (pname, _), [exp]) when Procname.equal callee_pname pname -> - Prover.check_disequal tenv prop exp Exp.zero - | _ -> false) + List.exists + ~f:(function + | Sil.Apred (Aretval (pname, _), [exp]) when Procname.equal callee_pname pname -> + Prover.check_disequal tenv prop exp Exp.zero + | _ -> false) (Attribute.get_all prop) in if last_call_ret_non_null then let returns_null prop = - IList.exists - (function - | Sil.Hpointsto (Exp.Lvar pvar, Sil.Eexp (e, _), _) when Pvar.is_return pvar -> - Prover.check_equal tenv (Prop.normalize tenv prop) e Exp.zero - | _ -> false) + List.exists + ~f:(function + | Sil.Hpointsto (Exp.Lvar pvar, Sil.Eexp (e, _), _) when Pvar.is_return pvar -> + Prover.check_equal tenv (Prop.normalize tenv prop) e Exp.zero + | _ -> false) prop.Prop.sigma in IList.filter (fun (prop, _) -> not (returns_null prop)) posts else posts in @@ -977,8 +977,8 @@ let do_taint_check tenv caller_pname callee_pname calling_prop missing_pi sub ac let not_untaint_atom atom = not (Exp.Map.exists (fun _ (_, untaint_atoms) -> - IList.exists - (fun a -> Sil.equal_atom atom a) + List.exists + ~f:(fun a -> Sil.equal_atom atom a) untaint_atoms) taint_untaint_exp_map) in check_taint_on_variadic_function tenv callee_pname caller_pname actual_params calling_prop; @@ -1197,9 +1197,9 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re assert false else (* no dereference error detected *) let desc = - if IList.exists (function Cannot_combine -> true | _ -> false) invalid_res then + if List.exists ~f:(function Cannot_combine -> true | _ -> false) invalid_res then call_desc (Some Localise.Pnm_dangling) - else if IList.exists (function + else if List.exists ~f:(function | Prover_checks (check :: _) -> trace_call Specs.CallStats.CR_not_met; let exn = get_check_exn tenv check callee_pname loc __POS__ in @@ -1307,27 +1307,3 @@ let exe_function_call formal_params in let results = IList.map exe_one_spec spec_list in exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc results - -(* -let check_splitting_precondition sub1 sub2 = - let dom1 = Sil.sub_domain sub1 in - let rng1 = Sil.sub_range sub1 in - let dom2 = Sil.sub_domain sub2 in - let rng2 = Sil.sub_range sub2 in - let overlap = IList.exists (fun id -> IList.exists (Ident.equal id) dom1) dom2 in - if overlap then begin - L.d_str "Dom(Sub1): "; Sil.d_exp_list (IList.map (fun id -> Exp.Var id) dom1); L.d_ln (); - L.d_str "Ran(Sub1): "; Sil.d_exp_list rng1; L.d_ln (); - L.d_str "Dom(Sub2): "; Sil.d_exp_list (IList.map (fun id -> Exp.Var id) dom2); L.d_ln (); - L.d_str "Ran(Sub2): "; Sil.d_exp_list rng2; L.d_ln (); - assert false - end - -(** check whether 0|->- occurs in sigma *) -let sigma_has_null_pointer sigma = - let hpred_null_pointer = function - | Sil.Hpointsto (e, _, _) -> - Exp.equal e Exp.zero - | _ -> false in - IList.exists hpred_null_pointer sigma -*) diff --git a/infer/src/backend/taint.ml b/infer/src/backend/taint.ml index aa8223e8e..38590d62c 100644 --- a/infer/src/backend/taint.ml +++ b/infer/src/backend/taint.ml @@ -355,8 +355,8 @@ let has_taint_annotation fieldname (struct_typ: StructTyp.t) = let fld_has_taint_annot (fname, _, annot) = Ident.equal_fieldname fieldname fname && (Annotations.ia_is_privacy_source annot || Annotations.ia_is_integrity_source annot) in - IList.exists fld_has_taint_annot struct_typ.fields || - IList.exists fld_has_taint_annot struct_typ.statics + List.exists ~f:fld_has_taint_annot struct_typ.fields || + List.exists ~f:fld_has_taint_annot struct_typ.statics (* add tainting attributes to a list of paramenters *) let get_params_to_taint tainted_param_nums formal_params = diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index 3fbb648b7..716f37789 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/infer/src/base/CommandLineOption.ml @@ -117,7 +117,7 @@ let xdesc {long; short; spec; doc} = (* translate Symbol to String for better formatting of --help messages *) | Symbol (symbols, action) -> String (fun arg -> - if IList.mem String.equal arg symbols then + if List.mem ~equal:String.equal symbols arg then action arg else raise (Arg.Bad (F.sprintf "wrong argument '%s'; option '%s' expects one of: %s" @@ -226,7 +226,7 @@ let add exes desc = full_desc_list := desc :: !full_desc_list ; IList.iter (fun (exe, desc_list) -> let desc = - if IList.mem equal_exe exe exes then + if List.mem ~equal:equal_exe exes exe then desc else {desc with meta = ""; doc = ""} in diff --git a/infer/src/base/DB.ml b/infer/src/base/DB.ml index d28c2c870..71e5d9fdb 100644 --- a/infer/src/base/DB.ml +++ b/infer/src/base/DB.ml @@ -217,8 +217,8 @@ let global_tenv_fname = filename_concat captured_dir basename let is_source_file path = - IList.exists - (fun ext -> Filename.check_suffix path ext) + List.exists + ~f:(fun ext -> Filename.check_suffix path ext) Config.source_file_extentions let infer_start_time = lazy diff --git a/infer/src/base/IList.ml b/infer/src/base/IList.ml index 5258ce670..235a8b496 100644 --- a/infer/src/base/IList.ml +++ b/infer/src/base/IList.ml @@ -9,9 +9,6 @@ type 'a t = 'a list [@@deriving compare] -let equal cmp l1 l2 = - compare cmp l1 l2 = 0 - let exists = List.exists let filter = List.filter let find = List.find @@ -48,27 +45,6 @@ let fold_lefti (f : 'a -> int -> 'b -> 'a) a l = fold_left (fun (i, acc) e -> i +1, f acc i e) (0, a) l |> snd -(** tail-recursive variant of List.combine *) -let combine = - let rec combine acc l1 l2 = match l1, l2 with - | [], [] -> acc - | x1:: l1, x2:: l2 -> combine ((x1, x2):: acc) l1 l2 - | [], _:: _ - | _:: _, [] -> raise (Invalid_argument "IList.combine") in - fun l1 l2 -> rev (combine [] l1 l2) - -(** tail-recursive variant of List.split *) -let split = - let rec split acc1 acc2 = function - | [] -> (acc1, acc2) - | (x, y):: l -> split (x:: acc1) (y:: acc2) l in - fun l -> - let acc1, acc2 = split [] [] l in - rev acc1, rev acc2 - -(** Like List.mem but without builtin equality *) -let mem equal x l = exists (equal x) l - (** tail-recursive variant of List.flatten *) let flatten = let rec flatten acc l = match l with @@ -88,10 +64,6 @@ let rec drop_first n = function let drop_last n list = rev (drop_first n (rev list)) -(** tail-recursive variant of List.append *) -let append l1 l2 = - rev_append (rev l1) l2 - (** tail-recursive variant of List.map *) let map f l = rev (rev_map f l) diff --git a/infer/src/base/IList.mli b/infer/src/base/IList.mli index cf68d8076..02c399b75 100644 --- a/infer/src/base/IList.mli +++ b/infer/src/base/IList.mli @@ -9,16 +9,6 @@ type 'a t = 'a list [@@deriving compare] -(** Generic equality of lists given a compare function for the elements of the list *) -val equal : ('a -> 'a -> int) -> 'a list -> 'a list -> bool - -(** tail-recursive variant of List.append *) -val append : 'a list -> 'a list -> 'a list - -(** tail-recursive variant of List.combine *) -val combine : 'a list -> 'b list -> ('a * 'b) list - -val exists : ('a -> bool) -> 'a list -> bool val filter : ('a -> bool) -> 'a list -> 'a list (** tail-recursive variant of List.flatten *) @@ -56,9 +46,6 @@ val filter_changed : ('a -> bool) -> 'a list -> 'a list (** tail-recursive variant of List.mapi *) val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list -(** Like List.mem but without builtin equality *) -val mem : ('a -> 'b -> bool) -> 'a -> 'b list -> bool - val nth : 'a list -> int -> 'a val partition : ('a -> bool) -> 'a list -> 'a list * 'a list val rev : 'a list -> 'a list @@ -66,9 +53,6 @@ val rev_append : 'a list -> 'a list -> 'a list val rev_map : ('a -> 'b) -> 'a list -> 'b list val sort : ('a -> 'a -> int) -> 'a list -> 'a list -(** tail-recursive variant of List.split *) -val split : ('a * 'b) list -> 'a list * 'b list - val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list val tl : 'a list -> 'a list diff --git a/infer/src/base/SourceFile.ml b/infer/src/base/SourceFile.ml index 611588b0d..63d0d5c4a 100644 --- a/infer/src/base/SourceFile.ml +++ b/infer/src/base/SourceFile.ml @@ -126,7 +126,7 @@ let of_header header_file = let header_exts = ["h"; "hh"; "hpp"; "hxx"] in let file_no_ext, ext_opt = Filename.split_extension abs_path in let file_opt = match ext_opt with - | Some ext when IList.mem String.equal ext header_exts -> ( + | Some ext when List.mem ~equal:String.equal header_exts ext -> ( let possible_files = IList.map (fun ext -> file_no_ext ^ "." ^ ext) source_exts in try Some (IList.find path_exists possible_files) with Not_found -> None diff --git a/infer/src/bufferoverrun/bufferOverrunDomain.ml b/infer/src/bufferoverrun/bufferOverrunDomain.ml index 78b0cfa1b..db0f436cc 100644 --- a/infer/src/bufferoverrun/bufferOverrunDomain.ml +++ b/infer/src/bufferoverrun/bufferOverrunDomain.ml @@ -377,7 +377,7 @@ struct let get_symbols : t -> Itv.Symbol.t list = fun x -> - IList.append (Itv.get_symbols x.itv) (ArrayBlk.get_symbols x.arrayblk) + List.append (Itv.get_symbols x.itv) (ArrayBlk.get_symbols x.arrayblk) let normalize : t -> t = fun x -> diff --git a/infer/src/bufferoverrun/bufferOverrunSemantics.ml b/infer/src/bufferoverrun/bufferOverrunSemantics.ml index f40d541d1..42e91e41c 100644 --- a/infer/src/bufferoverrun/bufferOverrunSemantics.ml +++ b/infer/src/bufferoverrun/bufferOverrunSemantics.ml @@ -11,7 +11,6 @@ *) open! IStd -open Core_kernel.Fn open AbsLoc module F = Format @@ -69,7 +68,7 @@ struct | Exp.Lfield (e, fn, _) -> eval e mem loc |> Val.get_all_locs - |> flip PowLoc.append_field fn + |> Fn.flip PowLoc.append_field fn |> Val.of_pow_loc | Exp.Lindex (e1, _) -> let arr = eval e1 mem loc in (* must have array blk *) @@ -342,7 +341,7 @@ struct let new_matching = get_matching_pairs tenv formal actual typ caller_mem callee_entry_mem in - IList.append new_matching l + List.append new_matching l in let formals = get_formals callee_pdesc in let actuals = IList.map (fun (a, _) -> eval a caller_mem loc) params in diff --git a/infer/src/bufferoverrun/itv.ml b/infer/src/bufferoverrun/itv.ml index 6ebf89849..dd2cf81c8 100644 --- a/infer/src/bufferoverrun/itv.ml +++ b/infer/src/bufferoverrun/itv.ml @@ -807,7 +807,7 @@ struct let get_symbols : t -> Symbol.t list = fun (l, u) -> - IList.append (Bound.get_symbols l) (Bound.get_symbols u) + List.append (Bound.get_symbols l) (Bound.get_symbols u) let normalize : t -> t option = fun (l, u) -> diff --git a/infer/src/checkers/Siof.ml b/infer/src/checkers/Siof.ml index 9dd34429a..65c28b7b3 100644 --- a/infer/src/checkers/Siof.ml +++ b/infer/src/checkers/Siof.ml @@ -151,8 +151,8 @@ let report_siof trace pdesc gname loc = Reporting.log_error caller_pname ~loc ~ltr exn in let has_foreign_sink (_, path) = - IList.exists - (fun (sink, _) -> + List.exists + ~f:(fun (sink, _) -> GlobalsAccesses.exists (is_foreign tu_opt) (SiofTrace.Sink.kind sink)) path in diff --git a/infer/src/checkers/ThreadSafety.ml b/infer/src/checkers/ThreadSafety.ml index 65dd4eb6a..898005b67 100644 --- a/infer/src/checkers/ThreadSafety.ml +++ b/infer/src/checkers/ThreadSafety.ml @@ -434,7 +434,8 @@ let is_immutable_collection_class class_name tenv = ] in PatternMatch.supertype_exists tenv - (fun typename _ -> IList.mem String.equal (Typename.name typename) immutable_collections) + (fun typename _ -> + List.mem ~equal:String.equal immutable_collections (Typename.name typename)) class_name let is_call_to_builder_class_method = function @@ -555,7 +556,7 @@ let get_current_class_and_threadsafe_superclasses tenv pname = let calculate_addendum_message tenv pname = match get_current_class_and_threadsafe_superclasses tenv pname with | Some (current_class,thread_safe_annotated_classes) -> - if not (IList.mem Typename.equal current_class thread_safe_annotated_classes) then + if not (List.mem ~equal:Typename.equal thread_safe_annotated_classes current_class) then match thread_safe_annotated_classes with | hd::_ -> F.asprintf "\n Note: Superclass %a is marked @ThreadSafe." Typename.pp hd | [] -> "" @@ -623,8 +624,8 @@ let should_report_on_file file_env = fun (_, tenv, pname, _) -> PatternMatch.check_current_class_attributes Annotations.ia_is_not_thread_safe tenv pname in - not (IList.exists current_class_marked_not_threadsafe file_env) && - IList.exists current_class_or_super_marked_threadsafe file_env + not (List.exists ~f:current_class_marked_not_threadsafe file_env) && + List.exists ~f:current_class_or_super_marked_threadsafe file_env (* For now, just checks if there is one active element amongst the posts of the analyzed methods. This indicates that the method races with itself. To be refined later. *) diff --git a/infer/src/checkers/annotations.ml b/infer/src/checkers/annotations.ml index be0c97060..2aaefd9f7 100644 --- a/infer/src/checkers/annotations.ml +++ b/infer/src/checkers/annotations.ml @@ -69,11 +69,11 @@ type annotated_signature = { } [@@deriving compare] let ia_has_annotation_with (ia: Annot.Item.t) (predicate: Annot.t -> bool): bool = - IList.exists (fun (a, _) -> predicate a) ia + List.exists ~f:(fun (a, _) -> predicate a) ia let ma_has_annotation_with ((ia, ial) : Annot.Method.t) (predicate: Annot.t -> bool): bool = let has_annot a = ia_has_annotation_with a predicate in - has_annot ia || IList.exists has_annot ial + has_annot ia || List.exists ~f:has_annot ial (** [annot_ends_with annot ann_name] returns true if the class name of [annot], without the package, is equal to [ann_name] *) @@ -86,10 +86,10 @@ let class_name_matches s ((annot : Annot.t), _) = String.equal s annot.class_name let ia_ends_with ia ann_name = - IList.exists (fun (a, _) -> annot_ends_with a ann_name) ia + List.exists ~f:(fun (a, _) -> annot_ends_with a ann_name) ia let ia_contains ia ann_name = - IList.exists (class_name_matches ann_name) ia + List.exists ~f:(class_name_matches ann_name) ia let ia_get ia ann_name = try Some (fst (IList.find (class_name_matches ann_name) ia)) @@ -97,7 +97,7 @@ let ia_get ia ann_name = let pdesc_has_parameter_annot pdesc predicate = let _, param_annotations = (Procdesc.get_attributes pdesc).ProcAttributes.method_annotation in - IList.exists predicate param_annotations + List.exists ~f:predicate param_annotations let pdesc_get_return_annot pdesc = fst (Procdesc.get_attributes pdesc).ProcAttributes.method_annotation @@ -118,8 +118,8 @@ let pname_has_return_annot pname ~attrs_of_pname predicate = let field_has_annot fieldname (struct_typ : StructTyp.t) predicate = let fld_has_taint_annot (fname, _, annot) = Ident.equal_fieldname fieldname fname && predicate annot in - IList.exists fld_has_taint_annot struct_typ.fields || - IList.exists fld_has_taint_annot struct_typ.statics + List.exists ~f:fld_has_taint_annot struct_typ.fields || + List.exists ~f:fld_has_taint_annot struct_typ.statics let struct_typ_has_annot (struct_typ : StructTyp.t) predicate = predicate struct_typ.annots @@ -143,8 +143,8 @@ let ia_is_present ia = ia_ends_with ia present let ia_is_nonnull ia = - IList.exists - (ia_ends_with ia) + List.exists + ~f:(ia_ends_with ia) [nonnull; notnull; camel_nonnull] let ia_is_false_on_null ia = @@ -179,15 +179,15 @@ let field_injector_readonly_list = (** Annotations for readonly injectors. The injector framework initializes the field but does not write null into it. *) let ia_is_field_injector_readonly ia = - IList.exists - (ia_ends_with ia) + List.exists + ~f:(ia_ends_with ia) field_injector_readonly_list (** Annotations for read-write injectors. The injector framework initializes the field and can write null into it. *) let ia_is_field_injector_readwrite ia = - IList.exists - (ia_ends_with ia) + List.exists + ~f:(ia_ends_with ia) field_injector_readwrite_list let ia_is_mutable ia = @@ -316,8 +316,8 @@ let annotated_signature_is_anonymous_inner_class_wrapper ann_sig proc_name = (** Check if the given parameter has a Nullable annotation in the given signature *) let param_is_nullable pvar ann_sig = - IList.exists - (fun (param, annot, _) -> + List.exists + ~f:(fun (param, annot, _) -> Mangled.equal param (Pvar.get_name pvar) && ia_is_nullable annot) ann_sig.params diff --git a/infer/src/checkers/checkTraceCallSequence.ml b/infer/src/checkers/checkTraceCallSequence.ml index 8ebff4898..421b25a0c 100644 --- a/infer/src/checkers/checkTraceCallSequence.ml +++ b/infer/src/checkers/checkTraceCallSequence.ml @@ -58,10 +58,10 @@ module APIs = struct false let is_begin pn = let filter (pkgname, cname, begin_name, _) = method_match pn pkgname cname begin_name in - IList.exists filter tracing_methods + List.exists ~f:filter tracing_methods let is_end pn = let filter (pkgname, cname, _, end_name) = method_match pn pkgname cname end_name in - IList.exists filter tracing_methods + List.exists ~f:filter tracing_methods let is_begin_or_end pn = is_begin pn || is_end pn end @@ -228,7 +228,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 List.mem ~equal:String.equal boolean_variables name then Some name else None | _ -> None diff --git a/infer/src/checkers/checkers.ml b/infer/src/checkers/checkers.ml index 0d64ca31d..fa1e41d0f 100644 --- a/infer/src/checkers/checkers.ml +++ b/infer/src/checkers/checkers.ml @@ -99,7 +99,7 @@ module ST = struct let is_parameter_suppressed = String.is_suffix a.class_name ~suffix:Annotations.suppress_lint && - IList.mem normalized_equal kind a.parameters in + List.mem ~equal:normalized_equal a.parameters kind in let is_annotation_suppressed = String.is_suffix ~suffix:(normalize (drop_prefix kind)) (normalize a.class_name) in @@ -341,7 +341,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } = | _ -> false in let is_formal_param exp = - IList.exists (equal_formal_param exp) (Lazy.force class_formal_names) in + List.exists ~f:(equal_formal_param exp) (Lazy.force class_formal_names) in let is_nullcheck pn = match pn with | Procname.Java pn_java -> diff --git a/infer/src/checkers/immutableChecker.ml b/infer/src/checkers/immutableChecker.ml index ca1e14253..90e07a16d 100644 --- a/infer/src/checkers/immutableChecker.ml +++ b/infer/src/checkers/immutableChecker.ml @@ -24,7 +24,7 @@ let check_immutable_cast tenv curr_pname curr_pdesc typ_expected typ_found_opt l "java.util.Set", "com.google.common.collect.ImmutableSet" ] in let in_casts expected given = - IList.exists (fun (x, y) -> + List.exists ~f:(fun (x, y) -> String.equal (Typename.name expected) x && String.equal (Typename.name given) y ) casts in diff --git a/infer/src/checkers/patternMatch.ml b/infer/src/checkers/patternMatch.ml index 116543a94..b2c07103c 100644 --- a/infer/src/checkers/patternMatch.ml +++ b/infer/src/checkers/patternMatch.ml @@ -39,7 +39,7 @@ let java_proc_name_with_class_method pn_java class_with_path method_name = let rec supertype_exists tenv pred name = match Tenv.lookup tenv name with | Some ({supers} as struct_typ) -> - pred name struct_typ || IList.exists (fun name -> supertype_exists tenv pred name) supers + pred name struct_typ || List.exists ~f:(fun name -> supertype_exists tenv pred name) supers | None -> false @@ -56,7 +56,7 @@ let rec supertype_find_map_opt tenv f name = let is_immediate_subtype tenv this_type_name super_type_name = match Tenv.lookup tenv this_type_name with - | Some {supers} -> IList.exists (Typename.equal super_type_name) supers + | Some {supers} -> List.exists ~f:(Typename.equal super_type_name) supers | None -> false (** return true if [typ0] <: [typ1] *) @@ -99,7 +99,7 @@ let type_get_annotation tenv (typ: Typ.t): Annot.Item.t option = | _ -> None let type_has_direct_supertype tenv (typ : Typ.t) (class_name : Typename.t) = - IList.exists (fun cn -> Typename.equal cn class_name) (type_get_direct_supertypes tenv typ) + List.exists ~f:(fun cn -> Typename.equal cn class_name) (type_get_direct_supertypes tenv typ) let type_has_supertype (tenv: Tenv.t) @@ -114,12 +114,12 @@ let type_has_supertype let match_name () = Typename.equal cn class_name in let has_indirect_supertype () = has_supertype (Typ.Tstruct cn) (Typ.Set.add typ visited) in (match_name () || has_indirect_supertype ()) in - IList.exists match_supertype supers in + List.exists ~f:match_supertype supers in has_supertype typ Typ.Set.empty let type_is_nested_in_direct_supertype tenv t n = let is_nested_in cn1 cn2 = String.is_prefix ~prefix:(Typename.name cn1 ^ "$") (Typename.name cn2) in - IList.exists (is_nested_in n) (type_get_direct_supertypes tenv t) + List.exists ~f:(is_nested_in n) (type_get_direct_supertypes tenv t) let rec get_type_name = function | Typ.Tstruct name -> @@ -274,7 +274,7 @@ let type_has_initializer (tenv: Tenv.t) (t: Typ.t): bool = let check_candidate class_name = type_has_supertype tenv t class_name in - IList.exists check_candidate initializer_classes + List.exists ~f:check_candidate initializer_classes (** Check if the method is one of the known initializer methods. *) let method_is_initializer @@ -286,7 +286,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 + List.exists ~f:(String.equal mname) initializer_methods | _ -> false else @@ -337,15 +337,15 @@ let override_exists f tenv proc_name = | Some ({ methods; supers; }) -> let is_override pname = Procname.equal pname super_proc_name && not (Procname.is_constructor pname) in - IList.exists (fun pname -> is_override pname && f pname) methods || - IList.exists (super_type_exists tenv) supers + List.exists ~f:(fun pname -> is_override pname && f pname) methods || + List.exists ~f:(super_type_exists tenv) supers | _ -> false in match proc_name with | Procname.Java proc_name_java -> let type_name = Typename.Java.from_string (Procname.java_get_class_name proc_name_java) in - IList.exists - (super_type_exists tenv) + List.exists + ~f:(super_type_exists tenv) (type_get_direct_supertypes tenv (Typ.Tstruct type_name)) | _ -> false (* Only java supported at the moment *) diff --git a/infer/src/checkers/printfArgs.ml b/infer/src/checkers/printfArgs.ml index af408b92f..ff12f4dc4 100644 --- a/infer/src/checkers/printfArgs.ml +++ b/infer/src/checkers/printfArgs.ml @@ -69,15 +69,15 @@ let format_type_matches_given_type (given_type: string): bool = match format_type with | "d" | "i" | "u" | "x" | "X" | "o" -> - IList.mem - String.equal - given_type + List.mem + ~equal:String.equal ["java.lang.Integer"; "java.lang.Long"; "java.lang.Short"; "java.lang.Byte"] - | "a" | "A" | "f" | "F" | "g" | "G" | "e" | "E" -> - IList.mem - String.equal given_type + | "a" | "A" | "f" | "F" | "g" | "G" | "e" | "E" -> + List.mem + ~equal:String.equal ["java.lang.Double"; "java.lang.Float"] + given_type | "c" -> 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/procCfg.ml b/infer/src/checkers/procCfg.ml index 0ab158eb2..597c01c7a 100644 --- a/infer/src/checkers/procCfg.ml +++ b/infer/src/checkers/procCfg.ml @@ -151,7 +151,7 @@ module Exceptional = struct let existing_exn_preds = try Procdesc.IdMap.find exn_succ_node_id exn_preds_acc with Not_found -> [] in - if not (IList.mem Procdesc.Node.equal n existing_exn_preds) + if not (List.mem ~equal:Procdesc.Node.equal existing_exn_preds n) then (* don't add duplicates *) Procdesc.IdMap.add exn_succ_node_id (n :: existing_exn_preds) exn_preds_acc else diff --git a/infer/src/checkers/sqlChecker.ml b/infer/src/checkers/sqlChecker.ml index c4f923f04..8119710b3 100644 --- a/infer/src/checkers/sqlChecker.ml +++ b/infer/src/checkers/sqlChecker.ml @@ -39,7 +39,7 @@ let callback_sql { Callbacks.proc_desc; proc_name; tenv } = let matches s r = Str.string_match r s 0 in match const_map node rvar1, const_map node rvar2 with | Some (Const.Cstr ""), Some (Const.Cstr s2) -> - if IList.exists (matches s2) sql_start then + if List.exists ~f:(matches s2) sql_start then begin L.stdout "%s%s@." diff --git a/infer/src/clang/ClangCommand.re b/infer/src/clang/ClangCommand.re index f2f4ada9c..03b3aabc5 100644 --- a/infer/src/clang/ClangCommand.re +++ b/infer/src/clang/ClangCommand.re @@ -51,7 +51,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 => List.exists f::(String.equal flag) orig_argv; let can_attach_ast_exporter cmd => has_flag cmd "-cc1" && ( @@ -122,7 +122,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 List.mem equal::String.equal flags_blacklist flag => 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 3602fae39..1e0859afe 100644 --- a/infer/src/clang/ComponentKit.ml +++ b/infer/src/clang/ComponentKit.ml @@ -55,7 +55,7 @@ let rec is_component_or_controller_descendant_impl decl = Does not recurse into hierarchy. *) and contains_ck_impl decl_list = - IList.exists is_component_or_controller_descendant_impl decl_list + List.exists ~f:is_component_or_controller_descendant_impl decl_list (** An easy way to fix the component kit best practice http://componentkit.org/docs/avoid-local-variables.html @@ -97,9 +97,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 + List.mem ~equal:String.equal cpp_whitelist ndi.ni_name | Some ObjCInterfaceDecl (_, ndi, _, _, _) -> - IList.mem String.equal ndi.ni_name objc_whitelist + List.mem ~equal:String.equal objc_whitelist ndi.ni_name | _ -> false in match an with @@ -172,14 +172,16 @@ 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 [ - ckcomponent_cl; - ckcomponentcontroller_cl; - "CKCompositeComponent"; - "CKStatefulViewComponent"; - "CKStatefulViewComponentController"; - "NTNativeTemplateComponent" - ] -> true + | Some name when List.mem ~equal:String.equal + [ + ckcomponent_cl; + ckcomponentcontroller_cl; + "CKCompositeComponent"; + "CKStatefulViewComponent"; + "CKStatefulViewComponentController"; + "NTNativeTemplateComponent" + ] + name -> true | _ -> false in let condition = is_component_or_controller_if (Some if_decl) @@ -359,7 +361,7 @@ let component_file_cyclomatic_complexity_info (context: CLintersContext.context) | Clang_ast_t.CXXCatchStmt _ | Clang_ast_t.ConditionalOperator _ -> true | Clang_ast_t.BinaryOperator (_, _, _, boi) -> - IList.mem (=) boi.Clang_ast_t.boi_kind [`LAnd; `LOr] + List.mem ~equal:(=) [`LAnd; `LOr] boi.Clang_ast_t.boi_kind | _ -> false in let cyclo_loc_opt an = match an with | CTL.Stmt stmt when (Config.compute_analytics diff --git a/infer/src/clang/cAst_utils.ml b/infer/src/clang/cAst_utils.ml index a4604728c..684e90947 100644 --- a/infer/src/clang/cAst_utils.ml +++ b/infer/src/clang/cAst_utils.ml @@ -291,7 +291,7 @@ let rec exists_eventually_st atomic_pred param st = if atomic_pred param st then true else let _, st_list = Clang_ast_proj.get_stmt_tuple st in - IList.exists (exists_eventually_st atomic_pred param) st_list + List.exists ~f:(exists_eventually_st atomic_pred param) st_list let is_syntactically_global_var decl = match decl with @@ -410,7 +410,7 @@ let rec is_objc_if_descendant ?(blacklist = default_blacklist) if_decl ancestors 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 + List.mem ~equal:String.equal some_list ndi.Clang_ast_t.ni_name 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/cContext.ml b/infer/src/clang/cContext.ml index 6a1e190ad..1206678b2 100644 --- a/infer/src/clang/cContext.ml +++ b/infer/src/clang/cContext.ml @@ -126,9 +126,9 @@ let add_block_static_var context block_name static_var_typ = (let new_static_vars, duplicate = try let static_vars = Procname.Map.find block_name outer_context.blocks_static_vars in - if IList.mem ( + if List.mem ~equal:( fun (var1, _) (var2, _) -> Pvar.equal var1 var2 - ) static_var_typ static_vars then + ) static_vars static_var_typ then static_vars, true else static_var_typ :: static_vars, false diff --git a/infer/src/clang/cFrontend_decl.ml b/infer/src/clang/cFrontend_decl.ml index 3f866919c..e313c46a9 100644 --- a/infer/src/clang/cFrontend_decl.ml +++ b/infer/src/clang/cFrontend_decl.ml @@ -176,7 +176,7 @@ struct List.hd qual_name |> Option.value_map ~default:false ~f:is_std_qual && List.is_prefix (List.rev qual_name) ~prefix:(List.rev rest) ~equal:qual_equal | _ -> List.equal ~equal:qual_equal whitelisted_method qual_name in - IList.exists method_matches whitelist + List.exists ~f:method_matches whitelist (** Given REVERSED list of method qualifiers (method_name::class_name::rest_quals), return whether method should be translated based on method and class whitelists *) diff --git a/infer/src/clang/cGeneral_utils.ml b/infer/src/clang/cGeneral_utils.ml index cecc4eea8..eb74097bd 100644 --- a/infer/src/clang/cGeneral_utils.ml +++ b/infer/src/clang/cGeneral_utils.ml @@ -32,7 +32,7 @@ let rec string_from_list l = let rec append_no_duplicates eq list1 list2 = match list2 with | el:: rest2 -> - if (IList.mem eq el list1) then + if (List.mem ~equal:eq list1 el) then (append_no_duplicates eq list1 rest2) else (append_no_duplicates eq list1 rest2)@[el] | [] -> list1 diff --git a/infer/src/clang/cLocation.ml b/infer/src/clang/cLocation.ml index bbfcbb68e..10870f8ad 100644 --- a/infer/src/clang/cLocation.ml +++ b/infer/src/clang/cLocation.ml @@ -24,8 +24,8 @@ let source_file_in_project source_file = let file_in_project = SourceFile.is_under_project_root source_file in let rel_source_file = SourceFile.to_string source_file in let file_should_be_skipped = - IList.exists - (fun path -> String.is_prefix ~prefix:path rel_source_file) + List.exists + ~f:(fun path -> String.is_prefix ~prefix:path rel_source_file) Config.skip_translation_headers in file_in_project && not (file_should_be_skipped) @@ -75,8 +75,8 @@ let should_translate_lib trans_unit_ctx source_range decl_trans_context ~transla let is_file_blacklisted file = let paths = Config.skip_clang_analysis_in_path in let is_file_blacklisted = - IList.exists - (fun path -> Str.string_match (Str.regexp ("^.*/" ^ path)) file 0) + List.exists + ~f:(fun path -> Str.string_match (Str.regexp ("^.*/" ^ path)) file 0) paths in is_file_blacklisted diff --git a/infer/src/clang/cPredicates.ml b/infer/src/clang/cPredicates.ml index 760d3fb83..ac6adfd39 100644 --- a/infer/src/clang/cPredicates.ml +++ b/infer/src/clang/cPredicates.ml @@ -92,7 +92,7 @@ let decl_ref_is_in names st = | Clang_ast_t.DeclRefExpr (_, _, _, drti) -> (match drti.drti_decl_ref with | Some dr -> let ndi, _, _ = CAst_utils.get_info_from_decl_ref dr in - IList.exists (String.equal ndi.ni_name) names + List.exists ~f:(String.equal ndi.ni_name) names | _ -> false) | _ -> false @@ -137,7 +137,7 @@ let is_ivar_atomic stmt = (match CAst_utils.get_decl ivar_pointer with | Some d -> let attributes = get_ivar_attributes d in - IList.exists (PVariant.(=) `Atomic) attributes + List.exists ~f:(PVariant.(=) `Atomic) attributes | _ -> false) | _ -> false diff --git a/infer/src/clang/cTL.ml b/infer/src/clang/cTL.ml index bce46307e..7d08e4e85 100644 --- a/infer/src/clang/cTL.ml +++ b/infer/src/clang/cTL.ml @@ -301,7 +301,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 + List.mem ~equal:String.equal tl an_str (* given a decl returns a stmt such that decl--->stmt via label trs *) let transition_decl_to_stmt d trs = @@ -437,7 +437,7 @@ and eval_EF phi an lcxt trans = eval_formula phi' an lcxt | None, _ -> eval_formula phi an lcxt - || IList.exists (fun an' -> eval_EF phi an' lcxt trans) (get_successor_nodes an) + || List.exists ~f:(fun an' -> eval_EF phi an' lcxt trans) (get_successor_nodes an) (* Evaluate phi on node an' such that an -l-> an'. False if an' does not exists *) and evaluate_on_transition phi an lcxt l = @@ -455,7 +455,7 @@ and eval_EX phi an lcxt trans = match trans, an with | Some _, _ -> evaluate_on_transition phi an lcxt trans | None, _ -> - IList.exists (fun an' -> eval_formula phi an' lcxt) (get_successor_nodes an) + List.exists ~f:(fun an' -> eval_formula phi an' lcxt) (get_successor_nodes an) (* an, lcxt |= E(phi1 U phi2) evaluated using the equivalence an, lcxt |= E(phi1 U phi2) <=> an, lcxt |= phi2 or (phi1 and EX(E(phi1 U phi2))) @@ -486,7 +486,7 @@ and in_node node_type_list phi an lctx = (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 + List.exists ~f:holds_for_one_node node_type_list (* Intuitive meaning: (an,lcxt) satifies EH[Classes] phi diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index c46d60699..631666465 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -133,8 +133,8 @@ struct let create_field_exp (var, typ) = let id = Ident.create_fresh Ident.knormal in id, Sil.Load (id, Exp.Lvar var, typ, loc) in - let ids, captured_instrs = IList.split (IList.map create_field_exp captured_vars) in - let fields_ids = IList.combine fields ids in + let ids, captured_instrs = List.unzip (IList.map create_field_exp captured_vars) in + let fields_ids = List.zip_exn fields ids in let set_fields = IList.map (fun ((f, t, _), id) -> Sil.Store (Exp.Lfield (Exp.Var id_block, f, block_type), t, Exp.Var id, loc)) fields_ids in (declare_block_local :: trans_res.instrs) @ @@ -807,7 +807,7 @@ struct let (sil_e2, _) = extract_exp_from_list res_trans_e2.exps "\nWARNING: Missing RHS operand in BinOp. Returning -1. Fix needed...\n" in let binop_res_trans, exp_to_parent = - if IList.exists (Exp.equal var_exp) res_trans_e2.initd_exps then [], [] + if List.exists ~f:(Exp.equal var_exp) res_trans_e2.initd_exps then [], [] else let exp_op, instr_bin = CArithmetic_trans.binary_operation_instruction @@ -1670,8 +1670,8 @@ struct (* by some constructor call, which we can tell by the fact that the index is returned *) (* in initd_exps, then we assume that all the indices were initialized and *) (* we don't need any assignments. *) - if IList.exists - ((fun arr index -> Exp.is_array_index_of index arr) var_exp) + if List.exists + ~f:((fun arr index -> Exp.is_array_index_of index arr) var_exp) initd_exps then [] else IList.map2 assign_instr lh rh_exps in @@ -1714,7 +1714,7 @@ struct let rhs_owning_method = CTrans_utils.is_owning_method ie in let _, instrs_assign = (* variable might be initialized already - do nothing in that case*) - if IList.exists (Exp.equal var_exp) res_trans_ie.initd_exps then ([], []) + if List.exists ~f:(Exp.equal var_exp) res_trans_ie.initd_exps then ([], []) else if !Config.arc_mode && (CTrans_utils.is_method_call ie || ObjcInterface_decl.is_pointer_to_objc_class ie_typ) @@ -1938,7 +1938,7 @@ struct let (sil_expr, _) = extract_exp_from_list res_trans_stmt.exps "WARNING: There should be only one return expression.\n" in - let ret_instrs = if IList.exists (Exp.equal ret_exp) res_trans_stmt.initd_exps + let ret_instrs = if List.exists ~f:(Exp.equal ret_exp) res_trans_stmt.initd_exps then [] else [Sil.Store (ret_exp, ret_type, sil_expr, sil_loc)] in let autorelease_instrs = @@ -2070,7 +2070,7 @@ struct let captured_block_vars = block_decl_info.Clang_ast_t.bdi_captured_variables in let captureds = CVar_decl.captured_vars_from_block_info context captured_block_vars in let ids_instrs = IList.map assign_captured_var captureds in - let ids, instrs = IList.split ids_instrs in + let ids, instrs = List.unzip ids_instrs in let block_data = (context, type_ptr, block_pname, captureds) in F.function_decl context.translation_unit_context context.tenv context.cfg context.cg decl (Some block_data); diff --git a/infer/src/clang/cTrans_models.ml b/infer/src/clang/cTrans_models.ml index 537f3076b..9873ede03 100644 --- a/infer/src/clang/cTrans_models.ml +++ b/infer/src/clang/cTrans_models.ml @@ -66,7 +66,7 @@ let is_modeled_builtin funct = String.equal funct CFrontend_config.builtin_memset_chk let is_modeled_attribute attr_name = - IList.mem String.equal attr_name CFrontend_config.modeled_function_attributes + List.mem ~equal:String.equal CFrontend_config.modeled_function_attributes attr_name let get_first_param_typedef_string_opt type_ptr = match CAst_utils.get_desugared_type type_ptr with diff --git a/infer/src/clang/objcProperty_decl.ml b/infer/src/clang/objcProperty_decl.ml index 87e37d11a..5aa2aad8e 100644 --- a/infer/src/clang/objcProperty_decl.ml +++ b/infer/src/clang/objcProperty_decl.ml @@ -19,13 +19,13 @@ open! IStd let is_strong_property obj_c_property_decl_info = let attrs = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in - IList.exists (fun a -> match a with + List.exists ~f:(fun a -> match a with | `Strong -> true | _ -> false) attrs let is_assign_property obj_c_property_decl_info = let attrs = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in - IList.exists (fun a -> match a with + List.exists ~f:(fun a -> match a with | `Assign -> true | _ -> false) attrs diff --git a/infer/src/eradicate/eradicateChecks.ml b/infer/src/eradicate/eradicateChecks.ml index 485d04983..4322d77d4 100644 --- a/infer/src/eradicate/eradicateChecks.ml +++ b/infer/src/eradicate/eradicateChecks.ml @@ -253,12 +253,12 @@ let check_constructor_initialization tenv let filter_range_opt = function | Some (_, ta, _) -> f ta | None -> unknown in - IList.exists - (function pname, typestate -> - let pvar = Pvar.mk - (Mangled.from_string (Ident.fieldname_to_string fn)) - pname in - filter_range_opt (TypeState.lookup_pvar pvar typestate)) + List.exists + ~f:(function pname, typestate -> + let pvar = Pvar.mk + (Mangled.from_string (Ident.fieldname_to_string fn)) + pname in + filter_range_opt (TypeState.lookup_pvar pvar typestate)) list in let may_be_assigned_in_final_typestate = @@ -268,7 +268,7 @@ let check_constructor_initialization tenv | TypeOrigin.Field (f, _) -> (* field initialized with another field needing initialization *) let circular = - IList.exists (fun (f', _, _) -> Ident.equal_fieldname f f') fields in + List.exists ~f:(fun (f', _, _) -> Ident.equal_fieldname f f') fields in not circular | _ -> true in diff --git a/infer/src/eradicate/typeCheck.ml b/infer/src/eradicate/typeCheck.ml index 01268941f..8509cf12c 100644 --- a/infer/src/eradicate/typeCheck.ml +++ b/infer/src/eradicate/typeCheck.ml @@ -345,7 +345,7 @@ let typecheck_instr let is_parameter_field pvar = (* parameter.field *) let name = Pvar.get_name pvar in let filter (s, _, _) = Mangled.equal s name in - IList.exists filter annotated_signature.Annotations.params in + List.exists ~f:filter annotated_signature.Annotations.params in let is_static_field pvar = (* static field *) Pvar.is_global pvar in diff --git a/infer/src/integration/CaptureCompilationDatabase.ml b/infer/src/integration/CaptureCompilationDatabase.ml index 1f2979abd..c9c58d067 100644 --- a/infer/src/integration/CaptureCompilationDatabase.ml +++ b/infer/src/integration/CaptureCompilationDatabase.ml @@ -29,7 +29,7 @@ let should_capture_file_from_index () = (** The buck targets are assumed to start with //, aliases are not supported. *) let check_args_for_targets args = - if not (IList.exists Buck.is_target_string args) then + if not (List.exists ~f:Buck.is_target_string args) then Buck.no_targets_found_error_and_exit args let add_flavor_to_targets args = diff --git a/infer/src/java/jMain.ml b/infer/src/java/jMain.ml index 2379d627a..408265bcd 100644 --- a/infer/src/java/jMain.ml +++ b/infer/src/java/jMain.ml @@ -113,8 +113,8 @@ let do_all_files classpath sources classes = let linereader = Printer.LineReader.create () in let skip source_file = let is_path_matching path = - IList.exists - (fun pattern -> Str.string_match (Str.regexp pattern) path 0) + List.exists + ~f:(fun pattern -> Str.string_match (Str.regexp pattern) path 0) Config.skip_analysis_in_path in is_path_matching (SourceFile.to_rel_path source_file) || Inferconfig.skip_translation_matcher source_file Procname.empty_block in diff --git a/infer/src/quandary/JavaTrace.ml b/infer/src/quandary/JavaTrace.ml index 37aa388d1..a781024b7 100644 --- a/infer/src/quandary/JavaTrace.ml +++ b/infer/src/quandary/JavaTrace.ml @@ -83,10 +83,12 @@ module SourceKind = struct name, typ, None in let taint_formals_with_types type_strs kind formals = let taint_formal_with_types ((formal_name, formal_typ) as formal) = - let matches_classname typ typ_str = match typ with - | Typ.Tptr (Tstruct typename, _) -> String.equal (Typename.name typename) typ_str - | _ -> false in - if IList.mem matches_classname formal_typ type_strs + let matches_classname = match formal_typ with + | Typ.Tptr (Tstruct typename, _) -> + List.mem ~equal:String.equal type_strs (Typename.name typename) + | _ -> + false in + if matches_classname then formal_name, formal_typ, Some kind else diff --git a/infer/src/unit/TraceTests.ml b/infer/src/unit/TraceTests.ml index f48558aef..fd3330d80 100644 --- a/infer/src/unit/TraceTests.ml +++ b/infer/src/unit/TraceTests.ml @@ -98,13 +98,15 @@ let tests = assert_equal (IList.length reports) 2; assert_bool "Reports should contain source1 -> sink1" - (IList.exists - (fun (source, sink, _) -> MockSource.equal source source1 && MockSink.equal sink sink1) + (List.exists + ~f:(fun (source, sink, _) -> + MockSource.equal source source1 && MockSink.equal sink sink1) reports); assert_bool "Reports should contain source2 -> sink2" - (IList.exists - (fun (source, sink, _) -> MockSource.equal source source2 && MockSink.equal sink sink2) + (List.exists + ~f:(fun (source, sink, _) -> + MockSource.equal source source2 && MockSink.equal sink sink2) reports) in "get_reports">::get_reports_ in diff --git a/infer/src/unit/accessTreeTests.ml b/infer/src/unit/accessTreeTests.ml index 1519206ee..7a70d7572 100644 --- a/infer/src/unit/accessTreeTests.ml +++ b/infer/src/unit/accessTreeTests.ml @@ -441,8 +441,8 @@ let tests = (ap, trace) :: acc in let ap_traces = Domain.fold collect_ap_traces tree [] in let has_ap_trace_pair ap_in trace_in = - IList.exists - (fun (ap, trace) -> AccessPath.equal ap ap_in && MockTraceDomain.equal trace trace_in) + List.exists + ~f:(fun (ap, trace) -> AccessPath.equal ap ap_in && MockTraceDomain.equal trace trace_in) ap_traces in assert_bool "Should have six ap/trace pairs" (Int.equal (IList.length ap_traces) 6); diff --git a/infer/src/unit/procCfgTests.ml b/infer/src/unit/procCfgTests.ml index 125e3a3d1..0ea3430d6 100644 --- a/infer/src/unit/procCfgTests.ml +++ b/infer/src/unit/procCfgTests.ml @@ -49,7 +49,7 @@ let tests = let open OUnit2 in let cmp l1 l2 = let sort = IList.sort Procdesc.Node.compare in - IList.equal Procdesc.Node.compare (sort l1) (sort l2) in + List.equal ~equal:Procdesc.Node.equal (sort l1) (sort l2) in let pp_diff fmt (actual, expected) = let pp_sep fmt _ = F.pp_print_char fmt ',' in let pp_node_list fmt l = F.pp_print_list ~pp_sep Procdesc.Node.pp fmt l in diff --git a/infer/src/unit/schedulerTests.ml b/infer/src/unit/schedulerTests.ml index c5b22e20b..52adb679c 100644 --- a/infer/src/unit/schedulerTests.ml +++ b/infer/src/unit/schedulerTests.ml @@ -52,7 +52,7 @@ module MockProcCfg = struct let node_id = id n in IList.filter (fun (_, succs) -> - IList.exists (fun node -> equal_id (id node) node_id) succs) + List.exists ~f:(fun node -> equal_id (id node) node_id) succs) t |> IList.map fst with Not_found -> []