Deprecate IList module in favour of Core List

Reviewed By: jberdine

Differential Revision: D4462130

fbshipit-source-id: e58bef0
master
Cristiano Calcagno 8 years ago committed by Facebook Github Bot
parent c2b967d27b
commit 5c12d98d37

@ -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) {

@ -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;

@ -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

@ -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

@ -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 =

@ -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)];

@ -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. */

@ -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);

@ -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

@ -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 ->

@ -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
}

@ -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
};

@ -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

@ -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

@ -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 &&

@ -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

@ -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
*)

@ -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) ->

@ -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

@ -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 *)

@ -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;

@ -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

@ -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

@ -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' =

@ -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

@ -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', _)

@ -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

@ -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)

@ -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) ->

@ -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
*)

@ -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 =

@ -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

@ -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

@ -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)

@ -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

@ -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

@ -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 ->

@ -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

@ -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) ->

@ -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

@ -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. *)

@ -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

@ -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

@ -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 ->

@ -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

@ -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 *)

@ -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

@ -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

@ -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@."

@ -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];

@ -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

@ -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)

@ -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

@ -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 *)

@ -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

@ -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

@ -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

@ -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

@ -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);

@ -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

@ -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

@ -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

@ -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

@ -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 =

@ -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

@ -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

@ -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

@ -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);

@ -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

@ -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 -> []

Loading…
Cancel
Save