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 do_pdesc pd => {
let pname = Procname.to_string (Procdesc.get_proc_name pd); let pname = Procname.to_string (Procdesc.get_proc_name pd);
let nodes = Procdesc.get_nodes pd; let nodes = Procdesc.get_nodes pd;
let broken = IList.exists broken_node nodes; let broken = List.exists f::broken_node nodes;
if broken { if broken {
L.out "\n ***BROKEN CFG: '%s'\n" pname L.out "\n ***BROKEN CFG: '%s'\n" pname
} else { } else {
@ -262,7 +262,7 @@ let mark_unchanged_pdescs cfg_new cfg_old => {
let node_map = ref Procdesc.NodeMap.empty; let node_map = ref Procdesc.NodeMap.empty;
/* formals are the same if their types are the same */ /* formals are the same if their types are the same */
let formals_eq formals1 formals2 => 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 => { let nodes_eq n1s n2s => {
/* nodes are the same if they have the same id, instructions, and succs/preds up to renaming /* nodes are the same if they have the same id, instructions, and succs/preds up to renaming
with [exp_map] and [id_map] */ with [exp_map] and [id_map] */
@ -278,19 +278,21 @@ let mark_unchanged_pdescs cfg_new cfg_old => {
0 0
}; };
let instrs_eq instrs1 instrs2 => let instrs_eq instrs1 instrs2 =>
IList.equal List.equal
( equal::(
fun i1 i2 => { fun i1 i2 => {
let (n, exp_map') = Sil.compare_structural_instr i1 i2 !exp_map; let (n, exp_map') = Sil.compare_structural_instr i1 i2 !exp_map;
exp_map := exp_map'; exp_map := exp_map';
n Int.equal n 0
} }
) )
instrs1 instrs1
instrs2; instrs2;
Int.equal (compare_id n1 n2) 0 && Int.equal (compare_id n1 n2) 0 &&
IList.equal Procdesc.Node.compare (Procdesc.Node.get_succs n1) (Procdesc.Node.get_succs n2) && List.equal
IList.equal Procdesc.Node.compare (Procdesc.Node.get_preds n1) (Procdesc.Node.get_preds n2) && 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) instrs_eq (Procdesc.Node.get_instrs n1) (Procdesc.Node.get_instrs n2)
}; };
try (IList.for_all2 node_eq n1s n2s) { try (IList.for_all2 node_eq n1s n2s) {

@ -169,7 +169,7 @@ let rec has_tmp_var =
| Darray dexp1 dexp2 | Darray dexp1 dexp2
| Dbinop _ dexp1 dexp2 => has_tmp_var dexp1 || has_tmp_var dexp2 | Dbinop _ dexp1 dexp2 => has_tmp_var dexp1 || has_tmp_var dexp2
| Dretcall dexp dexp_list _ _ | 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 _ | Dconst _
| Dunknown | Dunknown
| Dsizeof _ None _ => false; | Dsizeof _ None _ => false;

@ -552,7 +552,7 @@ let parameter_field_not_null_checked_desc (desc : error_desc) exp =
| _ -> desc | _ -> desc
let has_tag (desc : error_desc) tag = 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 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]" | `MLeak_unknown -> "[UNKNOWN ORIGIN]"
let contains_all = let contains_all =
IList.mem PVariant.(=) `MLeak_all Config.ml_buckets List.mem ~equal:PVariant.(=) Config.ml_buckets `MLeak_all
let contains_cf = let contains_cf =
IList.mem PVariant.(=) `MLeak_cf Config.ml_buckets List.mem ~equal:PVariant.(=) Config.ml_buckets `MLeak_cf
let contains_arc = let contains_arc =
IList.mem PVariant.(=) `MLeak_arc Config.ml_buckets List.mem ~equal:PVariant.(=) Config.ml_buckets `MLeak_arc
let contains_narc = 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 = let contains_cpp =
IList.mem PVariant.(=) `MLeak_cpp Config.ml_buckets List.mem ~equal:PVariant.(=) Config.ml_buckets `MLeak_cpp
let contains_unknown_origin = 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 = let should_raise_leak_cf typ =
if contains_cf then if contains_cf then

@ -201,8 +201,8 @@ struct
| Core_graphics -> core_graphics_types | Core_graphics -> core_graphics_types
let is_objc_memory_model_controlled o = let is_objc_memory_model_controlled o =
IList.mem String.equal o core_foundation_types || List.mem ~equal:String.equal core_foundation_types o ||
IList.mem String.equal o core_graphics_types List.mem ~equal:String.equal core_graphics_types o
let rec is_core_lib lib typ = let rec is_core_lib lib typ =
match typ with match typ with
@ -210,7 +210,7 @@ struct
is_core_lib lib styp is_core_lib lib styp
| Typ.Tstruct name -> | Typ.Tstruct name ->
let core_lib_types = core_lib_to_type_list lib in let core_lib_types = core_lib_to_type_list lib in
IList.mem String.equal (Typename.name name) core_lib_types List.mem ~equal:String.equal core_lib_types (Typename.name name)
| _ -> false | _ -> false
let is_core_foundation_type typ = let is_core_foundation_type typ =

@ -538,9 +538,9 @@ let get_loop_heads pdesc => {
} }
} else { } else {
let ancester = NodeSet.add n ancester; 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; 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)]; let start_wl = [(get_start_node pdesc, NodeSet.empty)];

@ -232,7 +232,7 @@ let has_objc_ref_counter tenv hpred =>
switch hpred { switch hpred {
| Hpointsto _ _ (Sizeof (Tstruct name) _ _) => | Hpointsto _ _ (Sizeof (Tstruct name) _ _) =>
switch (Tenv.lookup tenv 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
} }
| _ => 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. */ /** 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. /** 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] */ /** extend [fav] with a [id] */
let (++) fav 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] fav := [id, ...!fav]
}; };
@ -1419,7 +1419,7 @@ let rec ident_sorted_list_subset l1 l2 =>
is in [fav2].*/ is in [fav2].*/
let fav_subset_ident fav1 fav2 => ident_sorted_list_subset (fav_to_list fav1) (fav_to_list 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 => let rec exp_fav_add fav e =>
switch (e: Exp.t) { 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]. */ 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 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. */ /** 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 is_instof t => equal_kind (snd t) INSTOF;
let list_intersect equal l1 l2 => { 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 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 */ /* 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); 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 = let add_or_replace_check_changed tenv check_attribute_change prop atom0 =
match atom0 with match atom0 with
| Sil.Apred (att0, ((_ :: _) as exps0)) | Anpred (att0, ((_ :: _) as exps0)) -> | 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 pairs =
let nexp = IList.hd nexps in (* len nexps = len exps0 > 0 by match *) IList.map (fun e -> (e, Prop.exp_normalize_prop tenv prop e)) exps0 in
let natom = Sil.atom_replace_exp (IList.combine exps0 nexps) atom0 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 let atom_map = function
| Sil.Apred (att, exp :: _) | Anpred (att, exp :: _) | Sil.Apred (att, exp :: _) | Anpred (att, exp :: _)
when Exp.equal nexp exp && attributes_in_same_category att att0 -> 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 nexp = Prop.exp_normalize_prop tenv prop exp in
let atom_get_attr attributes atom = let atom_get_attr attributes atom =
match atom with 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 | _ -> attributes in
IList.fold_left atom_get_attr [] prop.pi 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 has_dangling_uninit tenv prop exp =
let la = get_for_exp tenv prop exp in let la = get_for_exp tenv prop exp in
IList.exists (function List.exists ~f:(function
| Sil.Apred (a, _) -> PredSymb.equal a (Adangling DAuninit) | Sil.Apred (a, _) -> PredSymb.equal a (Adangling DAuninit)
| _ -> false | _ -> false
) la ) 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 deallocate_stack_vars tenv (p: 'a Prop.t) pvars =
let filter = function let filter = function
| Sil.Hpointsto (Exp.Lvar v, _, _) -> | Sil.Hpointsto (Exp.Lvar v, _, _) ->
IList.exists (Pvar.equal v) pvars List.exists ~f:(Pvar.equal v) pvars
| _ -> false in | _ -> false in
let sigma_stack, sigma_other = IList.partition filter p.sigma 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 *) 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 = let rec find_in_sigma e seen_hpreds =
IList.fold_right ( IList.fold_right (
fun hpred res -> 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 else
let seen_hpreds = hpred :: seen_hpreds in let seen_hpreds = hpred :: seen_hpreds in
match res with match res with

@ -387,7 +387,7 @@ let execute___get_hidden_field { Builtin.tenv; pdesc; prop_; path; ret_id; args;
| None -> p in | None -> p in
let foot_var = lazy (Exp.Var (Ident.create_fresh Ident.kfootprint)) 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 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 let do_hpred in_foot hpred = match hpred with
| Sil.Hpointsto(e, Sil.Estruct (fsel, inst), texp) | Sil.Hpointsto(e, Sil.Estruct (fsel, inst), texp)
when Exp.equal e n_lexp && (not (has_fld_hidden fsel)) -> 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 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 foot_var = lazy (Exp.Var (Ident.create_fresh Ident.kfootprint)) in
let filter_fld_hidden (f, _ ) = Ident.fieldname_is_hidden f 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 let do_hpred in_foot hpred = match hpred with
| Sil.Hpointsto(e, Sil.Estruct (fsel, inst), texp) | Sil.Hpointsto(e, Sil.Estruct (fsel, inst), texp)
when Exp.equal e n_lexp1 && not in_foot -> 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, parameter_not_null_checked,
premature_nil_termination 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; let issue_type_is_buffer_overrun = Localise.equal issue_type Localise.buffer_overrun;
if (issue_type_is_null_deref || issue_type_is_buffer_overrun) { if (issue_type_is_null_deref || issue_type_is_buffer_overrun) {
let issue_bucket_is_high = { let issue_bucket_is_high = {
let issue_bucket = Localise.error_desc_get_bucket error_desc; let issue_bucket = Localise.error_desc_get_bucket error_desc;
let high_buckets = Localise.BucketLevel.[b1, b2]; let high_buckets = Localise.BucketLevel.[b1, b2];
let eq o y => Option.value_map
switch (o, y) { issue_bucket default::false f::(fun b => List.mem equal::String.equal high_buckets b)
| (None, _) => false
| (Some x, y) => String.equal x y
};
IList.mem eq issue_bucket high_buckets
}; };
issue_bucket_is_high issue_bucket_is_high
} else { } else {
@ -377,7 +373,7 @@ let should_report (issue_kind: Exceptions.err_kind) issue_type error_desc eclass
thread_safety_violation, thread_safety_violation,
unsafe_guarded_by_access 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 issue_type_is_reportable
} }

@ -107,7 +107,7 @@ let remove_abduced_retvars tenv p => {
| Sil.Aeq lhs rhs | Sil.Aeq lhs rhs
| Sil.Aneq lhs rhs => exp_contains lhs || exp_contains rhs | Sil.Aneq lhs rhs => exp_contains lhs || exp_contains rhs
| Sil.Apred _ es | Sil.Apred _ es
| Sil.Anpred _ es => IList.exists exp_contains es | Sil.Anpred _ es => List.exists f::exp_contains es
) )
pi 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 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 (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 (inst_private, inst_public) = Sil.sub_domain_partition f inst in
let insts_of_public_ids = Sil.sub_range inst_public 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 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)) && *) (* (not (IList.intersect compare fav_inst_of_base fav_in_pvars)) && *)
(List.is_empty fpv_inst_of_base) && (List.is_empty fpv_inst_of_base) &&
(List.is_empty fpv_insts_of_private_ids) && (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_p_leftover)) &&
(not (IList.intersect Ident.compare fav_insts_of_private_ids fav_insts_of_public_ids)) (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 edges = ref [] in
let add_edge edg = edges := edg :: !edges in let add_edge edg = edges := edg :: !edges in
let get_edges_strexp rec_flds root se = 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 match se with
| Sil.Eexp _ | Sil.Earray _ -> () | Sil.Eexp _ | Sil.Earray _ -> ()
| Sil.Estruct (fsel, _) -> | Sil.Estruct (fsel, _) ->
@ -505,7 +505,7 @@ let discover_para_dll_candidates tenv p =
let edges = ref [] in let edges = ref [] in
let add_edge edg = (edges := edg :: !edges) in let add_edge edg = (edges := edg :: !edges) in
let get_edges_strexp rec_flds root se = 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 match se with
| Sil.Eexp _ | Sil.Earray _ -> () | Sil.Eexp _ | Sil.Earray _ -> ()
| Sil.Estruct (fsel, _) -> | Sil.Estruct (fsel, _) ->
@ -544,7 +544,7 @@ let discover_para_dll_candidates tenv p =
let discover_para tenv p = let discover_para tenv p =
let candidates = discover_para_candidates tenv p in let candidates = discover_para_candidates tenv p in
let already_defined para paras = 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) = let f paras (root, next, out) =
match (discover_para_roots tenv p root next next out) with match (discover_para_roots tenv p root next next out) with
| None -> paras | None -> paras
@ -558,7 +558,7 @@ let discover_para_dll tenv p =
*) *)
let candidates = discover_para_dll_candidates tenv p in let candidates = discover_para_dll_candidates tenv p in
let already_defined para paras = 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) = let f paras (iF, oB, iF', oF) =
match (discover_para_dll_roots tenv p iF oB iF' iF' iF oF) with match (discover_para_dll_roots tenv p iF oB iF' iF' iF oF) with
| None -> paras | None -> paras
@ -599,7 +599,7 @@ let eqs_sub subst eqs =
let eqs_solve ids_in eqs_in = let eqs_solve ids_in eqs_in =
let rec solve (sub: Sil.subst) (eqs: (Exp.t * Exp.t) list) : Sil.subst option = let rec solve (sub: Sil.subst) (eqs: (Exp.t * Exp.t) list) : Sil.subst option =
let do_default id e eqs_rest = 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 else
let sub' = match Sil.extend_sub sub id e with let sub' = match Sil.extend_sub sub id e with
| None -> L.out "@.@.ERROR : Buggy Implementation.@.@."; assert false | 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_list = Sil.sub_to_list sub in
let sub_dom = IList.map fst sub_list in let sub_dom = IList.map fst sub_list in
let filter id = 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 IList.filter filter ids_in in
match solve Sil.sub_empty eqs_in with match solve Sil.sub_empty eqs_in with
| None -> None | 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' | (DLL para', _) -> Match.hpara_dll_iso tenv para para'
| _ -> false in | _ -> false in
let filter_sll para = let filter_sll para =
not (IList.exists (eq_sll para) old_rsets) && not (List.exists ~f:(eq_sll para) old_rsets) &&
not (IList.exists (eq_sll para) !new_rsets) in not (List.exists ~f:(eq_sll para) !new_rsets) in
let filter_dll para = let filter_dll para =
not (IList.exists (eq_dll para) old_rsets) && not (List.exists ~f:(eq_dll para) old_rsets) &&
not (IList.exists (eq_dll para) !new_rsets) in 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_sll = IList.filter filter_sll closed_paras_sll in
let todo_paras_dll = IList.filter filter_dll closed_paras_dll in let todo_paras_dll = IList.filter filter_dll closed_paras_dll in
(todo_paras_sll, todo_paras_dll) in (todo_paras_sll, todo_paras_dll) in
@ -906,7 +906,7 @@ let get_cycle root prop =
| (f, e):: el' -> | (f, e):: el' ->
if Sil.equal_strexp e e_root then if Sil.equal_strexp e e_root then
(et_src, f, e):: path, true (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 path, false
else ( else (
let visited' = (fst et_src):: visited in let visited' = (fst et_src):: visited in
@ -967,7 +967,7 @@ let get_var_retain_cycle prop_ =
Some (Sil.hpred_get_lhs hp) Some (Sil.hpred_get_lhs hp)
with Not_found -> None in with Not_found -> None in
let find_block v = 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) Some (Exp.Lvar Sil.block_pvar)
else None in else None in
let sexp e = Sil.Eexp (e, Sil.Inone) 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 | [] -> false
| ((_, t), fn, _):: c' -> | ((_, t), fn, _):: c' ->
let ia = get_item_annotation t fn in 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 else do_cycle c' in
do_cycle cycle do_cycle cycle
@ -1083,7 +1083,7 @@ let check_junk ?original_prop pname tenv prop =
Sil.strexp_fav_add fav se; Sil.strexp_fav_add fav se;
Sil.fav_mem fav id Sil.fav_mem fav id
| _ -> false in | _ -> 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 = let rec remove_junk_recursive sigma_done sigma_todo =
match sigma_todo with match sigma_todo with
| [] -> IList.rev sigma_done | [] -> IList.rev sigma_done
@ -1172,7 +1172,7 @@ let check_junk ?original_prop pname tenv prop =
| None, Some _ -> false in | None, Some _ -> false in
(is_none alloc_attribute && !leaks_reported <> []) || (is_none alloc_attribute && !leaks_reported <> []) ||
(* None attribute only reported if it's the first one *) (* 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 = let ignore_leak =
!Config.allow_leak || ignore_resource || is_undefined || already_reported () in !Config.allow_leak || ignore_resource || is_undefined || already_reported () in
let report_and_continue = let report_and_continue =
@ -1239,7 +1239,7 @@ let get_local_stack cur_sigma init_sigma =
| Sil.Hpointsto (Exp.Lvar pvar, _, _) -> pvar | Sil.Hpointsto (Exp.Lvar pvar, _, _) -> pvar
| Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> assert false in | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> assert false in
let filter_local_stack olds = function 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 | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> false in
let init_stack = IList.filter filter_stack init_sigma in let init_stack = IList.filter filter_stack init_sigma in
let init_stack_pvars = IList.map get_stack_var init_stack 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 remove_local_stack sigma pvars =
let filter_non_stack = function 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 | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> true in
IList.filter filter_non_stack sigma IList.filter filter_non_stack sigma

@ -227,7 +227,7 @@ end = struct
match se', se_in with match se', se_in with
| Sil.Earray (len, esel, _), Sil.Earray (_, esel_in, inst2) -> | Sil.Earray (len, esel, _), Sil.Earray (_, esel_in, inst2) ->
let orig_indices = IList.map fst esel in 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 = let process_index idx =
if index_is_not_new idx then idx else (Sil.array_clean_new_index footprint_part idx) in 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 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 fun i -> IList.map (add_index i) elist_path in
let pointers = IList.flatten (IList.map add_index_to_paths indices) in let pointers = IList.flatten (IList.map add_index_to_paths indices) in
let filter = function 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 | _ -> 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 *) (** Given [p] containing an array at [path], blur [index] in it *)
@ -440,7 +440,7 @@ let keep_only_indices tenv
match se with match se with
| Sil.Earray (len, esel, inst) -> | Sil.Earray (len, esel, inst) ->
let esel', esel_leftover' = 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) if List.is_empty esel_leftover' then (sigma, false)
else begin else begin
let se' = Sil.Earray (len, esel', inst) in 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 formal_names = IList.map fst formals in
let is_formal pvar = let is_formal pvar =
let name = Pvar.get_name pvar in 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 formal_ids = ref [] in
let process_formal_letref = function let process_formal_letref = function
| Sil.Load (id, Exp.Lvar pvar, _, _) -> | Sil.Load (id, Exp.Lvar pvar, _, _) ->
@ -90,14 +90,14 @@ let check_access access_opt de_opt =
| Sil.Call (_, _, etl, _, _) -> | Sil.Call (_, _, etl, _, _) ->
let formal_ids = find_formal_ids node in let formal_ids = find_formal_ids node in
let arg_is_formal_param (e, _) = match e with 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 | _ -> 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 true
| Sil.Store (_, _, e, _) -> | Sil.Store (_, _, e, _) ->
exp_is_null e exp_is_null e
| _ -> false in | _ -> 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 local_access_found = ref false in
let do_node node = let do_node node =
if Int.equal (Procdesc.Node.get_loc node).Location.line line_number && 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 id when Ident.is_normal id -> IList.length es >= 1
| Exp.Var _ -> | Exp.Var _ ->
if Int.equal Config.join_cond 0 then 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 else if Dangling.check side e then
begin 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 if r then begin
L.d_str ".... Dangling Check (dang e:"; Sil.d_exp e; L.d_str ".... Dangling Check (dang e:"; Sil.d_exp e;
L.d_str ") (? es:"; Sil.d_exp_list es; L.d_strln ") ...."; L.d_str ") (? es:"; Sil.d_exp_list es; L.d_strln ") ....";
@ -265,7 +265,7 @@ module CheckJoinPre : InfoLossCheckerSig = struct
end end
else else
begin 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 if r then begin
L.d_str ".... Dangling Check (notdang e:"; Sil.d_exp e; L.d_str ".... Dangling Check (notdang e:"; Sil.d_exp e;
L.d_str ") (? es:"; Sil.d_exp_list es; L.d_strln ") ...."; L.d_str ") (? es:"; Sil.d_exp_list es; L.d_strln ") ....";
@ -1641,11 +1641,17 @@ let pi_partial_join tenv mode
| None -> | None ->
begin begin
match Prop.atom_const_lt_exp a_op with match Prop.atom_const_lt_exp a_op with
| None -> Some a_res | None ->
| Some (n, e) -> if IList.exists (is_stronger_lt n e) pi_op then (widening_atom a_res) else Some a_res 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 end
| Some (e, n) -> | 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 end in
let handle_atom_with_widening len p_op pi_op atom_list a = 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 *) (* 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_fp =
let sigma_fp0 = efp.Prop.sigma in 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 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 sigma_fp0 in
let ep1' = Prop.set p1 ~pi_fp ~sigma_fp in let ep1' = Prop.set p1 ~pi_fp ~sigma_fp in
let ep2' = Prop.set p2 ~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 = let is_allocated d =
match d with match d with
| Dotdangling(_, e, _) -> | Dotdangling(_, e, _) ->
IList.exists (fun a -> match a with List.exists ~f:(fun a -> match a with
| Dotpointsto(_, e', _) | Dotpointsto(_, e', _)
| Dotarray(_, _, e', _, _, _) | Dotarray(_, _, e', _, _, _)
| Dotlseg(_, e', _, _, _, _) | Dotlseg(_, e', _, _, _, _)
@ -280,7 +280,7 @@ let make_dangling_boxes pe allocated_nodes (sigma_lambda: (Sil.hpred * int) list
match l with match l with
| [] -> [] | [] -> []
| Dotdangling(coo, e, color):: l' -> | 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) else Dotdangling(coo, e, color):: filter_duplicate l' (e:: seen_exp)
| box:: l' -> box:: filter_duplicate l' seen_exp (* this case cannot happen*) in | box:: l' -> box:: filter_duplicate l' seen_exp (* this case cannot happen*) in
let rec subtract_allocated candidate_dangling = 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);] Dotstruct((mk_coordinate (n + 1) lambda), e, l, e_color_str, te);]
| (Sil.Hpointsto (e, _, _), lambda) -> | (Sil.Hpointsto (e, _, _), lambda) ->
let e_color_str = color_to_str (exp_color e) in 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)] [Dotpointsto((mk_coordinate n lambda), e, e_color_str)]
| (Sil.Hlseg (k, hpara, e1, e2, _), lambda) -> | (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 *) 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 = let rec do_strexp se in_struct =
match se with match se with
| Sil.Eexp (e, _) -> if in_struct then fields_structs:= e ::!fields_structs else () | 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.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 (IList.split l)) in | Sil.Earray (_, l, _) -> IList.iter (fun e -> do_strexp e false) (snd (List.unzip l)) in
let rec fs s = let rec fs s =
match s with match s with
| [] -> () | [] -> ()
@ -385,14 +385,16 @@ let is_nil e prop =
let in_cycle cycle edge = let in_cycle cycle edge =
match cycle with match cycle with
| Some cycle' -> | Some cycle' ->
IList.mem (fun (fn, se) (_,fn',se') -> let (fn, se) = edge in
Ident.equal_fieldname fn fn' && Sil.equal_strexp se se') edge cycle' List.exists
~f:(fun (_,fn',se') -> Ident.equal_fieldname fn fn' && Sil.equal_strexp se se')
cycle'
| _ -> false | _ -> false
let node_in_cycle cycle node = let node_in_cycle cycle node =
match cycle, node with match cycle, node with
| Some _, Dotstruct(_, _, l, _,_) -> (* only struct nodes can be in cycle *) | Some _, Dotstruct(_, _, l, _,_) -> (* only struct nodes can be in cycle *)
IList.exists (in_cycle cycle) l List.exists ~f:(in_cycle cycle) l
| _ -> false | _ -> false
@ -416,7 +418,7 @@ let rec compute_target_struct_fields dotnodes list_fld p f lambda cycle =
) )
| [node] | [Dotpointsto _ ; node] | [node; Dotpointsto _] -> | [node] | [Dotpointsto _ ; node] | [node; Dotpointsto _] ->
let n = get_coordinate_id node in 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 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 let link_kind = if (in_cycle cycle (fn, se)) && (not !print_full_prop) then
LinkRetainCycle LinkRetainCycle
@ -452,7 +454,7 @@ let rec compute_target_array_elements dotnodes list_elements p f lambda =
) )
| [node] | [Dotpointsto _ ; node] | [node; Dotpointsto _] -> | [node] | [Dotpointsto _ ; node] | [node; Dotpointsto _] ->
let n = get_coordinate_id node in 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 e_no_special_char = strip_special_chars (Exp.to_string e) in
[(LinkArrayToStruct, Exp.to_string idx, n, e_no_special_char)] [(LinkArrayToStruct, Exp.to_string idx, n, e_no_special_char)]
end else 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 tmp_links = ref links in
let remove_links_from ln = let remove_links_from ln =
IList.filter IList.filter
(fun n' -> not (IList.mem equal_link n' ln)) (fun n' -> not (List.mem ~equal:equal_link ln n'))
!tmp_links in !tmp_links in
let remove_node n ns = let remove_node n ns =
IList.filter (fun n' -> match n' with 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!*) | _ -> [] (* arrays and struct do not give danglings. CHECK THIS!*)
) in ) in
let is_not_allocated e = 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_pointsto(_, e', _, _)
| VH_lseg(_, e', _ , _) | VH_lseg(_, e', _ , _)
| VH_dllseg(_, e', _, _, _, _) -> Exp.equal e 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 match l with
| [] -> [] | [] -> []
| e:: l' -> | 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 else e:: filter_duplicate l' (e:: seen_exp) in
let rhs_exp_list = IList.flatten (IList.map get_rhs_predicate sigma) in let rhs_exp_list = IList.flatten (IList.map get_rhs_predicate sigma) in
let candidate_dangling_exps = filter_duplicate rhs_exp_list [] 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)] ("line", string_of_int loc.Location.line)]
[xml_signature; xml_specifications] in [xml_signature; xml_specifications] in
Io_infer.Xml.pp_document true fmt proc_summary 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 vector_class = ["std"; "vector"]
let is_one_of_classes class_name classes = 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 -> IList.for_all (fun wrapper_class_substring ->
String.is_substring ~substring:wrapper_class_substring class_name) wrapper_class) String.is_substring ~substring:wrapper_class_substring class_name) wrapper_class)
classes classes
@ -100,7 +100,7 @@ let find_nullify_after_instr node instr pvar : bool =
| instr_ -> | instr_ ->
if Sil.equal_instr instr instr_ then found_instr := true; if Sil.equal_instr instr instr_ then found_instr := true;
false in false in
IList.exists find_nullify node_instrs List.exists ~f:find_nullify node_instrs
(** Find the other prune node of a conditional (** Find the other prune node of a conditional
(e.g. the false branch given the true branch 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 -> | Sil.Store (Exp.Lvar _pvar, _, Exp.Const (Const.Cint i), _) when Pvar.equal pvar _pvar ->
IntLit.iszero i <> true_branch IntLit.iszero i <> true_branch
| _ -> false in | _ -> 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 match Procdesc.Node.get_preds node with
| [pred_node] -> find_boolean_assignment pred_node pvar true_branch | [pred_node] -> find_boolean_assignment pred_node pvar true_branch
| [n1; n2] -> | [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 fun_dexp = DExp.Dconst (Const.Cfun pname) in
let args_dexp = let args_dexp =
let args_dexpo = IList.map (fun (e, _) -> _exp_rv_dexp tenv seen node e) args in 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 [] then []
else else
let unNone = function Some x -> x | None -> assert false in 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) -> | Some (fun_exp, eargs, loc, call_flags) ->
let fun_dexpo = _exp_rv_dexp tenv seen node' fun_exp in 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 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 else
let unNone = function Some x -> x | None -> assert false in let unNone = function Some x -> x | None -> assert false in
let args = IList.map unNone blame_args 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 let filter = function
| (ni, Exp.Var id') -> Ident.is_normal ni && Ident.equal id' id | (ni, Exp.Var id') -> Ident.is_normal ni && Ident.equal id' id
| _ -> false in | _ -> 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 function
| Sil.Hpointsto (Exp.Lvar pv, sexp, texp) | Sil.Hpointsto (Exp.Lvar pv, sexp, texp)
when (Pvar.is_local pv || Pvar.is_global pv || Pvar.is_seed pv) -> 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 = let rec cleandir dir =
match Unix.readdir dir with match Unix.readdir dir with
| entry -> | entry ->
if (IList.exists (String.equal entry) dirs) then ( if (List.exists ~f:(String.equal entry) dirs) then (
rmtree (name ^/ entry) rmtree (name ^/ entry)
) else if not (String.equal entry Filename.current_dir_name ) else if not (String.equal entry Filename.current_dir_name
|| String.equal entry Filename.parent_dir_name) then ( || String.equal entry Filename.parent_dir_name) then (
@ -140,7 +140,7 @@ let clean_results_dir () =
cleandir dir cleandir dir
) )
| exception Unix.Unix_error (Unix.ENOTDIR, _, _) -> | 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 Unix.unlink name
| exception Unix.Unix_error (Unix.ENOENT, _, _) -> | exception Unix.Unix_error (Unix.ENOENT, _, _) ->
() in () in

@ -46,11 +46,11 @@ type filter_config =
let is_matching patterns = let is_matching patterns =
fun source_file -> fun source_file ->
let path = SourceFile.to_rel_path source_file in let path = SourceFile.to_rel_path source_file in
IList.exists List.exists
(fun pattern -> ~f:(fun pattern ->
try try
Int.equal (Str.search_forward pattern path 0) 0 Int.equal (Str.search_forward pattern path 0) 0
with Not_found -> false) with Not_found -> false)
patterns patterns
@ -132,11 +132,11 @@ module FileOrProcMatcher = struct
and method_name = Procname.java_get_method pname_java in and method_name = Procname.java_get_method pname_java in
try try
let class_patterns = String.Map.find_exn pattern_map class_name in let class_patterns = String.Map.find_exn pattern_map class_name in
IList.exists List.exists
(fun p -> ~f:(fun p ->
match p.method_name with match p.method_name with
| None -> true | None -> true
| Some m -> String.equal m method_name) | Some m -> String.equal m method_name)
class_patterns class_patterns
with Not_found -> false in with Not_found -> false in
@ -200,7 +200,7 @@ module OverridesMatcher = struct
is_subtype mp.class_name is_subtype mp.class_name
&& (Option.value_map ~f:(match_method language proc_name) ~default:false mp.method_name) && (Option.value_map ~f:(match_method language proc_name) ~default:false mp.method_name)
| _ -> failwith "Expecting method pattern" in | _ -> failwith "Expecting method pattern" in
IList.exists is_matching patterns List.exists ~f:is_matching patterns
end end
@ -233,8 +233,8 @@ let patterns_of_json_with_key (json_key, json) =
let detect_pattern assoc = let detect_pattern assoc =
match detect_language assoc with match detect_language assoc with
| Ok language -> | Ok language ->
let is_method_pattern key = IList.exists (String.equal key) ["class"; "method"] let is_method_pattern key = List.exists ~f:(String.equal key) ["class"; "method"]
and is_source_contains key = IList.exists (String.equal key) ["source_contains"] in and is_source_contains key = List.exists ~f:(String.equal key) ["source_contains"] in
let rec loop = function let rec loop = function
| [] -> | [] ->
Error ("Unknown pattern for " ^ json_key ^ " in " ^ Config.inferconfig_file) Error ("Unknown pattern for " ^ json_key ^ " in " ^ Config.inferconfig_file)
@ -334,7 +334,7 @@ let filters_from_inferconfig inferconfig : filters =
let error_filter = let error_filter =
function error_name -> function error_name ->
let error_str = Localise.to_string error_name in let error_str = Localise.to_string error_name in
not (IList.exists (String.equal error_str) inferconfig.suppress_errors) in not (List.exists ~f:(String.equal error_str) inferconfig.suppress_errors) in
{ {
path_filter = path_filter; path_filter = path_filter;
error_filter = error_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*) (* Decide whether a checker or error type is enabled or disabled based on*)
(* white/black listing in .inferconfig and the default value *) (* white/black listing in .inferconfig and the default value *)
let is_checker_enabled checker_name = let is_checker_enabled checker_name =
match IList.mem String.(=) checker_name Config.disable_checks, match List.mem ~equal:String.(=) Config.disable_checks checker_name,
IList.mem String.(=) checker_name Config.enable_checks with 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 *) | 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 *) | true, false -> (* if it's blacklisted and not whitelisted then it should be disabled *)
false false
| false, true -> (* if it is not blacklisted and it is whitelisted then it should be enabled *) | 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 let is_call = function
| Sil.Call _ -> true | Sil.Call _ -> true
| _ -> false in | _ -> false in
IList.exists is_call instrs in List.exists ~f:is_call instrs in
let is_set_instr i = let is_set_instr i =
match i with match i with
| Sil.Store _ -> true | 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') (lhs, (Some fld, typ) :: path, reachable_hpreds')
with Not_found -> (sink_exp, path, reachable_hpreds)) with Not_found -> (sink_exp, path, reachable_hpreds))
| Sil.Hpointsto (lhs, Sil.Earray (_, elems, _), Exp.Sizeof (typ, _, _)) -> | 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 then
let reachable_hpreds' = Sil.HpredSet.remove hpred reachable_hpreds in let reachable_hpreds' = Sil.HpredSet.remove hpred reachable_hpreds in
(* None means "no field name" ~=~ nameless array index *) (* 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 SpecMap.empty old_specs) in
let re_exe_filter old_spec = (* filter out pres which failed re-exe *) let re_exe_filter old_spec = (* filter out pres which failed re-exe *)
if Specs.equal_phase phase Specs.RE_EXECUTION && if Specs.equal_phase phase Specs.RE_EXECUTION &&
not (IList.exists not (List.exists
(fun new_spec -> Specs.Jprop.equal new_spec.Specs.pre old_spec.Specs.pre) ~f:(fun new_spec -> Specs.Jprop.equal new_spec.Specs.pre old_spec.Specs.pre)
new_specs) new_specs)
then begin then begin
changed:= true; changed:= true;

@ -16,7 +16,7 @@ module L = Logging
module F = Format module F = Format
let mem_idlist i l = 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 (** Type for a hpred pattern. flag=false means that the implication
between hpreds is not considered, and flag = true means that it is 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 let f res_acc (e1, e2) = match res_acc with
| None -> None | None -> None
| Some (sub_acc, vars_leftover) -> exp_match e1 sub_acc vars_leftover e2 in | 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 Option.find_map
let es_match_res = IList.fold_left f (Some (sub, vars)) es_combined ~f:(fun es_combined -> IList.fold_left f (Some (sub, vars)) es_combined)
in es_match_res (List.zip es1 es2)
(** Checks sexp1 = sexp2[sub ++ sub'] for some sub' with (** Checks sexp1 = sexp2[sub ++ sub'] for some sub' with
dom(sub') subseteq vars. Returns (sub ++ sub', vars - dom(sub')). dom(sub') subseteq vars. Returns (sub ++ sub', vars - dom(sub')).
@ -140,7 +140,7 @@ and isel_match isel1 sub vars isel2 =
| [], _ | _, [] -> None | [], _ | _, [] -> None
| (idx1, se1') :: isel1', (idx2, se2') :: isel2' -> | (idx1, se1') :: isel1', (idx2, se2') :: isel2' ->
let idx2 = Sil.exp_sub sub idx2 in 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 if (not sanity_check) then begin
let pe = Pp.text in let pe = Pp.text in
L.out "@[.... Sanity Check Failure while Matching Index-Strexps ....@."; 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 *) (* extends substitution sub by creating a new substitution for vars *)
let sub_extend_with_ren (sub: Sil.subst) 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 f id = (id, Exp.Var (Ident.create_fresh Ident.kprimed)) in
let renaming_for_vars = Sil.sub_of_list (IList.map f vars) in let renaming_for_vars = Sil.sub_of_list (IList.map f vars) in
Sil.sub_join sub renaming_for_vars 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 else match hpat.hpred with
| Sil.Hpointsto _ | Sil.Hlseg (Sil.Lseg_NE, _, _, _, _) | Sil.Hdllseg (Sil.Lseg_NE, _, _, _, _, _, _) -> None | Sil.Hpointsto _ | Sil.Hlseg (Sil.Lseg_NE, _, _, _, _) | Sil.Hdllseg (Sil.Lseg_NE, _, _, _, _, _, _) -> None
| Sil.Hlseg (_, _, e1, e2, _) -> | 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 in if (not fully_instantiated) then None else
let e1' = Sil.exp_sub sub e1 let e1' = Sil.exp_sub sub e1
in begin in begin
@ -198,7 +191,7 @@ let rec instantiate_to_emp p condition sub vars = function
end end
| Sil.Hdllseg (_, _, iF, oB, oF, iB, _) -> | Sil.Hdllseg (_, _, iF, oB, oF, iB, _) ->
let fully_instantiated = 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 in if (not fully_instantiated) then None else
let iF' = Sil.exp_sub sub iF in let iF' = Sil.exp_sub sub iF in
let oB' = Sil.exp_sub sub oB 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) -> | 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 filter = gen_filter_lseg k2 para2 e_start2 e_end2 es_shared2 in
let do_emp_lseg _ = 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 if (not fully_instantiated_start2) then None
else else
let e_start2' = Sil.exp_sub sub e_start2 in 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 | None -> None
| Some (sub_res, p_leftover) when condition p_leftover sub_res -> | Some (sub_res, p_leftover) when condition p_leftover sub_res ->
let not_in_para2_exist_vars id = 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 let sub_res' = Sil.sub_filter not_in_para2_exist_vars sub_res
in Some (sub_res', p_leftover) in Some (sub_res', p_leftover)
| Some _ -> None | 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 filter = gen_filter_dllseg k2 para2 iF2 oB2 oF2 iB2 es_shared2 in
let do_emp_dllseg _ = let do_emp_dllseg _ =
let fully_instantiated_iFoB2 = 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 in if (not fully_instantiated_iFoB2) then None else
let iF2' = Sil.exp_sub sub iF2 in let iF2' = Sil.exp_sub sub iF2 in
let oB2' = Sil.exp_sub sub oB2 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 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 in prop_match_with_impl_sub tenv p condition sub_new vars_leftover hpat_next hpats_rest in
let do_para_dllseg _ = 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 in if (not fully_instantiated_iF2) then None else
let iF2' = Sil.exp_sub sub iF2 let iF2' = Sil.exp_sub sub iF2
in match exp_match iF2' sub vars iB2 with 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 | None -> None
| Some (sub_res, p_leftover) when condition p_leftover sub_res -> | Some (sub_res, p_leftover) when condition p_leftover sub_res ->
let not_in_para2_exist_vars id = 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 let sub_res' = Sil.sub_filter not_in_para2_exist_vars sub_res
in Some (sub_res', p_leftover) in Some (sub_res', p_leftover)
| Some _ -> None | 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 = and hpara_common_match_with_impl tenv impl_ok ids1 sigma1 eids2 ids2 sigma2 =
try try
let sub_ids = 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 let f (id2, id1) = (id2, Exp.Var id1) in
IList.map f ren_ids in IList.map f ren_ids in
let (sub_eids, eids_fresh) = let (sub_eids, eids_fresh) =
@ -558,7 +552,7 @@ let corres_extend_front e1 e2 corres =
let corres_extensible corres e1 e2 = let corres_extensible corres e1 e2 =
let predicate (e1', e2') = (Exp.equal e1 e1') || (Exp.equal e2 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 corres_related corres e1 e2 =
let filter (e1', e2') = (Exp.equal e1 e1') || (Exp.equal e2 e2') in 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 let new_sigma2 = hpred2 :: sigma2 in
(new_sigma1, new_sigma2) in (new_sigma1, new_sigma2) in
let new_todos = 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 (root1, root2) :: (next1, next2) :: shared12 @ todos' in
generic_find_partial_iso tenv mode update new_corres new_sigma_corres new_todos new_sigma_todo generic_find_partial_iso tenv mode update new_corres new_sigma_corres new_todos new_sigma_todo
with Invalid_argument _ -> None) 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 let new_sigma2 = hpred2 :: sigma2 in
(new_sigma1, new_sigma2) in (new_sigma1, new_sigma2) in
let new_todos = 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 (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 generic_find_partial_iso tenv mode update new_corres new_sigma_corres new_todos new_sigma_todo
with Invalid_argument _ -> None) 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 let add_fresh_id pair = (pair, Ident.create_fresh Ident.kprimed) in
IList.map add_fresh_id new_corres' in IList.map add_fresh_id new_corres' in
let (es_shared, ids_shared, ids_exists) = 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 corres_ids_no_elist1 = IList.filter not_in_elist1 corres_ids in
let should_be_shared ((e1, e2), _) = Exp.equal e1 e2 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 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 | Sil.Call (_, _, _, _, call_flags) -> call_flags_is_dispatch call_flags
| _ -> false in | _ -> false in
let has_dispatch_call instrs = 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 let replace_dispatch_calls = function
| Sil.Call (ret_id, (Exp.Const (Const.Cfun callee_pname) as call_exp), | Sil.Call (ret_id, (Exp.Const (Const.Cfun callee_pname) as call_exp),
(((_, receiver_typ) :: _) as args), loc, call_flags) as instr (((_, receiver_typ) :: _) as args), loc, call_flags) as instr
@ -71,7 +71,7 @@ let add_abstraction_instructions pdesc =
| Node.Exit_node _ -> true | Node.Exit_node _ -> true
| _ -> false in | _ -> false in
let succ_nodes = Node.get_succs node 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 else match succ_nodes with
| [] -> false | [] -> false
| [h] -> IList.length (Node.get_preds h) > 1 | [h] -> IList.length (Node.get_preds h) > 1

@ -1285,13 +1285,13 @@ module Normalize = struct
when IntLit.isone i -> when IntLit.isone i ->
let lower = Exp.int (n -- IntLit.one) in let lower = Exp.int (n -- IntLit.one) in
let a_lower : Sil.atom = Aeq (BinOp (Lt, lower, Var id), Exp.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) else Aeq (Var id, Exp.int n)
| Aeq (BinOp (Lt, Const (Cint n), Var id), Const (Cint i)) | Aeq (BinOp (Lt, Const (Cint n), Var id), Const (Cint i))
when IntLit.isone i -> when IntLit.isone i ->
let upper = Exp.int (n ++ IntLit.one) in let upper = Exp.int (n ++ IntLit.one) in
let a_upper : Sil.atom = Aeq (BinOp (Le, Var id, upper), Exp.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) else Aeq (Var id, upper)
| Aeq (BinOp (Ne, e1, e2), Const (Cint i)) when IntLit.isone i -> | Aeq (BinOp (Ne, e1, e2), Const (Cint i)) when IntLit.isone i ->
Aneq (e1, e2) Aneq (e1, e2)
@ -1427,7 +1427,7 @@ module Normalize = struct
| _ -> acc in | _ -> acc in
IList.fold_left get_disequality_info [] nonineq_list in IList.fold_left get_disequality_info [] nonineq_list in
let is_neq e n = 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 le_list_tightened =
let get_le_inequality_info acc a = let get_le_inequality_info acc a =
match atom_exp_le_const a with match atom_exp_le_const a with
@ -1469,11 +1469,11 @@ module Normalize = struct
(fun (a : Sil.atom) -> match a with (fun (a : Sil.atom) -> match a with
| Aneq (Const (Cint n), e) | Aneq (Const (Cint n), e)
| Aneq (e, Const (Cint n)) -> | Aneq (e, Const (Cint n)) ->
(not (IList.exists (not (List.exists
(fun (e', n') -> Exp.equal e e' && IntLit.lt n' n) ~f:(fun (e', n') -> Exp.equal e e' && IntLit.lt n' n)
le_list_tightened)) && le_list_tightened)) &&
(not (IList.exists (not (List.exists
(fun (n', e') -> Exp.equal e e' && IntLit.leq n n') ~f:(fun (n', e') -> Exp.equal e e' && IntLit.leq n n')
lt_list_tightened)) lt_list_tightened))
| _ -> true) | _ -> true)
nonineq_list in nonineq_list in
@ -1503,7 +1503,7 @@ module Normalize = struct
let unsigned_exps = lazy (sigma_get_unsigned_exps sigma) in let unsigned_exps = lazy (sigma_get_unsigned_exps sigma) in
function function
| Aneq ((Var _) as e, Const (Cint n)) when IntLit.isnegative n -> | 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) -> | Aneq (e1, e2) ->
not (syntactically_different (e1, e2)) not (syntactically_different (e1, e2))
| Aeq (Const c1, Const c2) -> | Aeq (Const c1, Const c2) ->
@ -1556,7 +1556,7 @@ module Normalize = struct
(** Conjoin a pure atomic predicate by normal conjunction. *) (** Conjoin a pure atomic predicate by normal conjunction. *)
let rec prop_atom_and tenv ?(footprint=false) (p : normal t) a : normal t = let rec prop_atom_and tenv ?(footprint=false) (p : normal t) a : normal t =
let a' = normalize_and_strengthen_atom tenv p a in 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 else begin
let p' = let p' =
match a' with 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 npi = Normalize.pi_normalize tenv subst nsigma prop.pi in
let nsub, atoms = let nsub, atoms =
let dom_subst = IList.map fst (Sil.sub_to_list subst) in 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 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 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 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. *) [fav] should not contain any primed variables. *)
let exist_quantify tenv fav (prop : normal t) : normal t = let exist_quantify tenv fav (prop : normal t) : normal t =
let ids = Sil.fav_to_list fav in 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 if List.is_empty ids then prop else
let gen_fresh_id_sub id = (id, Exp.Var (Ident.create_fresh Ident.kprimed)) in 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 ren_sub = Sil.sub_of_list (IList.map gen_fresh_id_sub ids) in
let prop' = let prop' =
(* throw away x=E if x becomes _x *) (* 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 let sub = Sil.sub_filter (fun i -> not (mem_idlist i ids)) prop.sub in
if Sil.equal_subst sub prop.sub then prop if Sil.equal_subst sub prop.sub then prop
else unsafe_cast_to_normal (set prop ~sub) in 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 *) (** 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 remove_seed_captured_vars_block tenv captured_vars prop =
let is_captured pname vn = Mangled.equal pname vn in
let hpred_seed_captured = let hpred_seed_captured =
function function
| Sil.Hpointsto (Exp.Lvar pv, _, _) -> | Sil.Hpointsto (Exp.Lvar pv, _, _) ->
let pname = Pvar.get_name pv in 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 | _ -> false in
let sigma = prop.sigma in let sigma = prop.sigma in
let sigma' = let sigma' =

@ -193,7 +193,7 @@ let compute_diff default_color oldgraph newgraph : diff =
() in () in
IList.iter build_changed newedges; IList.iter build_changed newedges;
let colormap (o: Obj.t) = 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 else default_color in
!changed, colormap in !changed, colormap in
let changed_norm, colormap_norm = compute_changed false in let changed_norm, colormap_norm = compute_changed false in

@ -129,7 +129,7 @@ end = struct
let remove_redundancy constraints = let remove_redundancy constraints =
let constraints' = sort_then_remove_redundancy constraints in 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 = let rec combine acc_todos acc_seen constraints_new constraints_old =
match constraints_new, constraints_old with match constraints_new, constraints_old with
@ -442,11 +442,11 @@ end = struct
(* [ sizeof(t1) - sizeof(t2) <= -1 ] *) (* [ sizeof(t1) - sizeof(t2) <= -1 ] *)
check_type_size_lt t1 t2 check_type_size_lt t1 t2
| e, Exp.Const (Const.Cint n) -> (* [e <= n' <= n |- e <= n] *) | 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 | e', Exp.Const (Const.Cint n') -> Exp.equal e e' && IntLit.leq n' n
| _, _ -> false) leqs | _, _ -> false) leqs
| Exp.Const (Const.Cint n), e -> (* [ n-1 <= n' < e |- n <= e] *) | 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' | Exp.Const (Const.Cint n'), e' -> Exp.equal e e' && IntLit.leq (n -- IntLit.one) n'
| _, _ -> false) lts | _, _ -> false) lts
| _ -> Exp.equal e1 e2 | _ -> Exp.equal e1 e2
@ -457,11 +457,11 @@ end = struct
match e1, e2 with match e1, e2 with
| Exp.Const (Const.Cint n1), Exp.Const (Const.Cint n2) -> IntLit.lt n1 n2 | 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] *) | 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' | Exp.Const (Const.Cint n'), e' -> Exp.equal e e' && IntLit.leq n n'
| _, _ -> false) lts | _, _ -> false) lts
| e, Exp.Const (Const.Cint n) -> (* [e <= n' <= n-1 |- e < n] *) | 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) | e', Exp.Const (Const.Cint n') -> Exp.equal e e' && IntLit.leq n' (n -- IntLit.one)
| _, _ -> false) leqs | _, _ -> false) leqs
| _ -> false | _ -> false
@ -469,7 +469,7 @@ end = struct
(** Check [prop |- e1!=e2]. Result [false] means "don't know". *) (** Check [prop |- e1!=e2]. Result [false] means "don't know". *)
let check_ne ineq _e1 _e2 = let check_ne ineq _e1 _e2 =
let e1, e2 = if Exp.compare _e1 _e2 <= 0 then _e1, _e2 else _e2, _e1 in 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. *) (** Find a IntLit.t n such that [t |- e<=n] if possible. *)
let compute_upper_bound { leqs = leqs; lts = _; neqs = _ } e1 = 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 check_le ineq e1 e2 && check_le ineq e2 e1 in
let inconsistent_leq (e1, e2) = check_lt 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 let inconsistent_lt (e1, e2) = check_le ineq e2 e1 in
IList.exists inconsistent_neq neqs || List.exists ~f:inconsistent_neq neqs ||
IList.exists inconsistent_leq leqs || List.exists ~f:inconsistent_leq leqs ||
IList.exists inconsistent_lt lts List.exists ~f:inconsistent_lt lts
(* (*
(** Pretty print inequalities and disequalities *) (** 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 eq = Sil.Aeq(n_e1, n_e2) in
let n_eq = Prop.atom_normalize_prop tenv prop eq in let n_eq = Prop.atom_normalize_prop tenv prop eq in
let pi = prop.Prop.pi 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_equal () || check_equal_const () || check_equal_pi ()
(** Check [ |- e=0]. Result [false] means "don't know". *) (** 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 when IntLit.isone i -> check_lt_normalized tenv prop e1 e2
| Sil.Aeq (e1, e2) -> check_equal 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.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". *) (** Check [prop |- e1<=e2]. Result [false] means "don't know". *)
let check_le tenv prop e1 e2 = 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 is_root tenv prop iF n_e <> None || is_root tenv prop iB n_e <> None
else else
false false
in IList.exists f spatial_part in List.exists ~f spatial_part
(** Compute an upper bound of an expression *) (** Compute an upper bound of an expression *)
let compute_upper_bound_of_exp tenv p e = let compute_upper_bound_of_exp tenv p e =
@ -882,7 +882,7 @@ let check_inconsistency_base tenv prop =
Pvar.is_seed pv && Pvar.is_seed pv &&
(is_java_this pv || is_cpp_this pv || is_objc_instance_self pv) (is_java_this pv || is_cpp_this pv || is_objc_instance_self pv)
| _ -> false in | _ -> false in
IList.exists do_hpred sigma in List.exists ~f:do_hpred sigma in
let inconsistent_atom = function let inconsistent_atom = function
| Sil.Aeq (e1, e2) -> | Sil.Aeq (e1, e2) ->
(match e1, e2 with (match e1, e2 with
@ -905,7 +905,7 @@ let check_inconsistency_base tenv prop =
Inequalities.inconsistent ineq in Inequalities.inconsistent ineq in
inconsistent_ptsto () inconsistent_ptsto ()
|| check_inconsistency_two_hpreds tenv prop || check_inconsistency_two_hpreds tenv prop
|| IList.exists inconsistent_atom pi || List.exists ~f:inconsistent_atom pi
|| inconsistent_inequalities () || inconsistent_inequalities ()
|| inconsistent_this_self_var () || inconsistent_this_self_var ()
@ -1638,7 +1638,7 @@ let get_overrides_of tenv supertype pname =
| Tstruct name -> ( | Tstruct name -> (
match Tenv.lookup tenv name with match Tenv.lookup tenv name with
| Some { methods } -> | Some { methods } ->
IList.exists (fun m -> Procname.equal pname m) methods List.exists ~f:(fun m -> Procname.equal pname m) methods
| None -> | None ->
false false
) )
@ -1724,7 +1724,7 @@ let handle_parameter_subtype tenv prop1 sigma2 subs (e1, se1, texp1) (se2, texp2
let filter = function let filter = function
| Sil.Hpointsto(e', _, _) -> Exp.equal e' e | Sil.Hpointsto(e', _, _) -> Exp.equal e' e
| _ -> false in | _ -> false in
IList.exists filter prop1.Prop.sigma in List.exists ~f:filter prop1.Prop.sigma in
let type_rhs e = let type_rhs e =
let sub_opt = ref None in let sub_opt = ref None in
let filter = function 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); sub_opt := Some (t, len, sub);
true true
| _ -> false in | _ -> 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 let add_subtype () = match texp1, texp2, se1, se2 with
| Exp.Sizeof (Tptr (t1, _), None, _), Exp.Sizeof (Tptr (t2, _), None, _), | Exp.Sizeof (Tptr (t1, _), None, _), Exp.Sizeof (Tptr (t2, _), None, _),
Sil.Eexp (e1', _), Sil.Eexp (e2', _) 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) if not (Typ.equal typ_cont t' || List.is_empty array_cont)
then raise (Exceptions.Bad_footprint __POS__) in then raise (Exceptions.Bad_footprint __POS__) in
let index_in_array = 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 = let array_is_full =
match array_len with match array_len with
| Exp.Const (Const.Cint n') -> IntLit.geq (IntLit.of_int (IList.length array_cont)) n' | 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 pname tenv orig_prop footprint_part kind max_stamp se typ off' inst in
let atoms_se_typ_list_filtered = 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_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 IList.filter check_not_inconsistent atoms_se_typ_list in
if Config.trace_rearrange then L.d_strln "exiting strexp_extend_values"; if Config.trace_rearrange then L.d_strln "exiting strexp_extend_values";
let len, st = match te with 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 && (guarded_by_str_is_current_class guarded_by_str pname &&
Procdesc.is_java_synchronized pdesc && Procname.java_is_static pname) || Procdesc.is_java_synchronized pdesc && Procname.java_is_static pname) ||
(* or the prop says we already have the lock *) (* or the prop says we already have the lock *)
IList.exists List.exists
(function ~f:(function
| Sil.Apred (Alocked, _) -> true | Sil.Apred (Alocked, _) -> true
| _ -> false) | _ -> false)
(Attribute.get_for_exp tenv prop guarded_by_exp) in (Attribute.get_for_exp tenv prop guarded_by_exp) in
let guardedby_is_self_referential = let guardedby_is_self_referential =
String.equal "itself" (String.lowercase guarded_by_str) || 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. (where f is not the @GuardedBy field!), we will not warn.
*) *)
let is_accessible_through_local_ref exp = let is_accessible_through_local_ref exp =
IList.exists List.exists
(function ~f:(function
| Sil.Hpointsto (Lvar _, Eexp (rhs_exp, _), _) -> | Sil.Hpointsto (Lvar _, Eexp (rhs_exp, _), _) ->
Exp.equal exp rhs_exp Exp.equal exp rhs_exp
| Sil.Hpointsto (_, Estruct (flds, _), _) -> | Sil.Hpointsto (_, Estruct (flds, _), _) ->
IList.exists List.exists
(fun (fld, strexp) -> match strexp with ~f:(fun (fld, strexp) -> match strexp with
| Sil.Eexp (rhs_exp, _) -> | Sil.Eexp (rhs_exp, _) ->
Exp.equal exp rhs_exp && not (Ident.equal_fieldname fld accessed_fld) Exp.equal exp rhs_exp && not (Ident.equal_fieldname fld accessed_fld)
| _ -> | _ ->
false) false)
flds flds
| _ -> false) | _ -> false)
prop.Prop.sigma in prop.Prop.sigma in
Procdesc.get_access pdesc <> PredSymb.Private && Procdesc.get_access pdesc <> PredSymb.Private &&
not (Annotations.pdesc_return_annot_ends_with pdesc Annotations.visibleForTesting) && 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) -> | Typ.Tptr (_, Pk_objc_weak) ->
Mangled.equal (Pvar.get_name pvar) var Mangled.equal (Pvar.get_name pvar) var
| _ -> false in | _ -> false in
IList.exists is_weak_captured (Procdesc.get_captured pdesc) List.exists ~f:is_weak_captured (Procdesc.get_captured pdesc)
| _ -> false | _ -> 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); nullable_obj_str := Some (Procname.to_string pname);
true true
| _ -> false in | _ -> 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 *) (* it's ok for a non-nullable local to point to deref_exp *)
is_nullable || Pvar.is_local pvar is_nullable || Pvar.is_local pvar
| Sil.Hpointsto (_, Sil.Estruct (flds, _), Exp.Sizeof (typ, _, _)) -> | 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 match get_exp_called () with
| Some (_, Exp.Lvar pvar) -> (* pvar is the block *) | Some (_, Exp.Lvar pvar) -> (* pvar is the block *)
let name = Pvar.get_name pvar in 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 | _ -> false in
let is_field_deref () = (*Called expression is a field *) let is_field_deref () = (*Called expression is a field *)
match get_exp_called () with 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 | _ -> raise Not_found in
let duplicates = let duplicates =
let equal_normalized_instrs (_, normalized_instrs') = 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.filter equal_normalized_instrs elements in
IList.fold_left IList.fold_left
(fun nset (node', _) -> Procdesc.NodeSet.add node' nset) (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 = let block_captured =
match AttributesTable.load_attributes block_pname with match AttributesTable.load_attributes block_pname with
| Some attributes -> | Some attributes ->
fst (IList.split attributes.ProcAttributes.captured) fst (List.unzip attributes.ProcAttributes.captured)
| None -> | None ->
[] in [] in
let prop' = Prop.remove_seed_captured_vars_block tenv block_captured prop 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) ref ((IList.map Procname.from_string_c_fun) dangerous_list)
let check_inherently_dangerous_function caller_pname callee_pname = 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 = let exn =
Exceptions.Inherently_dangerous_function Exceptions.Inherently_dangerous_function
(Localise.desc_inherently_dangerous_function callee_pname) in (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 = let method_exists right_proc_name methods =
if Config.curr_language_is Config.Java then 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 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 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. *) 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 resolved_pname = do_resolve callee_pname receiver_exp actual_receiver_typ in
let feasible_targets = IList.filter may_dispatch_to targets in let feasible_targets = IList.filter may_dispatch_to targets in
(* make sure [resolved_pname] is not a duplicate *) (* 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 then feasible_targets
else resolved_pname :: feasible_targets else resolved_pname :: feasible_targets
else 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 *) let is_rec_call pname = (* TODO: (t7147096) extend this to detect mutual recursion *)
Procname.equal pname (Procdesc.get_proc_name pdesc) in Procname.equal pname (Procdesc.get_proc_name pdesc) in
let already_has_abduced_retval p abduced_ret_pv = let already_has_abduced_retval p abduced_ret_pv =
IList.exists List.exists
(fun hpred -> match hpred with ~f:(fun hpred -> match hpred with
| Sil.Hpointsto (Exp.Lvar pv, _, _) -> Pvar.equal pv abduced_ret_pv | Sil.Hpointsto (Exp.Lvar pv, _, _) -> Pvar.equal pv abduced_ret_pv
| _ -> false) | _ -> false)
p.Prop.sigma_fp in p.Prop.sigma_fp in
(* find an hpred [abduced] |-> A in [prop] and add [exp] = A to prop *) (* find an hpred [abduced] |-> A in [prop] and add [exp] = A to prop *)
let bind_exp_to_abduced_val exp_to_bind abduced 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 = let abduced_ref_pv =
Pvar.mk_abduced_ref_param callee_pname actual_pv callee_loc in Pvar.mk_abduced_ref_param callee_pname actual_pv callee_loc in
let already_has_abduced_retval p = let already_has_abduced_retval p =
IList.exists List.exists
(fun hpred -> match hpred with ~f:(fun hpred -> match hpred with
| Sil.Hpointsto (Exp.Lvar pv, _, _) -> Pvar.equal pv abduced_ref_pv | Sil.Hpointsto (Exp.Lvar pv, _, _) -> Pvar.equal pv abduced_ref_pv
| _ -> false) | _ -> false)
p.Prop.sigma_fp in p.Prop.sigma_fp in
(* prevent introducing multiple abduced retvals for a single call site in a loop *) (* prevent introducing multiple abduced retvals for a single call site in a loop *)
if already_has_abduced_retval prop then prop 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) = let is_not_const (e, _, i) =
match AttributesTable.load_attributes callee_pname with match AttributesTable.load_attributes callee_pname with
| Some attrs -> | Some attrs ->
let is_const = IList.mem Int.equal i attrs.ProcAttributes.const_formals in let is_const = List.mem ~equal:Int.equal attrs.ProcAttributes.const_formals i in
if is_const then ( if is_const then (
L.d_str (Printf.sprintf "Not havocing const argument number %d: " i); L.d_str (Printf.sprintf "Not havocing const argument number %d: " i);
Sil.d_exp e; Sil.d_exp e;
@ -1621,7 +1621,7 @@ and sym_exec_wrapper handle_exn tenv pdesc instr ((prop: Prop.normal Prop.t), pa
let instr_is_abstraction = function let instr_is_abstraction = function
| Sil.Abstract _ -> true | Sil.Abstract _ -> true
| _ -> false in | _ -> 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 let curr_node = State.get_node () in
match Procdesc.Node.get_kind curr_node with match Procdesc.Node.get_kind curr_node with
| Procdesc.Node.Prune_node _ when not (node_has_abstraction curr_node) -> | 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 -> | Sil.Hpointsto (e1, Sil.Eexp(e2, _), _) when Exp.equal e1 ret_pvar ->
exp_is_exn e2 exp_is_exn e2
| _ -> false in | _ -> 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 *) (** when prop is an exception, return the exception name *)
let prop_get_exn_name pname prop = let prop_get_exn_name pname prop =
@ -728,7 +728,7 @@ let combine tenv
| Sil.Aeq (Exp.Var id', Exp.Const (Const.Cint i)) -> | Sil.Aeq (Exp.Var id', Exp.Const (Const.Cint i)) ->
Ident.equal id id' && IntLit.isnull i Ident.equal id id' && IntLit.isnull i
| _ -> false in | _ -> 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 let f (e, inst_opt) = match e, inst_opt with
| Exp.Var id, Some inst when id_assigned_to_null id -> | Exp.Var id, Some inst when id_assigned_to_null id ->
let inst' = Sil.inst_set_null_case_flag inst in let inst' = Sil.inst_set_null_case_flag inst in
@ -789,7 +789,7 @@ let combine tenv
else Some post_p3 in else Some post_p3 in
post_p4 in post_p4 in
let _results = IList.map (fun (p, path) -> (compute_result p, path)) instantiated_post 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 None
else else
let results = 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 nullness. meant to eliminate false NPE warnings from the common
"if (get() != null) get().something()" pattern *) "if (get() != null) get().something()" pattern *)
let last_call_ret_non_null = let last_call_ret_non_null =
IList.exists List.exists
(function ~f:(function
| Sil.Apred (Aretval (pname, _), [exp]) when Procname.equal callee_pname pname -> | Sil.Apred (Aretval (pname, _), [exp]) when Procname.equal callee_pname pname ->
Prover.check_disequal tenv prop exp Exp.zero Prover.check_disequal tenv prop exp Exp.zero
| _ -> false) | _ -> false)
(Attribute.get_all prop) in (Attribute.get_all prop) in
if last_call_ret_non_null then if last_call_ret_non_null then
let returns_null prop = let returns_null prop =
IList.exists List.exists
(function ~f:(function
| Sil.Hpointsto (Exp.Lvar pvar, Sil.Eexp (e, _), _) when Pvar.is_return pvar -> | Sil.Hpointsto (Exp.Lvar pvar, Sil.Eexp (e, _), _) when Pvar.is_return pvar ->
Prover.check_equal tenv (Prop.normalize tenv prop) e Exp.zero Prover.check_equal tenv (Prop.normalize tenv prop) e Exp.zero
| _ -> false) | _ -> false)
prop.Prop.sigma in prop.Prop.sigma in
IList.filter (fun (prop, _) -> not (returns_null prop)) posts IList.filter (fun (prop, _) -> not (returns_null prop)) posts
else posts in 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 let not_untaint_atom atom = not
(Exp.Map.exists (Exp.Map.exists
(fun _ (_, untaint_atoms) -> (fun _ (_, untaint_atoms) ->
IList.exists List.exists
(fun a -> Sil.equal_atom atom a) ~f:(fun a -> Sil.equal_atom atom a)
untaint_atoms) untaint_atoms)
taint_untaint_exp_map) in taint_untaint_exp_map) in
check_taint_on_variadic_function tenv callee_pname caller_pname actual_params calling_prop; 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 assert false
else (* no dereference error detected *) else (* no dereference error detected *)
let desc = 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) call_desc (Some Localise.Pnm_dangling)
else if IList.exists (function else if List.exists ~f:(function
| Prover_checks (check :: _) -> | Prover_checks (check :: _) ->
trace_call Specs.CallStats.CR_not_met; trace_call Specs.CallStats.CR_not_met;
let exn = get_check_exn tenv check callee_pname loc __POS__ in let exn = get_check_exn tenv check callee_pname loc __POS__ in
@ -1307,27 +1307,3 @@ let exe_function_call
formal_params in formal_params in
let results = IList.map exe_one_spec spec_list 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 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) = let fld_has_taint_annot (fname, _, annot) =
Ident.equal_fieldname fieldname fname && Ident.equal_fieldname fieldname fname &&
(Annotations.ia_is_privacy_source annot || Annotations.ia_is_integrity_source annot) in (Annotations.ia_is_privacy_source annot || Annotations.ia_is_integrity_source annot) in
IList.exists fld_has_taint_annot struct_typ.fields || List.exists ~f: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.statics
(* add tainting attributes to a list of paramenters *) (* add tainting attributes to a list of paramenters *)
let get_params_to_taint tainted_param_nums formal_params = 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 *) (* translate Symbol to String for better formatting of --help messages *)
| Symbol (symbols, action) -> | Symbol (symbols, action) ->
String (fun arg -> String (fun arg ->
if IList.mem String.equal arg symbols then if List.mem ~equal:String.equal symbols arg then
action arg action arg
else else
raise (Arg.Bad (F.sprintf "wrong argument '%s'; option '%s' expects one of: %s" 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 ; full_desc_list := desc :: !full_desc_list ;
IList.iter (fun (exe, desc_list) -> IList.iter (fun (exe, desc_list) ->
let desc = let desc =
if IList.mem equal_exe exe exes then if List.mem ~equal:equal_exe exes exe then
desc desc
else else
{desc with meta = ""; doc = ""} in {desc with meta = ""; doc = ""} in

@ -217,8 +217,8 @@ let global_tenv_fname =
filename_concat captured_dir basename filename_concat captured_dir basename
let is_source_file path = let is_source_file path =
IList.exists List.exists
(fun ext -> Filename.check_suffix path ext) ~f:(fun ext -> Filename.check_suffix path ext)
Config.source_file_extentions Config.source_file_extentions
let infer_start_time = lazy let infer_start_time = lazy

@ -9,9 +9,6 @@
type 'a t = 'a list [@@deriving compare] type 'a t = 'a list [@@deriving compare]
let equal cmp l1 l2 =
compare cmp l1 l2 = 0
let exists = List.exists let exists = List.exists
let filter = List.filter let filter = List.filter
let find = List.find 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 fold_left (fun (i, acc) e -> i +1, f acc i e) (0, a) l
|> snd |> 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 *) (** tail-recursive variant of List.flatten *)
let flatten = let flatten =
let rec flatten acc l = match l with let rec flatten acc l = match l with
@ -88,10 +64,6 @@ let rec drop_first n = function
let drop_last n list = let drop_last n list =
rev (drop_first n (rev 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 *) (** tail-recursive variant of List.map *)
let map f l = let map f l =
rev (rev_map f l) rev (rev_map f l)

@ -9,16 +9,6 @@
type 'a t = 'a list [@@deriving compare] 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 val filter : ('a -> bool) -> 'a list -> 'a list
(** tail-recursive variant of List.flatten *) (** 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 *) (** tail-recursive variant of List.mapi *)
val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list 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 nth : 'a list -> int -> 'a
val partition : ('a -> bool) -> 'a list -> 'a list * 'a list val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
val rev : '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 rev_map : ('a -> 'b) -> 'a list -> 'b list
val sort : ('a -> 'a -> int) -> 'a list -> 'a 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 stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
val tl : '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 header_exts = ["h"; "hh"; "hpp"; "hxx"] in
let file_no_ext, ext_opt = Filename.split_extension abs_path in let file_no_ext, ext_opt = Filename.split_extension abs_path in
let file_opt = match ext_opt with let file_opt = match ext_opt with
| Some ext when IList.mem String.equal ext header_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 let possible_files = IList.map (fun ext -> file_no_ext ^ "." ^ ext) source_exts in
try Some (IList.find path_exists possible_files) try Some (IList.find path_exists possible_files)
with Not_found -> None with Not_found -> None

@ -377,7 +377,7 @@ struct
let get_symbols : t -> Itv.Symbol.t list let get_symbols : t -> Itv.Symbol.t list
= fun x -> = 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 let normalize : t -> t
= fun x -> = fun x ->

@ -11,7 +11,6 @@
*) *)
open! IStd open! IStd
open Core_kernel.Fn
open AbsLoc open AbsLoc
module F = Format module F = Format
@ -69,7 +68,7 @@ struct
| Exp.Lfield (e, fn, _) -> | Exp.Lfield (e, fn, _) ->
eval e mem loc eval e mem loc
|> Val.get_all_locs |> Val.get_all_locs
|> flip PowLoc.append_field fn |> Fn.flip PowLoc.append_field fn
|> Val.of_pow_loc |> Val.of_pow_loc
| Exp.Lindex (e1, _) -> | Exp.Lindex (e1, _) ->
let arr = eval e1 mem loc in (* must have array blk *) let arr = eval e1 mem loc in (* must have array blk *)
@ -342,7 +341,7 @@ struct
let new_matching = let new_matching =
get_matching_pairs tenv formal actual typ caller_mem callee_entry_mem get_matching_pairs tenv formal actual typ caller_mem callee_entry_mem
in in
IList.append new_matching l List.append new_matching l
in in
let formals = get_formals callee_pdesc in let formals = get_formals callee_pdesc in
let actuals = IList.map (fun (a, _) -> eval a caller_mem loc) params 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 let get_symbols : t -> Symbol.t list
= fun (l, u) -> = 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 let normalize : t -> t option
= fun (l, u) -> = fun (l, u) ->

@ -151,8 +151,8 @@ let report_siof trace pdesc gname loc =
Reporting.log_error caller_pname ~loc ~ltr exn in Reporting.log_error caller_pname ~loc ~ltr exn in
let has_foreign_sink (_, path) = let has_foreign_sink (_, path) =
IList.exists List.exists
(fun (sink, _) -> ~f:(fun (sink, _) ->
GlobalsAccesses.exists (is_foreign tu_opt) GlobalsAccesses.exists (is_foreign tu_opt)
(SiofTrace.Sink.kind sink)) (SiofTrace.Sink.kind sink))
path in path in

@ -434,7 +434,8 @@ let is_immutable_collection_class class_name tenv =
] in ] in
PatternMatch.supertype_exists PatternMatch.supertype_exists
tenv 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 class_name
let is_call_to_builder_class_method = function 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 = let calculate_addendum_message tenv pname =
match get_current_class_and_threadsafe_superclasses tenv pname with match get_current_class_and_threadsafe_superclasses tenv pname with
| Some (current_class,thread_safe_annotated_classes) -> | 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 match thread_safe_annotated_classes with
| hd::_ -> F.asprintf "\n Note: Superclass %a is marked @ThreadSafe." Typename.pp hd | 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, _) -> fun (_, tenv, pname, _) ->
PatternMatch.check_current_class_attributes Annotations.ia_is_not_thread_safe tenv pname PatternMatch.check_current_class_attributes Annotations.ia_is_not_thread_safe tenv pname
in in
not (IList.exists current_class_marked_not_threadsafe file_env) && not (List.exists ~f:current_class_marked_not_threadsafe file_env) &&
IList.exists current_class_or_super_marked_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. (* 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. *) This indicates that the method races with itself. To be refined later. *)

@ -69,11 +69,11 @@ type annotated_signature = {
} [@@deriving compare] } [@@deriving compare]
let ia_has_annotation_with (ia: Annot.Item.t) (predicate: Annot.t -> bool): bool = 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 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 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, (** [annot_ends_with annot ann_name] returns true if the class name of [annot], without the package,
is equal to [ann_name] *) is equal to [ann_name] *)
@ -86,10 +86,10 @@ let class_name_matches s ((annot : Annot.t), _) =
String.equal s annot.class_name String.equal s annot.class_name
let ia_ends_with ia ann_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 = 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 = let ia_get ia ann_name =
try Some (fst (IList.find (class_name_matches ann_name) ia)) 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 pdesc_has_parameter_annot pdesc predicate =
let _, param_annotations = (Procdesc.get_attributes pdesc).ProcAttributes.method_annotation in 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 = let pdesc_get_return_annot pdesc =
fst (Procdesc.get_attributes pdesc).ProcAttributes.method_annotation 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 field_has_annot fieldname (struct_typ : StructTyp.t) predicate =
let fld_has_taint_annot (fname, _, annot) = let fld_has_taint_annot (fname, _, annot) =
Ident.equal_fieldname fieldname fname && predicate annot in Ident.equal_fieldname fieldname fname && predicate annot in
IList.exists fld_has_taint_annot struct_typ.fields || List.exists ~f: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.statics
let struct_typ_has_annot (struct_typ : StructTyp.t) predicate = let struct_typ_has_annot (struct_typ : StructTyp.t) predicate =
predicate struct_typ.annots predicate struct_typ.annots
@ -143,8 +143,8 @@ let ia_is_present ia =
ia_ends_with ia present ia_ends_with ia present
let ia_is_nonnull ia = let ia_is_nonnull ia =
IList.exists List.exists
(ia_ends_with ia) ~f:(ia_ends_with ia)
[nonnull; notnull; camel_nonnull] [nonnull; notnull; camel_nonnull]
let ia_is_false_on_null ia = let ia_is_false_on_null ia =
@ -179,15 +179,15 @@ let field_injector_readonly_list =
(** Annotations for readonly injectors. (** Annotations for readonly injectors.
The injector framework initializes the field but does not write null into it. *) The injector framework initializes the field but does not write null into it. *)
let ia_is_field_injector_readonly ia = let ia_is_field_injector_readonly ia =
IList.exists List.exists
(ia_ends_with ia) ~f:(ia_ends_with ia)
field_injector_readonly_list field_injector_readonly_list
(** Annotations for read-write injectors. (** Annotations for read-write injectors.
The injector framework initializes the field and can write null into it. *) The injector framework initializes the field and can write null into it. *)
let ia_is_field_injector_readwrite ia = let ia_is_field_injector_readwrite ia =
IList.exists List.exists
(ia_ends_with ia) ~f:(ia_ends_with ia)
field_injector_readwrite_list field_injector_readwrite_list
let ia_is_mutable ia = 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 *) (** Check if the given parameter has a Nullable annotation in the given signature *)
let param_is_nullable pvar ann_sig = let param_is_nullable pvar ann_sig =
IList.exists List.exists
(fun (param, annot, _) -> ~f:(fun (param, annot, _) ->
Mangled.equal param (Pvar.get_name pvar) && ia_is_nullable annot) Mangled.equal param (Pvar.get_name pvar) && ia_is_nullable annot)
ann_sig.params ann_sig.params

@ -58,10 +58,10 @@ module APIs = struct
false false
let is_begin pn = let is_begin pn =
let filter (pkgname, cname, begin_name, _) = method_match pn pkgname cname begin_name in 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 is_end pn =
let filter (pkgname, cname, _, end_name) = method_match pn pkgname cname end_name in 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 = let is_begin_or_end pn =
is_begin pn || is_end pn is_begin pn || is_end pn
end end
@ -228,7 +228,7 @@ module BooleanVars = struct
let exp_boolean_var exp = match exp with let exp_boolean_var exp = match exp with
| Exp.Lvar pvar when Pvar.is_local pvar -> | Exp.Lvar pvar when Pvar.is_local pvar ->
let name = Mangled.to_string (Pvar.get_name pvar) in let name = Mangled.to_string (Pvar.get_name pvar) in
if IList.mem String.equal name boolean_variables if List.mem ~equal:String.equal boolean_variables name
then Some name then Some name
else None else None
| _ -> None | _ -> None

@ -99,7 +99,7 @@ module ST = struct
let is_parameter_suppressed = let is_parameter_suppressed =
String.is_suffix a.class_name ~suffix:Annotations.suppress_lint && 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 = let is_annotation_suppressed =
String.is_suffix ~suffix:(normalize (drop_prefix kind)) (normalize a.class_name) in 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 | _ -> false in
let is_formal_param exp = 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 let is_nullcheck pn = match pn with
| Procname.Java pn_java -> | 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" "java.util.Set", "com.google.common.collect.ImmutableSet"
] in ] in
let in_casts expected given = 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 expected) x
&& String.equal (Typename.name given) y && String.equal (Typename.name given) y
) casts in ) 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 = let rec supertype_exists tenv pred name =
match Tenv.lookup tenv name with match Tenv.lookup tenv name with
| Some ({supers} as struct_typ) -> | 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 -> | None ->
false 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 = let is_immediate_subtype tenv this_type_name super_type_name =
match Tenv.lookup tenv this_type_name with 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 | None -> false
(** return true if [typ0] <: [typ1] *) (** return true if [typ0] <: [typ1] *)
@ -99,7 +99,7 @@ let type_get_annotation tenv (typ: Typ.t): Annot.Item.t option =
| _ -> None | _ -> None
let type_has_direct_supertype tenv (typ : Typ.t) (class_name : Typename.t) = 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 let type_has_supertype
(tenv: Tenv.t) (tenv: Tenv.t)
@ -114,12 +114,12 @@ let type_has_supertype
let match_name () = Typename.equal cn class_name in let match_name () = Typename.equal cn class_name in
let has_indirect_supertype () = has_supertype (Typ.Tstruct cn) (Typ.Set.add typ visited) in let has_indirect_supertype () = has_supertype (Typ.Tstruct cn) (Typ.Set.add typ visited) in
(match_name () || has_indirect_supertype ()) 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 has_supertype typ Typ.Set.empty
let type_is_nested_in_direct_supertype tenv t n = 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 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 let rec get_type_name = function
| Typ.Tstruct name -> | Typ.Tstruct name ->
@ -274,7 +274,7 @@ let type_has_initializer
(tenv: Tenv.t) (tenv: Tenv.t)
(t: Typ.t): bool = (t: Typ.t): bool =
let check_candidate class_name = type_has_supertype tenv t class_name in 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. *) (** Check if the method is one of the known initializer methods. *)
let method_is_initializer let method_is_initializer
@ -286,7 +286,7 @@ let method_is_initializer
match proc_attributes.ProcAttributes.proc_name with match proc_attributes.ProcAttributes.proc_name with
| Procname.Java pname_java -> | Procname.Java pname_java ->
let mname = Procname.java_get_method pname_java in let mname = Procname.java_get_method pname_java in
IList.exists (String.equal mname) initializer_methods List.exists ~f:(String.equal mname) initializer_methods
| _ -> | _ ->
false false
else else
@ -337,15 +337,15 @@ let override_exists f tenv proc_name =
| Some ({ methods; supers; }) -> | Some ({ methods; supers; }) ->
let is_override pname = let is_override pname =
Procname.equal pname super_proc_name && not (Procname.is_constructor pname) in Procname.equal pname super_proc_name && not (Procname.is_constructor pname) in
IList.exists (fun pname -> is_override pname && f pname) methods || List.exists ~f:(fun pname -> is_override pname && f pname) methods ||
IList.exists (super_type_exists tenv) supers List.exists ~f:(super_type_exists tenv) supers
| _ -> | _ ->
false in false in
match proc_name with match proc_name with
| Procname.Java proc_name_java -> | Procname.Java proc_name_java ->
let type_name = Typename.Java.from_string (Procname.java_get_class_name proc_name_java) in let type_name = Typename.Java.from_string (Procname.java_get_class_name proc_name_java) in
IList.exists List.exists
(super_type_exists tenv) ~f:(super_type_exists tenv)
(type_get_direct_supertypes tenv (Typ.Tstruct type_name)) (type_get_direct_supertypes tenv (Typ.Tstruct type_name))
| _ -> | _ ->
false (* Only java supported at the moment *) false (* Only java supported at the moment *)

@ -69,15 +69,15 @@ let format_type_matches_given_type
(given_type: string): bool = (given_type: string): bool =
match format_type with match format_type with
| "d" | "i" | "u" | "x" | "X" | "o" -> | "d" | "i" | "u" | "x" | "X" | "o" ->
IList.mem List.mem
String.equal ~equal:String.equal
given_type
["java.lang.Integer"; "java.lang.Long"; "java.lang.Short"; "java.lang.Byte"] ["java.lang.Integer"; "java.lang.Long"; "java.lang.Short"; "java.lang.Byte"]
| "a" | "A" | "f" | "F" | "g" | "G" | "e" | "E" ->
IList.mem
String.equal
given_type given_type
| "a" | "A" | "f" | "F" | "g" | "G" | "e" | "E" ->
List.mem
~equal:String.equal
["java.lang.Double"; "java.lang.Float"] ["java.lang.Double"; "java.lang.Float"]
given_type
| "c" -> String.equal given_type "java.lang.Character" | "c" -> String.equal given_type "java.lang.Character"
| "b" | "h" | "H" | "s" -> true (* accepts pretty much anything, even null *) | "b" | "h" | "H" | "s" -> true (* accepts pretty much anything, even null *)
| _ -> false | _ -> false

@ -151,7 +151,7 @@ module Exceptional = struct
let existing_exn_preds = let existing_exn_preds =
try Procdesc.IdMap.find exn_succ_node_id exn_preds_acc try Procdesc.IdMap.find exn_succ_node_id exn_preds_acc
with Not_found -> [] in 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 *) then (* don't add duplicates *)
Procdesc.IdMap.add exn_succ_node_id (n :: existing_exn_preds) exn_preds_acc Procdesc.IdMap.add exn_succ_node_id (n :: existing_exn_preds) exn_preds_acc
else 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 let matches s r = Str.string_match r s 0 in
match const_map node rvar1, const_map node rvar2 with match const_map node rvar1, const_map node rvar2 with
| Some (Const.Cstr ""), Some (Const.Cstr s2) -> | 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 begin
L.stdout L.stdout
"%s%s@." "%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 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 => let can_attach_ast_exporter cmd =>
has_flag cmd "-cc1" && ( has_flag cmd "-cc1" && (
@ -122,7 +122,7 @@ let clang_cc1_cmd_sanitizer cmd => {
| [] => | [] =>
/* return non-reversed list */ /* return non-reversed list */
IList.rev (post_args_rev @ res_rev) IList.rev (post_args_rev @ res_rev)
| [flag, ...tl] when IList.mem String.equal flag flags_blacklist => | [flag, ...tl] when List.mem equal::String.equal flags_blacklist flag =>
filter_unsupported_args_and_swap_includes (flag, res_rev) tl filter_unsupported_args_and_swap_includes (flag, res_rev) tl
| [arg, ...tl] => { | [arg, ...tl] => {
let res_rev' = [replace_option_arg prev arg, ...res_rev]; let res_rev' = [replace_option_arg prev arg, ...res_rev];

@ -55,7 +55,7 @@ let rec is_component_or_controller_descendant_impl decl =
Does not recurse into hierarchy. *) Does not recurse into hierarchy. *)
and contains_ck_impl decl_list = 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 (** An easy way to fix the component kit best practice
http://componentkit.org/docs/avoid-local-variables.html http://componentkit.org/docs/avoid-local-variables.html
@ -97,9 +97,9 @@ let mutable_local_vars_advice context an =
let objc_whitelist = ["NSError"] in let objc_whitelist = ["NSError"] in
match get_referenced_type qual_type with match get_referenced_type qual_type with
| Some CXXRecordDecl (_, ndi, _, _, _, _, _, _) -> | Some CXXRecordDecl (_, ndi, _, _, _, _, _, _) ->
IList.mem String.equal ndi.ni_name cpp_whitelist List.mem ~equal:String.equal cpp_whitelist ndi.ni_name
| Some ObjCInterfaceDecl (_, ndi, _, _, _) -> | Some ObjCInterfaceDecl (_, ndi, _, _, _) ->
IList.mem String.equal ndi.ni_name objc_whitelist List.mem ~equal:String.equal objc_whitelist ndi.ni_name
| _ -> false in | _ -> false in
match an with match an with
@ -172,14 +172,16 @@ let component_with_unconventional_superclass_advice context an =
let has_conventional_superclass = let has_conventional_superclass =
let open CFrontend_config in let open CFrontend_config in
match superclass_name with match superclass_name with
| Some name when IList.mem String.equal name [ | Some name when List.mem ~equal:String.equal
ckcomponent_cl; [
ckcomponentcontroller_cl; ckcomponent_cl;
"CKCompositeComponent"; ckcomponentcontroller_cl;
"CKStatefulViewComponent"; "CKCompositeComponent";
"CKStatefulViewComponentController"; "CKStatefulViewComponent";
"NTNativeTemplateComponent" "CKStatefulViewComponentController";
] -> true "NTNativeTemplateComponent"
]
name -> true
| _ -> false in | _ -> false in
let condition = let condition =
is_component_or_controller_if (Some if_decl) 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.CXXCatchStmt _
| Clang_ast_t.ConditionalOperator _ -> true | Clang_ast_t.ConditionalOperator _ -> true
| Clang_ast_t.BinaryOperator (_, _, _, boi) -> | 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 | _ -> false in
let cyclo_loc_opt an = match an with let cyclo_loc_opt an = match an with
| CTL.Stmt stmt when (Config.compute_analytics | 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 if atomic_pred param st then true
else else
let _, st_list = Clang_ast_proj.get_stmt_tuple st in 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 = let is_syntactically_global_var decl =
match decl with match decl with
@ -410,7 +410,7 @@ let rec is_objc_if_descendant ?(blacklist = default_blacklist) if_decl ancestors
match if_decl with match if_decl with
| Some Clang_ast_t.ObjCInterfaceDecl (_, ndi, _, _, _) -> | Some Clang_ast_t.ObjCInterfaceDecl (_, ndi, _, _, _) ->
let in_list some_list = 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) not (in_list blacklist)
&& (in_list ancestors && (in_list ancestors
|| is_objc_if_descendant ~blacklist:blacklist (get_super_if if_decl) ancestors) || is_objc_if_descendant ~blacklist:blacklist (get_super_if if_decl) ancestors)

@ -126,9 +126,9 @@ let add_block_static_var context block_name static_var_typ =
(let new_static_vars, duplicate = (let new_static_vars, duplicate =
try try
let static_vars = Procname.Map.find block_name outer_context.blocks_static_vars in 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 fun (var1, _) (var2, _) -> Pvar.equal var1 var2
) static_var_typ static_vars then ) static_vars static_var_typ then
static_vars, true static_vars, true
else else
static_var_typ :: static_vars, false 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.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.is_prefix (List.rev qual_name) ~prefix:(List.rev rest) ~equal:qual_equal
| _ -> List.equal ~equal:qual_equal whitelisted_method qual_name in | _ -> 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 (** Given REVERSED list of method qualifiers (method_name::class_name::rest_quals), return
whether method should be translated based on method and class whitelists *) 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 = let rec append_no_duplicates eq list1 list2 =
match list2 with match list2 with
| el:: rest2 -> | el:: rest2 ->
if (IList.mem eq el list1) then if (List.mem ~equal:eq list1 el) then
(append_no_duplicates eq list1 rest2) (append_no_duplicates eq list1 rest2)
else (append_no_duplicates eq list1 rest2)@[el] else (append_no_duplicates eq list1 rest2)@[el]
| [] -> list1 | [] -> 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 file_in_project = SourceFile.is_under_project_root source_file in
let rel_source_file = SourceFile.to_string source_file in let rel_source_file = SourceFile.to_string source_file in
let file_should_be_skipped = let file_should_be_skipped =
IList.exists List.exists
(fun path -> String.is_prefix ~prefix:path rel_source_file) ~f:(fun path -> String.is_prefix ~prefix:path rel_source_file)
Config.skip_translation_headers in Config.skip_translation_headers in
file_in_project && not (file_should_be_skipped) 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 is_file_blacklisted file =
let paths = Config.skip_clang_analysis_in_path in let paths = Config.skip_clang_analysis_in_path in
let is_file_blacklisted = let is_file_blacklisted =
IList.exists List.exists
(fun path -> Str.string_match (Str.regexp ("^.*/" ^ path)) file 0) ~f:(fun path -> Str.string_match (Str.regexp ("^.*/" ^ path)) file 0)
paths in paths in
is_file_blacklisted is_file_blacklisted

@ -92,7 +92,7 @@ let decl_ref_is_in names st =
| Clang_ast_t.DeclRefExpr (_, _, _, drti) -> | Clang_ast_t.DeclRefExpr (_, _, _, drti) ->
(match drti.drti_decl_ref with (match drti.drti_decl_ref with
| Some dr -> let ndi, _, _ = CAst_utils.get_info_from_decl_ref dr in | 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)
| _ -> false | _ -> false
@ -137,7 +137,7 @@ let is_ivar_atomic stmt =
(match CAst_utils.get_decl ivar_pointer with (match CAst_utils.get_decl ivar_pointer with
| Some d -> | Some d ->
let attributes = get_ivar_attributes d in let attributes = get_ivar_attributes d in
IList.exists (PVariant.(=) `Atomic) attributes List.exists ~f:(PVariant.(=) `Atomic) attributes
| _ -> false) | _ -> false)
| _ -> 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 *) (* true iff an ast node is a node of type among the list tl *)
let node_has_type tl an = let node_has_type tl an =
let an_str = node_to_string an in let an_str = node_to_string an in
IList.mem String.equal an_str tl List.mem ~equal:String.equal tl an_str
(* given a decl returns a stmt such that decl--->stmt via label trs *) (* given a decl returns a stmt such that decl--->stmt via label trs *)
let transition_decl_to_stmt d trs = let transition_decl_to_stmt d trs =
@ -437,7 +437,7 @@ and eval_EF phi an lcxt trans =
eval_formula phi' an lcxt eval_formula phi' an lcxt
| None, _ -> | None, _ ->
eval_formula phi an lcxt 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 *) (* Evaluate phi on node an' such that an -l-> an'. False if an' does not exists *)
and evaluate_on_transition phi an lcxt l = and evaluate_on_transition phi an lcxt l =
@ -455,7 +455,7 @@ and eval_EX phi an lcxt trans =
match trans, an with match trans, an with
| Some _, _ -> evaluate_on_transition phi an lcxt trans | Some _, _ -> evaluate_on_transition phi an lcxt trans
| None, _ -> | 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) evaluated using the equivalence
an, lcxt |= E(phi1 U phi2) <=> an, lcxt |= phi2 or (phi1 and EX(E(phi1 U phi2))) 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) (String.equal id (node_to_unique_string_id an)) && (eval_formula phi an lctx)
| None -> | None ->
(node_has_type [n] an) && (eval_formula phi an lctx) in (node_has_type [n] an) && (eval_formula phi an lctx) in
IList.exists holds_for_one_node node_type_list List.exists ~f:holds_for_one_node node_type_list
(* Intuitive meaning: (an,lcxt) satifies EH[Classes] phi (* Intuitive meaning: (an,lcxt) satifies EH[Classes] phi

@ -133,8 +133,8 @@ struct
let create_field_exp (var, typ) = let create_field_exp (var, typ) =
let id = Ident.create_fresh Ident.knormal in let id = Ident.create_fresh Ident.knormal in
id, Sil.Load (id, Exp.Lvar var, typ, loc) 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 ids, captured_instrs = List.unzip (IList.map create_field_exp captured_vars) in
let fields_ids = IList.combine fields ids in let fields_ids = List.zip_exn fields ids in
let set_fields = IList.map (fun ((f, t, _), id) -> 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 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) @ (declare_block_local :: trans_res.instrs) @
@ -807,7 +807,7 @@ struct
let (sil_e2, _) = extract_exp_from_list res_trans_e2.exps let (sil_e2, _) = extract_exp_from_list res_trans_e2.exps
"\nWARNING: Missing RHS operand in BinOp. Returning -1. Fix needed...\n" in "\nWARNING: Missing RHS operand in BinOp. Returning -1. Fix needed...\n" in
let binop_res_trans, exp_to_parent = 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 else
let exp_op, instr_bin = let exp_op, instr_bin =
CArithmetic_trans.binary_operation_instruction 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 *) (* 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 *) (* in initd_exps, then we assume that all the indices were initialized and *)
(* we don't need any assignments. *) (* we don't need any assignments. *)
if IList.exists if List.exists
((fun arr index -> Exp.is_array_index_of index arr) var_exp) ~f:((fun arr index -> Exp.is_array_index_of index arr) var_exp)
initd_exps initd_exps
then [] then []
else IList.map2 assign_instr lh rh_exps in 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 rhs_owning_method = CTrans_utils.is_owning_method ie in
let _, instrs_assign = let _, instrs_assign =
(* variable might be initialized already - do nothing in that case*) (* 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 && else if !Config.arc_mode &&
(CTrans_utils.is_method_call ie || (CTrans_utils.is_method_call ie ||
ObjcInterface_decl.is_pointer_to_objc_class ie_typ) 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 let (sil_expr, _) = extract_exp_from_list res_trans_stmt.exps
"WARNING: There should be only one return expression.\n" in "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 [] then []
else [Sil.Store (ret_exp, ret_type, sil_expr, sil_loc)] in else [Sil.Store (ret_exp, ret_type, sil_expr, sil_loc)] in
let autorelease_instrs = let autorelease_instrs =
@ -2070,7 +2070,7 @@ struct
let captured_block_vars = block_decl_info.Clang_ast_t.bdi_captured_variables in 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 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.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 let block_data = (context, type_ptr, block_pname, captureds) in
F.function_decl context.translation_unit_context context.tenv context.cfg context.cg decl F.function_decl context.translation_unit_context context.tenv context.cfg context.cg decl
(Some block_data); (Some block_data);

@ -66,7 +66,7 @@ let is_modeled_builtin funct =
String.equal funct CFrontend_config.builtin_memset_chk String.equal funct CFrontend_config.builtin_memset_chk
let is_modeled_attribute attr_name = let is_modeled_attribute attr_name =
IList.mem String.equal attr_name CFrontend_config.modeled_function_attributes List.mem ~equal:String.equal CFrontend_config.modeled_function_attributes attr_name
let get_first_param_typedef_string_opt type_ptr = let get_first_param_typedef_string_opt type_ptr =
match CAst_utils.get_desugared_type type_ptr with 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 is_strong_property obj_c_property_decl_info =
let attrs = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in 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 | `Strong -> true
| _ -> false) attrs | _ -> false) attrs
let is_assign_property obj_c_property_decl_info = let is_assign_property obj_c_property_decl_info =
let attrs = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in 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 | `Assign -> true
| _ -> false) attrs | _ -> false) attrs

@ -253,12 +253,12 @@ let check_constructor_initialization tenv
let filter_range_opt = function let filter_range_opt = function
| Some (_, ta, _) -> f ta | Some (_, ta, _) -> f ta
| None -> unknown in | None -> unknown in
IList.exists List.exists
(function pname, typestate -> ~f:(function pname, typestate ->
let pvar = Pvar.mk let pvar = Pvar.mk
(Mangled.from_string (Ident.fieldname_to_string fn)) (Mangled.from_string (Ident.fieldname_to_string fn))
pname in pname in
filter_range_opt (TypeState.lookup_pvar pvar typestate)) filter_range_opt (TypeState.lookup_pvar pvar typestate))
list in list in
let may_be_assigned_in_final_typestate = let may_be_assigned_in_final_typestate =
@ -268,7 +268,7 @@ let check_constructor_initialization tenv
| TypeOrigin.Field (f, _) -> | TypeOrigin.Field (f, _) ->
(* field initialized with another field needing initialization *) (* field initialized with another field needing initialization *)
let circular = 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 not circular
| _ -> | _ ->
true in true in

@ -345,7 +345,7 @@ let typecheck_instr
let is_parameter_field pvar = (* parameter.field *) let is_parameter_field pvar = (* parameter.field *)
let name = Pvar.get_name pvar in let name = Pvar.get_name pvar in
let filter (s, _, _) = Mangled.equal s name 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 *) let is_static_field pvar = (* static field *)
Pvar.is_global pvar in 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. *) (** The buck targets are assumed to start with //, aliases are not supported. *)
let check_args_for_targets args = 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 Buck.no_targets_found_error_and_exit args
let add_flavor_to_targets 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 linereader = Printer.LineReader.create () in
let skip source_file = let skip source_file =
let is_path_matching path = let is_path_matching path =
IList.exists List.exists
(fun pattern -> Str.string_match (Str.regexp pattern) path 0) ~f:(fun pattern -> Str.string_match (Str.regexp pattern) path 0)
Config.skip_analysis_in_path in Config.skip_analysis_in_path in
is_path_matching (SourceFile.to_rel_path source_file) is_path_matching (SourceFile.to_rel_path source_file)
|| Inferconfig.skip_translation_matcher source_file Procname.empty_block in || Inferconfig.skip_translation_matcher source_file Procname.empty_block in

@ -83,10 +83,12 @@ module SourceKind = struct
name, typ, None in name, typ, None in
let taint_formals_with_types type_strs kind formals = let taint_formals_with_types type_strs kind formals =
let taint_formal_with_types ((formal_name, formal_typ) as formal) = let taint_formal_with_types ((formal_name, formal_typ) as formal) =
let matches_classname typ typ_str = match typ with let matches_classname = match formal_typ with
| Typ.Tptr (Tstruct typename, _) -> String.equal (Typename.name typename) typ_str | Typ.Tptr (Tstruct typename, _) ->
| _ -> false in List.mem ~equal:String.equal type_strs (Typename.name typename)
if IList.mem matches_classname formal_typ type_strs | _ ->
false in
if matches_classname
then then
formal_name, formal_typ, Some kind formal_name, formal_typ, Some kind
else else

@ -98,13 +98,15 @@ let tests =
assert_equal (IList.length reports) 2; assert_equal (IList.length reports) 2;
assert_bool assert_bool
"Reports should contain source1 -> sink1" "Reports should contain source1 -> sink1"
(IList.exists (List.exists
(fun (source, sink, _) -> MockSource.equal source source1 && MockSink.equal sink sink1) ~f:(fun (source, sink, _) ->
MockSource.equal source source1 && MockSink.equal sink sink1)
reports); reports);
assert_bool assert_bool
"Reports should contain source2 -> sink2" "Reports should contain source2 -> sink2"
(IList.exists (List.exists
(fun (source, sink, _) -> MockSource.equal source source2 && MockSink.equal sink sink2) ~f:(fun (source, sink, _) ->
MockSource.equal source source2 && MockSink.equal sink sink2)
reports) in reports) in
"get_reports">::get_reports_ in "get_reports">::get_reports_ in

@ -441,8 +441,8 @@ let tests =
(ap, trace) :: acc in (ap, trace) :: acc in
let ap_traces = Domain.fold collect_ap_traces tree [] in let ap_traces = Domain.fold collect_ap_traces tree [] in
let has_ap_trace_pair ap_in trace_in = let has_ap_trace_pair ap_in trace_in =
IList.exists List.exists
(fun (ap, trace) -> AccessPath.equal ap ap_in && MockTraceDomain.equal trace trace_in) ~f:(fun (ap, trace) -> AccessPath.equal ap ap_in && MockTraceDomain.equal trace trace_in)
ap_traces in ap_traces in
assert_bool "Should have six ap/trace pairs" (Int.equal (IList.length ap_traces) 6); 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 open OUnit2 in
let cmp l1 l2 = let cmp l1 l2 =
let sort = IList.sort Procdesc.Node.compare in 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_diff fmt (actual, expected) =
let pp_sep fmt _ = F.pp_print_char fmt ',' in 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 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 let node_id = id n in
IList.filter IList.filter
(fun (_, succs) -> (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 t
|> IList.map fst |> IList.map fst
with Not_found -> [] with Not_found -> []

Loading…
Cancel
Save