diff --git a/infer/src/IR/Cfg.re b/infer/src/IR/Cfg.re index e8288eecf..a5d2d3c09 100644 --- a/infer/src/IR/Cfg.re +++ b/infer/src/IR/Cfg.re @@ -74,7 +74,7 @@ let get_all_procs cfg => { /** Get the procedures whose body is defined in this cfg */ -let get_defined_procs cfg => IList.filter Procdesc.is_defined (get_all_procs cfg); +let get_defined_procs cfg => List.filter f::Procdesc.is_defined (get_all_procs cfg); /** checks whether a cfg is connected or not */ diff --git a/infer/src/IR/Cg.re b/infer/src/IR/Cg.re index 8adf830bd..603721db4 100644 --- a/infer/src/IR/Cg.re +++ b/infer/src/IR/Cg.re @@ -223,7 +223,8 @@ let get_all_nodes (g: t) => { IList.map (fun node => (node, get_calls g node)) nodes }; -let get_nodes_and_calls (g: t) => IList.filter (fun (n, _) => node_defined g n) (get_all_nodes g); +let get_nodes_and_calls (g: t) => + List.filter f::(fun (n, _) => node_defined g n) (get_all_nodes g); let node_get_num_ancestors g n => (n, Procname.Set.cardinal (get_ancestors g n)); @@ -331,7 +332,7 @@ let get_nodes_and_edges (g: t) :nodes_and_edges => { let get_defined_nodes (g: t) => { let (nodes, _) = get_nodes_and_edges g; let get_node (node, _) => node; - IList.map get_node (IList.filter (fun (_, defined) => defined) nodes) + IList.map get_node (List.filter f::(fun (_, defined) => defined) nodes) }; diff --git a/infer/src/IR/Localise.ml b/infer/src/IR/Localise.ml index 3a972b350..ee778c235 100644 --- a/infer/src/IR/Localise.ml +++ b/infer/src/IR/Localise.ml @@ -140,13 +140,11 @@ module Tags = struct let create () = ref [] let add tags tag value = tags := (tag, value) :: !tags let update tags tag value = - let tags' = IList.filter (fun (t, _) -> t <> tag) tags in + let tags' = List.filter ~f:(fun (t, _) -> t <> tag) tags in (tag, value) :: tags' let get tags tag = - try - let (_, v) = IList.find (fun (t, _) -> String.equal t tag) tags in - Some v - with Not_found -> None + List.find ~f:(fun (t, _) -> String.equal t tag) tags |> + Option.map ~f:snd end module BucketLevel = struct @@ -164,10 +162,9 @@ let error_desc_extract_tag_value err_desc tag_to_extract = match v with | (t, _) when String.equal t tag -> true | _ -> false in - try - let _, s = IList.find (find_value tag_to_extract) err_desc.tags in - s - with Not_found -> "" + match List.find ~f:(find_value tag_to_extract) err_desc.tags with + | Some (_, s) -> s + | None -> "" let error_desc_to_tag_value_pairs err_desc = err_desc.tags @@ -193,8 +190,8 @@ let error_desc_set_bucket err_desc bucket show_in_message = (** get the value tag, if any *) let get_value_line_tag tags = try - let value = snd (IList.find (fun (tag, _) -> String.equal tag Tags.value) tags) in - let line = snd (IList.find (fun (tag, _) -> String.equal tag Tags.line) tags) in + let value = snd (List.find_exn ~f:(fun (tag, _) -> String.equal tag Tags.value) tags) in + let line = snd (List.find_exn ~f:(fun (tag, _) -> String.equal tag Tags.line) tags) in Some [value; line] with Not_found -> None diff --git a/infer/src/IR/Objc_models.ml b/infer/src/IR/Objc_models.ml index 5c2e1c2b5..479b2e250 100644 --- a/infer/src/IR/Objc_models.ml +++ b/infer/src/IR/Objc_models.ml @@ -238,11 +238,10 @@ struct function_arg_is_cftype typ && String.equal funct cf_release let is_core_graphics_release typ funct = - try - let cg_typ = IList.find - (fun lib -> (String.equal funct (lib^upper_release))) core_graphics_types in - (String.is_substring ~substring:(cg_typ^ref) typ) - with Not_found -> false + let f lib = + String.equal funct (lib ^ upper_release) && + String.is_substring ~substring:(lib ^ ref) typ in + List.exists ~f core_graphics_types (* let function_arg_is_core_pgraphics typ = diff --git a/infer/src/IR/Procdesc.re b/infer/src/IR/Procdesc.re index a826dd309..eb8779d8d 100644 --- a/infer/src/IR/Procdesc.re +++ b/infer/src/IR/Procdesc.re @@ -89,7 +89,7 @@ let module Node = { NodeSet.singleton n } else { NodeSet.union - acc (slice_nodes (IList.filter (fun s => not (NodeSet.mem s !visited)) n.succs)) + acc (slice_nodes (List.filter f::(fun s => not (NodeSet.mem s !visited)) n.succs)) } }; IList.fold_left do_node NodeSet.empty nodes @@ -105,7 +105,7 @@ let module Node = { NodeSet.singleton n } else { NodeSet.union - acc (slice_nodes (IList.filter (fun s => not (NodeSet.mem s !visited)) n.preds)) + acc (slice_nodes (List.filter f::(fun s => not (NodeSet.mem s !visited)) n.preds)) } }; IList.fold_left do_node NodeSet.empty nodes @@ -132,9 +132,9 @@ let module Node = { let visited = ref NodeSet.empty; let rec nodes n => { visited := NodeSet.add n !visited; - let succs = IList.filter (fun n => not (NodeSet.mem n !visited)) (generator n); - switch (IList.length succs) { - | 1 => [n, ...nodes (IList.hd succs)] + let succs = List.filter f::(fun n => not (NodeSet.mem n !visited)) (generator n); + switch succs { + | [hd] => [n, ...nodes hd] | _ => [n] } }; diff --git a/infer/src/IR/Sil.re b/infer/src/IR/Sil.re index 486fe5093..9ac3a45d9 100644 --- a/infer/src/IR/Sil.re +++ b/infer/src/IR/Sil.re @@ -692,21 +692,22 @@ let module Predicates: { Can be applied only once, as it destroys the todo list */ let iter (env: env) f f_dll => while (env.todo != [] || env.todo_dll != []) { - if (env.todo != []) { - let hpara = IList.hd env.todo; - let () = env.todo = IList.tl env.todo; + switch env.todo { + | [hpara, ...todo'] => + env.todo = todo'; let (n, emitted) = HparaHash.find env.hash hpara; if (not emitted) { f n hpara } - } else if ( - env.todo_dll != [] - ) { - let hpara_dll = IList.hd env.todo_dll; - let () = env.todo_dll = IList.tl env.todo_dll; - let (n, emitted) = HparaDllHash.find env.hash_dll hpara_dll; - if (not emitted) { - f_dll n hpara_dll + | [] => + switch env.todo_dll { + | [hpara_dll, ...todo_dll'] => + env.todo_dll = todo_dll'; + let (n, emitted) = HparaDllHash.find env.hash_dll hpara_dll; + if (not emitted) { + f_dll n hpara_dll + } + | [] => () } } }; @@ -1223,7 +1224,7 @@ let hpred_get_lexp acc => let hpred_list_get_lexps (filter: Exp.t => bool) (hlist: list hpred) :list Exp.t => { let lexps = IList.fold_left hpred_get_lexp [] hlist; - IList.filter filter lexps + List.filter f::filter lexps }; @@ -1246,7 +1247,7 @@ let rec exp_fpv e => | Sizeof _ _ _ => [] }; -let exp_list_fpv el => IList.flatten (IList.map exp_fpv el); +let exp_list_fpv el => List.concat (IList.map exp_fpv el); let atom_fpv = fun @@ -1260,12 +1261,12 @@ let rec strexp_fpv = | Eexp e _ => exp_fpv e | Estruct fld_se_list _ => { let f (_, se) => strexp_fpv se; - IList.flatten (IList.map f fld_se_list) + List.concat (IList.map f fld_se_list) } | Earray len idx_se_list _ => { let fpv_in_len = exp_fpv len; let f (idx, se) => exp_fpv idx @ strexp_fpv se; - fpv_in_len @ IList.flatten (IList.map f idx_se_list) + fpv_in_len @ List.concat (IList.map f idx_se_list) }; let rec hpred_fpv = @@ -1286,7 +1287,7 @@ let rec hpred_fpv = analysis. In interprocedural analysis, we should consider the issue of scopes of program variables. */ and hpara_fpv para => { - let fpvars_in_body = IList.flatten (IList.map hpred_fpv para.body); + let fpvars_in_body = List.concat (IList.map hpred_fpv para.body); switch fpvars_in_body { | [] => [] | _ => assert false @@ -1297,7 +1298,7 @@ and hpara_fpv para => { analysis. In interprocedural analysis, we should consider the issue of scopes of program variables. */ and hpara_dll_fpv para => { - let fpvars_in_body = IList.flatten (IList.map hpred_fpv para.body_dll); + let fpvars_in_body = List.concat (IList.map hpred_fpv para.body_dll); switch fpvars_in_body { | [] => [] | _ => assert false @@ -1391,11 +1392,11 @@ let fav_imperative_to_functional f x => { /** [fav_filter_ident fav f] only keeps [id] if [f id] is true. */ -let fav_filter_ident fav filter => fav := IList.filter filter !fav; +let fav_filter_ident fav filter => fav := List.filter f::filter !fav; /** Like [fav_filter_ident] but return a copy. */ -let fav_copy_filter_ident fav filter => ref (IList.filter filter !fav); +let fav_copy_filter_ident fav filter => ref (List.filter f::filter !fav); /** checks whether every element in l1 appears l2 **/ @@ -1730,17 +1731,17 @@ let sub_symmetric_difference sub1_in sub2_in => { /** [sub_find filter sub] returns the expression associated to the first identifier that satisfies [filter]. Raise [Not_found] if there isn't one. */ -let sub_find filter (sub: subst) => snd (IList.find (fun (i, _) => filter i) sub); +let sub_find filter (sub: subst) => snd (List.find_exn f::(fun (i, _) => filter i) sub); /** [sub_filter filter sub] restricts the domain of [sub] to the identifiers satisfying [filter]. */ -let sub_filter filter (sub: subst) => IList.filter (fun (i, _) => filter i) sub; +let sub_filter filter (sub: subst) => List.filter f::(fun (i, _) => filter i) sub; /** [sub_filter_pair filter sub] restricts the domain of [sub] to the identifiers satisfying [filter(id, sub(id))]. */ -let sub_filter_pair = IList.filter; +let sub_filter_pair = List.filter; /** [sub_range_partition filter sub] partitions [sub] according to @@ -1795,7 +1796,7 @@ let sub_fav_add fav (sub: subst) => ) sub; -let sub_fpv (sub: subst) => IList.flatten (IList.map (fun (_, e) => exp_fpv e) sub); +let sub_fpv (sub: subst) => List.concat (IList.map (fun (_, e) => exp_fpv e) sub); /** Substitutions do not contain binders */ @@ -2235,12 +2236,7 @@ let hpred_sub subst => { /** {2 Functions for replacing occurrences of expressions.} */ let exp_replace_exp epairs e => - try { - let (_, e') = IList.find (fun (e1, _) => Exp.equal e e1) epairs; - e' - } { - | Not_found => e - }; + List.find f::(fun (e1, _) => Exp.equal e e1) epairs |> Option.value_map f::snd default::e; let atom_replace_exp epairs atom => atom_expmap (fun e => exp_replace_exp epairs e) atom; @@ -2382,13 +2378,13 @@ let sigma_to_sigma_ne sigma :list (list atom, list hpred) => ([Aeq e1 e2, ...eqs], sigma), (eqs, [Hlseg Lseg_NE para e1 e2 el, ...sigma]) ]; - IList.flatten (IList.map g eqs_sigma_list) + List.concat (IList.map g eqs_sigma_list) | Hdllseg Lseg_PE para_dll e1 e2 e3 e4 el => let g (eqs, sigma) => [ ([Aeq e1 e3, Aeq e2 e4, ...eqs], sigma), (eqs, [Hdllseg Lseg_NE para_dll e1 e2 e3 e4 el, ...sigma]) ]; - IList.flatten (IList.map g eqs_sigma_list) + List.concat (IList.map g eqs_sigma_list) }; IList.fold_left f [([], [])] sigma } else { diff --git a/infer/src/IR/Sil.rei b/infer/src/IR/Sil.rei index 196c2a1ac..2cc2b84df 100644 --- a/infer/src/IR/Sil.rei +++ b/infer/src/IR/Sil.rei @@ -716,7 +716,7 @@ let sub_filter: (Ident.t => bool) => subst => subst; /** [sub_filter_exp filter sub] restricts the domain of [sub] to the identifiers satisfying [filter(id, sub(id))]. */ -let sub_filter_pair: ((Ident.t, Exp.t) => bool) => subst => subst; +let sub_filter_pair: subst => f::((Ident.t, Exp.t) => bool) => subst; /** [sub_range_partition filter sub] partitions [sub] according to diff --git a/infer/src/IR/StructTyp.re b/infer/src/IR/StructTyp.re index da3eace79..4a3194b1b 100644 --- a/infer/src/IR/StructTyp.re +++ b/infer/src/IR/StructTyp.re @@ -111,9 +111,8 @@ let fld_typ lookup::lookup default::default fn (typ: Typ.t) => | Tstruct name => switch (lookup name) { | Some {fields} => - try (snd3 (IList.find (fun (f, _, _) => Ident.equal_fieldname f fn) fields)) { - | Not_found => default - } + List.find f::(fun (f, _, _) => Ident.equal_fieldname f fn) fields |> + Option.value_map f::snd3 default::default | None => default } | _ => default @@ -125,13 +124,8 @@ let get_field_type_and_annotation lookup::lookup fn (typ: Typ.t) => | Tptr (Tstruct name) _ => switch (lookup name) { | Some {fields, statics} => - try { - let (_, t, a) = - IList.find (fun (f, _, _) => Ident.equal_fieldname f fn) (fields @ statics); - Some (t, a) - } { - | Not_found => None - } + List.find_map + f::(fun (f, t, a) => Ident.equal_fieldname f fn ? Some (t, a) : None) (fields @ statics) | None => None } | _ => None diff --git a/infer/src/IR/Subtype.re b/infer/src/IR/Subtype.re index 7f020e9f3..65b8ce912 100644 --- a/infer/src/IR/Subtype.re +++ b/infer/src/IR/Subtype.re @@ -153,7 +153,7 @@ let is_instof t => equal_kind (snd t) INSTOF; let list_intersect equal l1 l2 => { let in_l2 a => List.mem equal::equal l2 a; - IList.filter in_l2 l1 + List.filter f::in_l2 l1 }; let join_flag flag1 flag2 => diff --git a/infer/src/IR/Tenv.re b/infer/src/IR/Tenv.re index 28ff04adb..8065393cb 100644 --- a/infer/src/IR/Tenv.re +++ b/infer/src/IR/Tenv.re @@ -93,8 +93,8 @@ let add tenv name struct_typ => TypenameHash.replace tenv name struct_typ; /** Get method that is being overriden by java_pname (if any) **/ let get_overriden_method tenv pname_java => { let struct_typ_get_method_by_name (struct_typ: StructTyp.t) method_name => - IList.find - (fun meth => String.equal method_name (Procname.get_method meth)) struct_typ.methods; + List.find_exn + f::(fun meth => String.equal method_name (Procname.get_method meth)) struct_typ.methods; let rec get_overriden_method_in_supers pname_java supers => switch supers { | [superclass, ...supers_tail] => diff --git a/infer/src/backend/Attribute.ml b/infer/src/backend/Attribute.ml index 1fdd239e9..c6f14e873 100644 --- a/infer/src/backend/Attribute.ml +++ b/infer/src/backend/Attribute.ml @@ -38,7 +38,7 @@ let add_or_replace_check_changed tenv check_attribute_change prop atom0 = | Sil.Apred (att0, ((_ :: _) as exps0)) | Anpred (att0, ((_ :: _) as exps0)) -> let pairs = IList.map (fun e -> (e, Prop.exp_normalize_prop tenv prop e)) exps0 in - let _, nexp = IList.hd pairs in (* len exps0 > 0 by match *) + let _, nexp = List.hd_exn pairs in (* len exps0 > 0 by match *) let natom = Sil.atom_replace_exp pairs atom0 in let atom_map = function | Sil.Apred (att, exp :: _) | Anpred (att, exp :: _) @@ -69,7 +69,7 @@ let get_all (prop: 'a Prop.t) = (** Get all the attributes of the prop *) let get_for_symb prop att = - IList.filter (function + List.filter ~f:(function | Sil.Apred (att', _) | Anpred (att', _) -> PredSymb.equal att' att | _ -> false ) prop.Prop.pi @@ -86,14 +86,12 @@ let get_for_exp tenv (prop: 'a Prop.t) exp = let get tenv prop exp category = let atts = get_for_exp tenv prop exp in - try - Some - (IList.find (function - | Sil.Apred (att, _) | Anpred (att, _) -> - PredSymb.equal_category (PredSymb.to_category att) category - | _ -> false - ) atts) - with Not_found -> None + List.find + ~f:(function + | Sil.Apred (att, _) | Anpred (att, _) -> + PredSymb.equal_category (PredSymb.to_category att) category + | _ -> false) + atts let get_undef tenv prop exp = get tenv prop exp ACundef @@ -248,11 +246,15 @@ let find_arithmetic_problem tenv proc_node_session prop exp = | Exp.Sizeof (_, None, _) -> () | Exp.Sizeof (_, Some len, _) -> walk len in walk exp; - try Some (Div0 (IList.find check_zero !exps_divided)), !res - with Not_found -> - (match !uminus_unsigned with - | (e, t):: _ -> Some (UminusUnsigned (e, t)), !res - | _ -> None, !res) + let problem_opt = + match (List.find ~f:check_zero !exps_divided, !uminus_unsigned) with + | Some e, _ -> + Some (Div0 e) + | None, (e, t):: _ -> + Some (UminusUnsigned (e, t)) + | None, [] -> + None in + problem_opt, !res (** Deallocate the stack variables in [pvars], and replace them by normal variables. Return the list of stack variables whose address was still present after deallocation. *) diff --git a/infer/src/backend/BuiltinDefn.ml b/infer/src/backend/BuiltinDefn.ml index 244094ad5..2d661bc9e 100644 --- a/infer/src/backend/BuiltinDefn.ml +++ b/infer/src/backend/BuiltinDefn.ml @@ -62,29 +62,30 @@ let return_result tenv e prop ret_id = let add_array_to_prop tenv pdesc prop_ lexp typ = let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in - begin - try - let hpred = IList.find (function + let hpred_opt = + List.find + ~f:(function | Sil.Hpointsto(e, _, _) -> Exp.equal e n_lexp - | _ -> false) prop.Prop.sigma in - match hpred with - | Sil.Hpointsto(_, Sil.Earray (len, _, _), _) -> - Some (len, prop) - | _ -> None (* e points to something but not an array *) - with Not_found -> (* e is not allocated, so we can add the array *) - match extract_array_type typ with - | Some arr_typ -> - let len = Exp.Var (Ident.create_fresh Ident.kfootprint) in - let s = mk_empty_array_rearranged len in - let hpred = Prop.mk_ptsto tenv n_lexp s (Exp.Sizeof (arr_typ, Some len, Subtype.exact)) in - let sigma = prop.Prop.sigma in - let sigma_fp = prop.Prop.sigma_fp in - let prop'= Prop.set prop ~sigma:(hpred:: sigma) in - let prop''= Prop.set prop' ~sigma_fp:(hpred:: sigma_fp) in - let prop''= Prop.normalize tenv prop'' in - Some (len, prop'') - | _ -> None - end + | _ -> false) + prop.Prop.sigma in + match hpred_opt with + | Some (Sil.Hpointsto (_, Sil.Earray (len, _, _), _)) -> + Some (len, prop) + | Some _ -> + None (* e points to something but not an array *) + | None -> + extract_array_type typ |> + Option.map ~f:(fun arr_typ -> + let len = Exp.Var (Ident.create_fresh Ident.kfootprint) in + let s = mk_empty_array_rearranged len in + let hpred = + Prop.mk_ptsto tenv n_lexp s (Exp.Sizeof (arr_typ, Some len, Subtype.exact)) in + let sigma = prop.Prop.sigma in + let sigma_fp = prop.Prop.sigma_fp in + let prop'= Prop.set prop ~sigma:(hpred:: sigma) in + let prop''= Prop.set prop' ~sigma_fp:(hpred:: sigma_fp) in + let prop''= Prop.normalize tenv prop'' in + (len, prop'')) (* Add an array in prop if it is not allocated.*) let execute___require_allocated_array { Builtin.tenv; pdesc; prop_; path; args; } @@ -146,40 +147,41 @@ let is_undefined_opt tenv prop n_lexp = it doesn't appear already in the heap. *) let create_type tenv n_lexp typ prop = let prop_type = - try - let _ = IList.find (function + match + List.find ~f:(function | Sil.Hpointsto(e, _, _) -> Exp.equal e n_lexp - | _ -> false) prop.Prop.sigma in - prop - with Not_found -> - let mhpred = - match typ with - | Typ.Tptr (typ', _) -> - let sexp = Sil.Estruct ([], Sil.inst_none) in - let texp = Exp.Sizeof (typ', None, Subtype.subtypes) in - let hpred = Prop.mk_ptsto tenv n_lexp sexp texp in - Some hpred - | Typ.Tarray _ -> - let len = Exp.Var (Ident.create_fresh Ident.kfootprint) in - let sexp = mk_empty_array len in - let texp = Exp.Sizeof (typ, None, Subtype.subtypes) in - let hpred = Prop.mk_ptsto tenv n_lexp sexp texp in - Some hpred - | _ -> None in - match mhpred with - | Some hpred -> - let sigma = prop.Prop.sigma in - let sigma_fp = prop.Prop.sigma_fp in - let prop'= Prop.set prop ~sigma:(hpred:: sigma) in - let prop''= - let has_normal_variables = - Sil.fav_exists (Sil.exp_fav n_lexp) Ident.is_normal in - if (is_undefined_opt tenv prop n_lexp) || has_normal_variables - then prop' - else Prop.set prop' ~sigma_fp:(hpred:: sigma_fp) in - let prop''= Prop.normalize tenv prop'' in - prop'' - | None -> prop in + | _ -> false) prop.Prop.sigma with + | Some _ -> + prop + | None -> + let mhpred = + match typ with + | Typ.Tptr (typ', _) -> + let sexp = Sil.Estruct ([], Sil.inst_none) in + let texp = Exp.Sizeof (typ', None, Subtype.subtypes) in + let hpred = Prop.mk_ptsto tenv n_lexp sexp texp in + Some hpred + | Typ.Tarray _ -> + let len = Exp.Var (Ident.create_fresh Ident.kfootprint) in + let sexp = mk_empty_array len in + let texp = Exp.Sizeof (typ, None, Subtype.subtypes) in + let hpred = Prop.mk_ptsto tenv n_lexp sexp texp in + Some hpred + | _ -> None in + match mhpred with + | Some hpred -> + let sigma = prop.Prop.sigma in + let sigma_fp = prop.Prop.sigma_fp in + let prop'= Prop.set prop ~sigma:(hpred:: sigma) in + let prop''= + let has_normal_variables = + Sil.fav_exists (Sil.exp_fav n_lexp) Ident.is_normal in + if (is_undefined_opt tenv prop n_lexp) || has_normal_variables + then prop' + else Prop.set prop' ~sigma_fp:(hpred:: sigma_fp) in + let prop''= Prop.normalize tenv prop'' in + prop'' + | None -> prop in let sil_is_null = Exp.BinOp (Binop.Eq, n_lexp, Exp.zero) in let sil_is_nonnull = Exp.UnOp (Unop.LNot, sil_is_null, None) in let null_case = Propset.to_proplist (prune tenv ~positive:true sil_is_null prop) in @@ -198,17 +200,15 @@ let execute___get_type_of { Builtin.pdesc; tenv; prop_; path; ret_id; args; } let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in let props = create_type tenv n_lexp typ prop in let aux prop = - begin - try - let hpred = IList.find (function - | Sil.Hpointsto(e, _, _) -> Exp.equal e n_lexp - | _ -> false) prop.Prop.sigma in - match hpred with - | Sil.Hpointsto(_, _, texp) -> - (return_result tenv texp prop ret_id), path - | _ -> assert false - with Not_found -> (return_result tenv Exp.zero prop ret_id), path - end in + let hpred_opt = + List.find_map ~f:(function + | Sil.Hpointsto(e, _, texp) when Exp.equal e n_lexp -> Some texp + | _ -> None) prop.Prop.sigma in + match hpred_opt with + | Some texp -> + ((return_result tenv texp prop ret_id), path) + | None -> + ((return_result tenv Exp.zero prop ret_id), path) in (IList.map aux props) | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -252,50 +252,52 @@ let execute___instanceof_cast ~instof if Exp.equal texp2 Exp.zero then [(return_result tenv Exp.zero prop ret_id, path)] else - begin - try - let hpred = IList.find (function - | Sil.Hpointsto (e1, _, _) -> Exp.equal e1 val1 - | _ -> false) prop.Prop.sigma in - match hpred with - | Sil.Hpointsto (_, _, texp1) -> - let pos_type_opt, neg_type_opt = - Prover.Subtyping_check.subtype_case_analysis tenv texp1 texp2 in - let mk_res type_opt res_e = match type_opt with - | None -> [] - | Some texp1' -> - let prop' = - if Exp.equal texp1 texp1' then prop - else replace_ptsto_texp tenv prop val1 texp1' in - [(return_result tenv res_e prop' ret_id, path)] in - if instof then (* instanceof *) - let pos_res = mk_res pos_type_opt Exp.one in - let neg_res = mk_res neg_type_opt Exp.zero in - pos_res @ neg_res - else (* cast *) - if not should_throw_exception then (* C++ case when negative cast returns 0 *) - let pos_res = mk_res pos_type_opt val1 in - let neg_res = mk_res neg_type_opt Exp.zero in - pos_res @ neg_res - else - begin - if !Config.footprint then - match pos_type_opt with - | None -> deal_with_failed_cast val1 texp1 texp2 - | Some _ -> mk_res pos_type_opt val1 - else (* !Config.footprint is false *) - match neg_type_opt with - | Some _ -> - if is_undefined_opt tenv prop val1 then mk_res pos_type_opt val1 - else deal_with_failed_cast val1 texp1 texp2 - | None -> mk_res pos_type_opt val1 - end - | _ -> [] - with Not_found -> - [(return_result tenv val1 prop ret_id, path)] - end in + let res_opt = + List.find ~f:(function + | Sil.Hpointsto (e1, _, _) -> Exp.equal e1 val1 + | _ -> false) prop.Prop.sigma |> + Option.map ~f:(function + | Sil.Hpointsto (_, _, texp1) -> + let pos_type_opt, neg_type_opt = + Prover.Subtyping_check.subtype_case_analysis tenv texp1 texp2 in + let mk_res type_opt res_e = match type_opt with + | None -> [] + | Some texp1' -> + let prop' = + if Exp.equal texp1 texp1' then prop + else replace_ptsto_texp tenv prop val1 texp1' in + [(return_result tenv res_e prop' ret_id, path)] in + if instof then (* instanceof *) + let pos_res = mk_res pos_type_opt Exp.one in + let neg_res = mk_res neg_type_opt Exp.zero in + pos_res @ neg_res + else (* cast *) + if not should_throw_exception then (* C++ case when negative cast returns 0 *) + let pos_res = mk_res pos_type_opt val1 in + let neg_res = mk_res neg_type_opt Exp.zero in + pos_res @ neg_res + else + begin + if !Config.footprint then + match pos_type_opt with + | None -> deal_with_failed_cast val1 texp1 texp2 + | Some _ -> mk_res pos_type_opt val1 + else (* !Config.footprint is false *) + match neg_type_opt with + | Some _ -> + if is_undefined_opt tenv prop val1 then mk_res pos_type_opt val1 + else deal_with_failed_cast val1 texp1 texp2 + | None -> mk_res pos_type_opt val1 + end + | _ -> [] + ) in + match res_opt with + | Some res -> + res + | None -> + [(return_result tenv val1 prop ret_id, path)] in let props = create_type tenv val1 typ1 prop in - IList.flatten (IList.map exe_one_prop props) + List.concat (IList.map exe_one_prop props) | _ -> raise (Exceptions.Wrong_argument_number __POS__) let execute___instanceof builtin_args @@ -399,9 +401,11 @@ let execute___get_hidden_field { Builtin.tenv; pdesc; prop_; path; ret_id; args; | Sil.Hpointsto(e, Sil.Estruct (fsel, _), _) when Exp.equal e n_lexp && not in_foot && has_fld_hidden fsel -> let set_ret_val () = - match IList.find filter_fld_hidden fsel with - | _, Sil.Eexp(e, _) -> ret_val := Some e - | _ -> () in + match List.find ~f:filter_fld_hidden fsel with + | Some (_, Sil.Eexp(e, _)) -> + ret_val := Some e + | _ -> + () in set_ret_val(); hpred | _ -> hpred in @@ -430,7 +434,7 @@ let execute___set_hidden_field { Builtin.tenv; pdesc; prop_; path; args; } let se = Sil.Eexp(n_lexp2, Sil.inst_none) in let fsel' = (Ident.fieldname_hidden, se) :: - (IList.filter (fun x -> not (filter_fld_hidden x)) fsel) in + (List.filter ~f:(fun x -> not (filter_fld_hidden x)) fsel) in Sil.Hpointsto(e, Sil.Estruct (fsel', inst), texp) | Sil.Hpointsto(e, Sil.Estruct (fsel, inst), texp) when Exp.equal e n_lexp1 && in_foot && not (has_fld_hidden fsel) -> @@ -545,21 +549,21 @@ let execute___release_autorelease_pool let call_release res atom = match res, atom with | ((prop', path') :: _, Sil.Apred (_, exp :: _)) -> - (try - let hpred = IList.find (function - | Sil.Hpointsto(e1, _, _) -> Exp.equal e1 exp - | _ -> false) prop_.Prop.sigma in - match hpred with - | Sil.Hpointsto (_, _, Exp.Sizeof (typ, _, _)) -> - let res1 = - execute___objc_release - { builtin_args with - Builtin.args = [(exp, typ)]; - prop_ = prop'; - path = path'; } in - res1 - | _ -> res - with Not_found -> res) + List.find ~f:(function + | Sil.Hpointsto(e1, _, _) -> Exp.equal e1 exp + | _ -> false) prop_.Prop.sigma |> + Option.value_map ~f:(function + | Sil.Hpointsto (_, _, Exp.Sizeof (typ, _, _)) -> + let res1 = + execute___objc_release + { builtin_args with + Builtin.args = [(exp, typ)]; + prop_ = prop'; + path = path'; } in + res1 + | _ -> res + ) + ~default:res | _ -> res in IList.fold_left call_release [(prop_without_attribute, path)] autoreleased_objects else execute___no_op prop_ path @@ -644,16 +648,21 @@ let execute___objc_cast { Builtin.tenv; pdesc; prop_; path; ret_id; args; } let pname = Procdesc.get_proc_name pdesc in let val1, prop__ = check_arith_norm_exp tenv pname val1_ prop_ in let texp2, prop = check_arith_norm_exp tenv pname texp2_ prop__ in - (try - let hpred = IList.find (function + (match + List.find ~f:(function | Sil.Hpointsto(e1, _, _) -> Exp.equal e1 val1 - | _ -> false) prop.Prop.sigma in - match hpred, texp2 with - | Sil.Hpointsto (val1, _, _), Exp.Sizeof _ -> - let prop' = replace_ptsto_texp tenv prop val1 texp2 in - [(return_result tenv val1 prop' ret_id, path)] - | _ -> [(return_result tenv val1 prop ret_id, path)] - with Not_found -> [(return_result tenv val1 prop ret_id, path)]) + | _ -> false) prop.Prop.sigma |> + Option.map ~f:(fun hpred -> match hpred, texp2 with + | Sil.Hpointsto (val1, _, _), Exp.Sizeof _ -> + let prop' = replace_ptsto_texp tenv prop val1 texp2 in + [(return_result tenv val1 prop' ret_id, path)] + | _ -> [(return_result tenv val1 prop ret_id, path)] + ) + with + | Some res -> + res + | None -> + [(return_result tenv val1 prop ret_id, path)]) | _ -> raise (Exceptions.Wrong_argument_number __POS__) let execute_abort { Builtin.proc_name; } @@ -720,7 +729,7 @@ let execute_free mk { Builtin.pdesc; instr; tenv; prop_; path; args; loc; } Propset.to_proplist (prune tenv ~positive:false n_lexp prop) in let plist = prop_zero @ (* model: if 0 then skip else _execute_free_nonzero *) - IList.flatten (IList.map (fun p -> + List.concat (IList.map (fun p -> _execute_free_nonzero mk pdesc tenv instr p (Prop.exp_normalize_prop tenv p lexp) typ loc) prop_nonzero) in IList.map (fun p -> (p, path)) plist @@ -792,18 +801,18 @@ let execute___cxx_typeid ({ Builtin.pdesc; tenv; prop_; args; loc} as r) | type_info_exp :: rest -> (let res = execute_alloc PredSymb.Mnew false { r with args = [type_info_exp] } in match rest with - | [(field_exp, _); (lexp, typ)] -> + | [(field_exp, _); (lexp, typ_)] -> let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in let typ = - try - let hpred = IList.find (function - | Sil.Hpointsto (e, _, _) -> Exp.equal e n_lexp - | _ -> false) prop.Prop.sigma in - match hpred with - | Sil.Hpointsto (_, _, Exp.Sizeof (dynamic_type, _, _)) -> dynamic_type - | _ -> typ - with Not_found -> typ in + List.find ~f:(function + | Sil.Hpointsto (e, _, _) -> Exp.equal e n_lexp + | _ -> false) prop.Prop.sigma |> + Option.value_map ~f:(function + | Sil.Hpointsto (_, _, Exp.Sizeof (dynamic_type, _, _)) -> dynamic_type + | _ -> typ_ + ) + ~default:typ_ in let typ_string = Typ.to_string typ in let set_instr = Sil.Store (field_exp, Typ.Tvoid, Exp.Const (Const.Cstr typ_string), loc) in @@ -843,7 +852,7 @@ let execute_scan_function skip_n_arguments ({ Builtin.args } as call_args) match args with | _ when IList.length args >= skip_n_arguments -> let varargs = ref args in - for _ = 1 to skip_n_arguments do varargs := IList.tl !varargs done; + varargs := List.drop !varargs skip_n_arguments; SymExec.unknown_or_scan_call ~is_scan:true None diff --git a/infer/src/backend/InferAnalyze.re b/infer/src/backend/InferAnalyze.re index 0d4dc9485..d3c400163 100644 --- a/infer/src/backend/InferAnalyze.re +++ b/infer/src/backend/InferAnalyze.re @@ -54,7 +54,7 @@ let analyze_cluster cluster_num (cluster: Cluster.t) => { }; let output_json_makefile_stats clusters => { - let clusters_to_analyze = IList.filter ClusterMakefile.cluster_should_be_analyzed clusters; + let clusters_to_analyze = List.filter f::ClusterMakefile.cluster_should_be_analyzed clusters; let num_files = IList.length clusters_to_analyze; let num_procs = 0; /* can't compute it at this stage */ diff --git a/infer/src/backend/InferPrint.re b/infer/src/backend/InferPrint.re index 62e6f320d..dfdb875c8 100644 --- a/infer/src/backend/InferPrint.re +++ b/infer/src/backend/InferPrint.re @@ -33,13 +33,13 @@ let load_specfiles () => { | Sys_error _ => [] }; let all_filepaths = IList.map (fun fname => Filename.concat dir fname) all_filenames; - IList.filter is_specs_file all_filepaths + List.filter f::is_specs_file all_filepaths }; let specs_dirs = { let result_specs_dir = DB.filename_to_string DB.Results_dir.specs_dir; [result_specs_dir, ...Config.specs_library] }; - IList.flatten (IList.map specs_files_in_dir specs_dirs) + List.concat (IList.map specs_files_in_dir specs_dirs) }; @@ -543,7 +543,8 @@ let pp_tests_of_report fmt report => { let pp_trace_elem fmt {description} => F.fprintf fmt "%s" description; let pp_trace fmt trace => if Config.print_traces_in_tests { - let trace_without_empty_descs = IList.filter (fun {description} => description != "") trace; + let trace_without_empty_descs = + List.filter f::(fun {description} => description != "") trace; F.fprintf fmt ", [%a]" (Pp.comma_seq pp_trace_elem) trace_without_empty_descs }; let pp_row jsonbug => diff --git a/infer/src/backend/PropUtil.re b/infer/src/backend/PropUtil.re index 43bd51143..90e3875d6 100644 --- a/infer/src/backend/PropUtil.re +++ b/infer/src/backend/PropUtil.re @@ -25,7 +25,7 @@ let get_name_of_objc_static_locals (curr_f: Procdesc.t) p => { | _ => [] }; let vars_sigma = IList.map hpred_local_static p.Prop.sigma; - IList.flatten (IList.flatten vars_sigma) + List.concat (List.concat vars_sigma) }; /* returns a list of local variables that points to an objc block in a proposition */ @@ -41,7 +41,7 @@ let get_name_of_objc_block_locals p => { | _ => [] }; let vars_sigma = IList.map hpred_local_blocks p.Prop.sigma; - IList.flatten (IList.flatten vars_sigma) + List.concat (List.concat vars_sigma) }; let remove_abduced_retvars tenv p => { @@ -101,8 +101,8 @@ let remove_abduced_retvars tenv p => { | Exp.BinOp _ e0 e1 | Exp.Lindex e0 e1 => exp_contains e0 || exp_contains e1 | _ => false; - IList.filter - ( + List.filter + f::( fun | Sil.Aeq lhs rhs | Sil.Aneq lhs rhs => exp_contains lhs || exp_contains rhs @@ -202,6 +202,6 @@ let remove_seed_vars tenv (prop: Prop.t 'a) :Prop.t Prop.normal => { | Sil.Hpointsto (Exp.Lvar pv) _ _ => not (Pvar.is_seed pv) | _ => true; let sigma = prop.sigma; - let sigma' = IList.filter hpred_not_seed sigma; + let sigma' = List.filter f::hpred_not_seed sigma; Prop.normalize tenv (Prop.set prop sigma::sigma') }; diff --git a/infer/src/backend/StatsAggregator.re b/infer/src/backend/StatsAggregator.re index 4f2c41837..db8f2ef95 100644 --- a/infer/src/backend/StatsAggregator.re +++ b/infer/src/backend/StatsAggregator.re @@ -33,7 +33,7 @@ let find_json_files_in_dir dir => { { let content = Array.to_list (Sys.readdir dir); let content_with_path = IList.map (fun p => Filename.concat dir p) content; - IList.filter is_valid_json_file content_with_path + List.filter f::is_valid_json_file content_with_path } : [] }; diff --git a/infer/src/backend/abs.ml b/infer/src/backend/abs.ml index a84c32057..14270c578 100644 --- a/infer/src/backend/abs.ml +++ b/infer/src/backend/abs.ml @@ -71,13 +71,13 @@ let create_condition_ls ids_private id_base p_leftover (inst: Sil.subst) = let inst_of_base = try Sil.sub_find (Ident.equal id_base) inst_public with Not_found -> assert false in let insts_of_private_ids = Sil.sub_range inst_private in (insts_of_private_ids, insts_of_public_ids, inst_of_base) in - let fav_insts_of_public_ids = IList.flatten (IList.map Sil.exp_fav_list insts_of_public_ids) in - let fav_insts_of_private_ids = IList.flatten (IList.map Sil.exp_fav_list insts_of_private_ids) in + let fav_insts_of_public_ids = List.concat (IList.map Sil.exp_fav_list insts_of_public_ids) in + let fav_insts_of_private_ids = List.concat (IList.map Sil.exp_fav_list insts_of_private_ids) in let (fav_p_leftover, _) = let sigma = p_leftover.Prop.sigma in (sigma_fav_list sigma, sigma_fav_in_pvars_list sigma) in let fpv_inst_of_base = Sil.exp_fpv inst_of_base in - let fpv_insts_of_private_ids = IList.flatten (IList.map Sil.exp_fpv insts_of_private_ids) in + let fpv_insts_of_private_ids = List.concat (IList.map Sil.exp_fpv insts_of_private_ids) in (* let fav_inst_of_base = Sil.exp_fav_list inst_of_base in L.out "@[.... application of condition ....@\n@."; @@ -420,7 +420,7 @@ let typ_get_recursive_flds tenv typ_exp = match typ with | Tstruct name -> ( match Tenv.lookup tenv name with - | Some { fields } -> IList.map fst3 (IList.filter (filter typ) fields) + | Some { fields } -> IList.map fst3 (List.filter ~f:(filter typ) fields) | None -> L.err "@.typ_get_recursive: unexpected type expr: %a@." Exp.pp typ_exp; [] (* ToDo: assert false *) @@ -473,7 +473,7 @@ let discover_para_candidates tenv p = match se with | Sil.Eexp _ | Sil.Earray _ -> () | Sil.Estruct (fsel, _) -> - let fsel' = IList.filter (fun (fld, _) -> is_rec_fld fld) fsel in + let fsel' = List.filter ~f:(fun (fld, _) -> is_rec_fld fld) fsel in let process (_, nextse) = match nextse with | Sil.Eexp (next, _) -> add_edge (root, next) @@ -491,7 +491,7 @@ let discover_para_candidates tenv p = | [] -> IList.rev found | (e1, e2) :: edges_notseen -> let edges_others = (IList.rev edges_seen) @ edges_notseen in - let edges_matched = IList.filter (fun (e1', _) -> Exp.equal e2 e1') edges_others in + let edges_matched = List.filter ~f:(fun (e1', _) -> Exp.equal e2 e1') edges_others in let new_found = let f found_acc (_, e3) = (e1, e2, e3) :: found_acc in IList.fold_left f found edges_matched in @@ -509,7 +509,7 @@ let discover_para_dll_candidates tenv p = match se with | Sil.Eexp _ | Sil.Earray _ -> () | Sil.Estruct (fsel, _) -> - let fsel' = IList.filter (fun (fld, _) -> is_rec_fld fld) fsel in + let fsel' = List.filter ~f:(fun (fld, _) -> is_rec_fld fld) fsel in let convert_to_exp acc (_, se) = match se with | Sil.Eexp (e, _) -> e:: acc @@ -531,7 +531,7 @@ let discover_para_dll_candidates tenv p = | [] -> IList.rev found | (iF, blink, flink) :: edges_notseen -> let edges_others = (IList.rev edges_seen) @ edges_notseen in - let edges_matched = IList.filter (fun (e1', _, _) -> Exp.equal flink e1') edges_others in + let edges_matched = List.filter ~f:(fun (e1', _, _) -> Exp.equal flink e1') edges_others in let new_found = let f found_acc (_, _, flink2) = (iF, blink, flink, flink2) :: found_acc in IList.fold_left f found edges_matched in @@ -627,7 +627,7 @@ let eqs_solve ids_in eqs_in = let sub_dom = IList.map fst sub_list in let filter id = not (List.exists ~f:(fun id' -> Ident.equal id id') sub_dom) in - IList.filter filter ids_in in + List.filter ~f:filter ids_in in match solve Sil.sub_empty eqs_in with | None -> None | Some sub -> Some (compute_ids sub, sub) @@ -703,8 +703,8 @@ let abs_rules_apply_lists tenv (p_in: Prop.normal Prop.t) : Prop.normal Prop.t = let (closed_paras_sll, closed_paras_dll) = let paras_sll = discover_para tenv p in let paras_dll = discover_para_dll tenv p in - let closed_paras_sll = IList.flatten (IList.map hpara_special_cases paras_sll) in - let closed_paras_dll = IList.flatten (IList.map hpara_special_cases_dll paras_dll) in + let closed_paras_sll = List.concat (IList.map hpara_special_cases paras_sll) in + let closed_paras_dll = List.concat (IList.map hpara_special_cases_dll paras_dll) in begin (* if IList.length closed_paras_sll >= 1 then @@ -733,8 +733,8 @@ let abs_rules_apply_lists tenv (p_in: Prop.normal Prop.t) : Prop.normal Prop.t = let filter_dll para = not (List.exists ~f:(eq_dll para) old_rsets) && not (List.exists ~f:(eq_dll para) !new_rsets) in - let todo_paras_sll = IList.filter filter_sll closed_paras_sll in - let todo_paras_dll = IList.filter filter_dll closed_paras_dll in + let todo_paras_sll = List.filter ~f:filter_sll closed_paras_sll in + let todo_paras_dll = List.filter ~f:filter_dll closed_paras_dll in (todo_paras_sll, todo_paras_dll) in let f_recurse () = let todo_rsets_sll = @@ -771,7 +771,7 @@ let abstract_pure_part tenv p ~(from_abstract_footprint: bool) = if Ident.is_primed id then Sil.fav_mem fav_sigma id else if Ident.is_footprint id then Sil.fav_mem fav_nonpure id else true) in - IList.filter filter pure in + List.filter ~f:filter pure in let new_pure = IList.fold_left (fun pi a -> @@ -825,7 +825,7 @@ let abstract_gc tenv p = Sil.fav_is_empty fav_a || IList.intersect Ident.compare (Sil.fav_to_list fav_a) (Sil.fav_to_list fav_p_without_pi) in - let new_pi = IList.filter strong_filter pi in + let new_pi = List.filter ~f:strong_filter pi in let prop = Prop.normalize tenv (Prop.set p ~pi:new_pi) in match Prop.prop_iter_create prop with | None -> prop @@ -882,11 +882,11 @@ let get_cycle root prop = let get_points_to e = match e with | Sil.Eexp(e', _) -> - (try - Some(IList.find (fun hpred -> match hpred with - | Sil.Hpointsto(e'', _, _) -> Exp.equal e'' e' - | _ -> false) sigma) - with _ -> None) + List.find + ~f:(fun hpred -> match hpred with + | Sil.Hpointsto (e'', _, _) -> Exp.equal e'' e' + | _ -> false) + sigma | _ -> None in let print_cycle cyc = (L.d_str "Cycle= "; @@ -962,10 +962,8 @@ let get_var_retain_cycle prop_ = when Exp.equal e e' && Typ.is_block_type typ -> true | _, _ -> false in let find v = - try - let hp = IList.find (is_pvar v) sigma in - Some (Sil.hpred_get_lhs hp) - with Not_found -> None in + List.find ~f:(is_pvar v) sigma |> + Option.map ~f:Sil.hpred_get_lhs in let find_block v = if (List.exists ~f:(is_hpred_block v) sigma) then Some (Exp.Lvar Sil.block_pvar) @@ -987,7 +985,7 @@ let get_var_retain_cycle prop_ = | hp:: sigma' -> let cycle = get_cycle hp prop_ in L.d_strln "Filtering pvar in cycle "; - let cycle' = IList.flatten (IList.map find_or_block cycle) in + let cycle' = List.concat (IList.map find_or_block cycle) in if List.is_empty cycle' then do_sigma sigma' else cycle' in do_sigma sigma @@ -1007,8 +1005,8 @@ let cycle_has_weak_or_unretained_or_assign_field tenv cycle = let equal_fn (fn', _, _) = Ident.equal_fieldname fn fn' in match Tenv.lookup tenv name with | Some { fields; statics } -> ( - try trd3 (IList.find equal_fn (fields @ statics)) - with Not_found -> [] + List.find ~f:equal_fn (fields @ statics) |> + Option.value_map ~f:trd3 ~default:[] ) | None -> [] ) @@ -1241,9 +1239,9 @@ let get_local_stack cur_sigma init_sigma = let filter_local_stack olds = function | Sil.Hpointsto (Exp.Lvar pvar, _, _) -> not (List.exists ~f:(Pvar.equal pvar) olds) | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> false in - let init_stack = IList.filter filter_stack init_sigma in + let init_stack = List.filter ~f:filter_stack init_sigma in let init_stack_pvars = IList.map get_stack_var init_stack in - let cur_local_stack = IList.filter (filter_local_stack init_stack_pvars) cur_sigma in + let cur_local_stack = List.filter ~f:(filter_local_stack init_stack_pvars) cur_sigma in let cur_local_stack_pvars = IList.map get_stack_var cur_local_stack in (cur_local_stack, cur_local_stack_pvars) @@ -1261,7 +1259,7 @@ let remove_local_stack sigma pvars = let filter_non_stack = function | Sil.Hpointsto (Exp.Lvar pvar, _, _) -> not (List.exists ~f:(Pvar.equal pvar) pvars) | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> true in - IList.filter filter_non_stack sigma + List.filter ~f:filter_non_stack sigma (** [prop_set_fooprint p p_foot] removes a local stack from [p_foot], and sets proposition [p_foot] as footprint of [p]. *) diff --git a/infer/src/backend/absarray.ml b/infer/src/backend/absarray.ml index cb55a96aa..4642a2492 100644 --- a/infer/src/backend/absarray.ml +++ b/infer/src/backend/absarray.ml @@ -76,14 +76,16 @@ end = struct | Sil.Estruct (fsel, _), Tstruct name, Field (fld, _) :: syn_offs' -> ( match Tenv.lookup tenv name with | Some { fields } -> - let se' = snd (IList.find (fun (f', _) -> Ident.equal_fieldname f' fld) fsel) in - let t' = snd3 (IList.find (fun (f', _, _) -> Ident.equal_fieldname f' fld) fields) in + let se' = + snd (List.find_exn ~f:(fun (f', _) -> Ident.equal_fieldname f' fld) fsel) in + let t' = + snd3 (List.find_exn ~f:(fun (f', _, _) -> Ident.equal_fieldname f' fld) fields) in get_strexp_at_syn_offsets tenv se' t' syn_offs' | None -> fail () ) | Sil.Earray (_, esel, _), Typ.Tarray (t', _), Index ind :: syn_offs' -> - let se' = snd (IList.find (fun (i', _) -> Exp.equal i' ind) esel) in + let se' = snd (List.find_exn ~f:(fun (i', _) -> Exp.equal i' ind) esel) in get_strexp_at_syn_offsets tenv se' t' syn_offs' | _ -> fail () @@ -96,9 +98,9 @@ end = struct | Sil.Estruct (fsel, inst), Tstruct name, Field (fld, _) :: syn_offs' -> ( match Tenv.lookup tenv name with | Some { fields } -> - let se' = snd (IList.find (fun (f', _) -> Ident.equal_fieldname f' fld) fsel) in + let se' = snd (List.find_exn ~f:(fun (f', _) -> Ident.equal_fieldname f' fld) fsel) in let t' = (fun (_,y,_) -> y) - (IList.find (fun (f', _, _) -> + (List.find_exn ~f:(fun (f', _, _) -> Ident.equal_fieldname f' fld) fields) in let se_mod = replace_strexp_at_syn_offsets tenv se' t' syn_offs' update in let fsel' = @@ -110,7 +112,7 @@ end = struct assert false ) | Sil.Earray (len, esel, inst), Tarray (t', _), Index idx :: syn_offs' -> - let se' = snd (IList.find (fun (i', _) -> Exp.equal i' idx) esel) in + let se' = snd (List.find_exn ~f:(fun (i', _) -> Exp.equal i' idx) esel) in let se_mod = replace_strexp_at_syn_offsets tenv se' t' syn_offs' update in let esel' = IList.map (fun ese -> if Exp.equal (fst ese) idx then (idx, se_mod) else ese) esel in @@ -150,7 +152,7 @@ end = struct let filter = function | Sil.Hpointsto (e, _, _) -> Exp.equal root e | _ -> false in - let hpred = IList.find filter sigma in + let hpred = List.find_exn ~f:filter sigma in (sigma, hpred, syn_offs) (** Find a sub strexp with the given property. Can raise [Not_found] *) @@ -177,11 +179,12 @@ end = struct | [] -> () | (f, se) :: fsel' -> begin - try - let t = snd3 (IList.find (fun (f', _, _) -> Ident.equal_fieldname f' f) ftal) in - find_offset_sexp sigma_other hpred root ((Field (f, typ)) :: offs) se t - with Not_found -> - L.d_strln ("Can't find field " ^ (Ident.fieldname_to_string f) ^ " in StrexpMatch.find") + match List.find ~f:(fun (f', _, _) -> Ident.equal_fieldname f' f) ftal with + | Some (_, t, _) -> + find_offset_sexp sigma_other hpred root ((Field (f, typ)) :: offs) se t + | None -> + L.d_strln + ("Can't find field " ^ (Ident.fieldname_to_string f) ^ " in StrexpMatch.find") end; find_offset_fsel sigma_other hpred root offs fsel' ftal typ and find_offset_esel sigma_other hpred root offs esel t = match esel with @@ -261,18 +264,6 @@ end = struct | _ -> assert false in let hpred' = hpred_replace_strexp tenv footprint_part hpred syn_offs update in replace_hpred (sigma, hpred, syn_offs) hpred' -(* - (** Get the partition of the sigma: the unmatched part of the sigma and the matched hpred *) - let get_sigma_partition (sigma, hpred, _) = - let sigma_unmatched = IList.filter (fun hpred' -> not (hpred' == hpred)) sigma in - (sigma_unmatched, hpred) - - (** Replace the strexp and the unmatched part of the sigma by the given inputs *) - let replace_strexp_sigma footprint_part ((_, hpred, syn_offs) : t) se_in sigma_in = - let new_sigma = hpred :: sigma_in in - let sigma' = replace_strexp tenv footprint_part (new_sigma, hpred, syn_offs) se_in in - IList.sort Sil.compare_hpred sigma' -*) end (** This function renames expressions in [p]. The renaming is, roughly @@ -292,10 +283,9 @@ let prop_replace_path_index tenv ) acc_outer map ) [] elist_path in let expmap_fun e' = - try - let _, fresh_e = IList.find (fun (e, _) -> Exp.equal e e') expmap_list in - fresh_e - with Not_found -> e' in + Option.value_map + ~f:snd (List.find ~f:(fun (e, _) -> Exp.equal e e') expmap_list) + ~default:e' in Prop.prop_expmap expmap_fun p (** This function uses [update] and transforms the two sigma parts of [p], @@ -376,7 +366,7 @@ let index_is_pointed_to tenv (p: Prop.normal Prop.t) (path: StrexpMatch.path) (i let elist_path = StrexpMatch.path_to_exps path in let add_index i e = Prop.exp_normalize_prop tenv p (Exp.Lindex(e, i)) 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 = List.concat (IList.map add_index_to_paths indices) in let filter = function | Sil.Hpointsto (_, Sil.Eexp (e, _), _) -> List.exists ~f:(Exp.equal e) pointers | _ -> false in @@ -502,7 +492,7 @@ let strexp_do_abstract tenv let default_indices = match IList.map fst esel with | [] -> [] - | indices -> [IList.hd (IList.rev indices)] (* keep last key at least *) in + | indices -> [List.hd_exn (IList.rev indices)] (* keep last key at least *) in partition_abstract should_keep abstract esel default_indices in let do_footprint () = match se_in with @@ -510,7 +500,7 @@ let strexp_do_abstract tenv | _ -> assert false in let filter_abstract d_keys should_keep abstract ksel default_keys = - let keep_ksel = IList.filter should_keep ksel in + let keep_ksel = List.filter ~f:should_keep ksel in let keep_keys = IList.map fst keep_ksel in let keep_keys' = if List.is_empty keep_keys then default_keys else keep_keys in if Config.trace_absarray then (L.d_str "keep "; d_keys keep_keys'; L.d_ln ()); @@ -593,7 +583,7 @@ let remove_redundant_elements tenv prop = Sil.fav_duplicates := false; (* L.d_str "favl_curr "; IList.iter (fun id -> Sil.d_exp (Exp.Var id)) favl_curr; L.d_ln(); L.d_str "favl_foot "; IList.iter (fun id -> Sil.d_exp (Exp.Var id)) favl_foot; L.d_ln(); *) - let num_occur l id = IList.length (IList.filter (fun id' -> Ident.equal id id') l) in + let num_occur l id = IList.length (List.filter ~f:(fun id' -> Ident.equal id id') l) in let at_most_once v = num_occur favl_curr v <= 1 && num_occur favl_foot v <= 1 in at_most_once in @@ -613,7 +603,7 @@ let remove_redundant_elements tenv prop = | _ -> true in let remove_redundant_se fp_part = function | Sil.Earray (len, esel, inst) -> - let esel' = IList.filter (filter_redundant_e_se fp_part) esel in + let esel' = List.filter ~f:(filter_redundant_e_se fp_part) esel in Sil.Earray (len, esel', inst) | se -> se in let remove_redundant_hpred fp_part = function diff --git a/infer/src/backend/callbacks.ml b/infer/src/backend/callbacks.ml index 663e6ed1a..cbf606605 100644 --- a/infer/src/backend/callbacks.ml +++ b/infer/src/backend/callbacks.ml @@ -122,7 +122,7 @@ let iterate_cluster_callbacks all_procs exe_env proc_names = (* Procedures matching the given language or all if no language is specified. *) let relevant_procedures language_opt = Option.value_map - ~f:(fun l -> IList.filter (fun p -> Config.equal_language l (get_language p)) proc_names) + ~f:(fun l -> List.filter ~f:(fun p -> Config.equal_language l (get_language p)) proc_names) ~default:proc_names language_opt in diff --git a/infer/src/backend/crashcontext.ml b/infer/src/backend/crashcontext.ml index b0b608ff1..d9334587c 100644 --- a/infer/src/backend/crashcontext.ml +++ b/infer/src/backend/crashcontext.ml @@ -23,7 +23,7 @@ let frame_id_of_stackframe frame = loc_str let frame_id_of_summary stacktree = - let short_name = IList.hd + let short_name = List.hd_exn (Str.split (Str.regexp "(") stacktree.Stacktree_j.method_name) in match stacktree.Stacktree_j.location with | None -> diff --git a/infer/src/backend/dom.ml b/infer/src/backend/dom.ml index d443852cf..ef3765a47 100644 --- a/infer/src/backend/dom.ml +++ b/infer/src/backend/dom.ml @@ -450,13 +450,16 @@ end = struct if n1 <> 0 then n1 else Exp.compare e2 e2' let get_fresh_exp e1 e2 = - try - let (_, _, e) = IList.find (fun (e1', e2', _) -> Exp.equal e1 e1' && Exp.equal e2 e2') !t in - e - with Not_found -> - let e = Exp.get_undefined (JoinState.get_footprint ()) in - t := (e1, e2, e)::!t; - e + match + List.find ~f:(fun (e1', e2', _) -> Exp.equal e1 e1' && Exp.equal e2 e2') !t |> + Option.map ~f:trd3 + with + | Some res -> + res + | None -> + let e = Exp.get_undefined (JoinState.get_footprint ()) in + t := (e1, e2, e)::!t; + e let get_induced_atom tenv acc strict_lower upper e = let ineq_lower = Prop.mk_inequality tenv (Exp.BinOp(Binop.Lt, strict_lower, e)) in @@ -478,14 +481,19 @@ end = struct let rec f_eqs_entry ((e1, e2, e) as entry) eqs_acc t_seen = function | [] -> eqs_acc, t_seen | ((e1', e2', e') as entry'):: t_rest' -> - try - let n = IList.find (fun n -> add_and_chk_eq e1 e1' n && add_and_chk_eq e2 e2' n) minus2_to_2 in - let eq = add_and_gen_eq e e' n in - let eqs_acc' = eq:: eqs_acc in - f_eqs_entry entry eqs_acc' t_seen t_rest' - with Not_found -> - let t_seen' = entry':: t_seen in - f_eqs_entry entry eqs_acc t_seen' t_rest' in + (match + List.find ~f:(fun n -> + add_and_chk_eq e1 e1' n && add_and_chk_eq e2 e2' n) minus2_to_2 |> + Option.map ~f:(fun n -> + let eq = add_and_gen_eq e e' n in + let eqs_acc' = eq:: eqs_acc in + f_eqs_entry entry eqs_acc' t_seen t_rest') + with + | Some res -> + res + | None -> + let t_seen' = entry':: t_seen in + f_eqs_entry entry eqs_acc t_seen' t_rest') in let rec f_eqs eqs_acc t_acc = function | [] -> (eqs_acc, t_acc) | entry:: t_rest -> @@ -505,15 +513,6 @@ end = struct | _ -> acc in IList.fold_left f_ineqs eqs t_minimal -(* - let lookup side e = - try - let (e1, e2, e) = - IList.find (fun (e1', e2', _) -> Exp.equal e (select side e1' e2')) !t in - Some (e, select (opposite side) e1 e2) - with Not_found -> - None -*) end (** {2 Modules for renaming} *) @@ -556,7 +555,7 @@ end = struct (Ident.is_footprint id) && (Sil.fav_for_all (Sil.exp_fav e) (fun id -> not (Ident.is_primed id))) | _ -> false in - let t' = IList.filter f !tbl in + let t' = List.filter ~f !tbl in tbl := t'; t' @@ -571,7 +570,7 @@ end = struct | Exp.Lvar _ | Exp.Var _ | Exp.BinOp (Binop.PlusA, Exp.Var _, _) -> let is_same_e (e1, e2, _) = Exp.equal e (select side e1 e2) in - let assoc = IList.filter is_same_e !tbl in + let assoc = List.filter ~f:is_same_e !tbl in IList.map (fun (e1, e2, _) -> select side_op e1 e2) assoc | _ -> L.d_str "no pattern match in check lost_little e: "; Sil.d_exp e; L.d_ln (); @@ -583,7 +582,7 @@ end = struct let lookup_side' side e = let f (e1, e2, _) = Exp.equal e (select side e1 e2) in - IList.filter f !tbl + List.filter ~f !tbl let lookup_side_induced' side e = let res = ref [] in @@ -624,7 +623,7 @@ end = struct let to_subst_proj (side: side) vars = let renaming_restricted = - IList.filter (function (_, _, Exp.Var i) -> Sil.fav_mem vars i | _ -> assert false) !tbl in + List.filter ~f:(function (_, _, Exp.Var i) -> Sil.fav_mem vars i | _ -> assert false) !tbl in let sub_list_side = IList.map (function (e1, e2, Exp.Var i) -> (i, select side e1 e2) | _ -> assert false) @@ -644,7 +643,7 @@ end = struct match select side e1 e2 with | Exp.Var i -> can_rename i | _ -> false in - IList.filter pick_id_case !tbl in + List.filter ~f:pick_id_case !tbl in let sub_list = let project (e1, e2, e) = match select side e1 e2 with @@ -747,41 +746,35 @@ end = struct (* Extend the renaming relation. At least one of e1 and e2 * should be a primed or footprint variable *) let extend e1 e2 default_op = - try - let eq_to_e (f1, f2, _) = Exp.equal e1 f1 && Exp.equal e2 f2 in - let _, _, res = IList.find eq_to_e !tbl in - res - with Not_found -> - let fav1 = Sil.exp_fav e1 in - let fav2 = Sil.exp_fav e2 in - let no_ren1 = not (Sil.fav_exists fav1 can_rename) in - let no_ren2 = not (Sil.fav_exists fav2 can_rename) in - let some_primed () = Sil.fav_exists fav1 Ident.is_primed || Sil.fav_exists fav2 Ident.is_primed in - let e = - if (no_ren1 && no_ren2) then - if (Exp.equal e1 e2) then e1 else (L.d_strln "failure reason 13"; raise IList.Fail) - else - match default_op with - | ExtDefault e -> e - | ExtFresh -> - let kind = if JoinState.get_footprint () && not (some_primed ()) then Ident.kfootprint else Ident.kprimed in - Exp.Var (Ident.create_fresh kind) in - let entry = e1, e2, e in - push entry; - Todo.push entry; - e -(* - let get e1 e2 = - let f (e1', e2', _) = Exp.equal e1 e1' && Exp.equal e2 e2' in - match (IList.filter f !tbl) with - | [] -> None - | (_, _, e):: _ -> Some e - - let pp pe f renaming = - let pp_triple f (e1, e2, e3) = - F.fprintf f "(%a,%a,%a)" (Sil.pp_exp pe) e3 (Sil.pp_exp pe) e1 (Sil.pp_exp pe) e2 in - (pp_seq pp_triple) f renaming -*) + match + List.find ~f:(fun (f1, f2, _) -> Exp.equal e1 f1 && Exp.equal e2 f2) !tbl |> + Option.map ~f:trd3 + with + | Some res -> + res + | None -> + let fav1 = Sil.exp_fav e1 in + let fav2 = Sil.exp_fav e2 in + let no_ren1 = not (Sil.fav_exists fav1 can_rename) in + let no_ren2 = not (Sil.fav_exists fav2 can_rename) in + let some_primed () = + Sil.fav_exists fav1 Ident.is_primed || Sil.fav_exists fav2 Ident.is_primed in + let e = + if (no_ren1 && no_ren2) then + if (Exp.equal e1 e2) then e1 else (L.d_strln "failure reason 13"; raise IList.Fail) + else + match default_op with + | ExtDefault e -> e + | ExtFresh -> + let kind = + if JoinState.get_footprint () && not (some_primed ()) + then Ident.kfootprint + else Ident.kprimed in + Exp.Var (Ident.create_fresh kind) in + let entry = e1, e2, e in + push entry; + Todo.push entry; + e end (** {2 Functions for constructing fresh sil data types} *) @@ -1821,7 +1814,7 @@ let footprint_partial_join' tenv (p1: Prop.normal Prop.t) (p2: Prop.normal Prop. let pi_fp = let pi_fp0 = Prop.get_pure efp in let f a = Sil.fav_for_all (Sil.atom_fav a) Ident.is_footprint in - IList.filter f pi_fp0 in + List.filter ~f pi_fp0 in let sigma_fp = let sigma_fp0 = efp.Prop.sigma in let f a = Sil.fav_exists (Sil.hpred_fav a) (fun a -> not (Ident.is_footprint a)) in diff --git a/infer/src/backend/dotty.ml b/infer/src/backend/dotty.ml index dc01254b1..09ad7d0a6 100644 --- a/infer/src/backend/dotty.ml +++ b/infer/src/backend/dotty.ml @@ -289,7 +289,7 @@ let make_dangling_boxes pe allocated_nodes (sigma_lambda: (Sil.hpred * int) list | d:: candidates -> if (is_allocated d) then subtract_allocated candidates else d:: subtract_allocated candidates in - let candidate_dangling = IList.flatten (IList.map get_rhs_predicate sigma_lambda) in + let candidate_dangling = List.concat (IList.map get_rhs_predicate sigma_lambda) in let candidate_dangling = filter_duplicate candidate_dangling [] in let dangling = subtract_allocated candidate_dangling in dangling_dotboxes:= dangling @@ -338,7 +338,7 @@ let set_exps_neq_zero pi = IList.iter f pi let box_dangling e = - let entry_e = IList.filter (fun b -> match b with + let entry_e = List.filter ~f:(fun b -> match b with | Dotdangling(_, e', _) -> Exp.equal e e' | _ -> false ) !dangling_dotboxes in match entry_e with |[] -> None @@ -477,7 +477,7 @@ let compute_target_from_eexp dotnodes e p lambda = [(LinkExpToExp, n', "")] else let nodes_e = select_nodes_exp_lambda dotnodes e lambda in - let nodes_e_no_struct = IList.filter is_not_struct nodes_e in + let nodes_e_no_struct = List.filter ~f:is_not_struct nodes_e in let trg = IList.map get_coordinate_id nodes_e_no_struct in (match trg with | [] -> @@ -498,7 +498,7 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = let target_list = compute_target_array_elements dotnodes lie p f lambda in (* below it's n+1 because n is the address, n+1 is the actual array node*) let ff n = IList.map (fun (k, lab_src, m, lab_trg) -> mk_link k (mk_coordinate (n + 1) lambda) (strip_special_chars lab_src) (mk_coordinate m lambda) (strip_special_chars lab_trg)) target_list in - let links_from_elements = IList.flatten (IList.map ff (n:: nl)) in + let links_from_elements = List.concat (IList.map ff (n:: nl)) in let trg_label = strip_special_chars (Exp.to_string e) in let lnk = mk_link (LinkToArray) (mk_coordinate n lambda) "" (mk_coordinate (n + 1) lambda) trg_label in @@ -519,11 +519,11 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = ) target_list in let nodes_e = select_nodes_exp_lambda dotnodes e lambda in let address_struct_id = - try get_coordinate_id (IList.hd (IList.filter (is_source_node_of_exp e) nodes_e)) + try get_coordinate_id (List.hd_exn (List.filter ~f:(is_source_node_of_exp e) nodes_e)) with exn when SymOp.exn_not_failure exn -> assert false in (* we need to exclude the address node from the sorce of fields. no fields should start from there*) - let nl'= IList.filter (fun id -> address_struct_id <> id) nl in - let links_from_fields = IList.flatten (IList.map ff nl') in + let nl'= List.filter ~f:(fun id -> address_struct_id <> id) nl in + let links_from_fields = List.concat (IList.map ff nl') in let lnk_from_address_struct = if !print_full_prop then let trg_label = strip_special_chars (Exp.to_string e) in [mk_link (LinkExpToStruct) (mk_coordinate address_struct_id lambda) "" @@ -541,7 +541,7 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = mk_link k (mk_coordinate n lambda) "" (mk_coordinate m lambda) (strip_special_chars lab_target) ) target_list in - let ll = IList.flatten (IList.map ff nl) in + let ll = List.concat (IList.map ff nl) in ll @ dotty_mk_set_links dotnodes sigma' p f cycle else dotty_mk_set_links dotnodes sigma' p f cycle) @@ -550,7 +550,7 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = (match src with | [] -> assert false | n:: _ -> - let (_, m, lab) = IList.hd (compute_target_from_eexp dotnodes e2 p lambda) in + let (_, m, lab) = List.hd_exn (compute_target_from_eexp dotnodes e2 p lambda) in let lnk = mk_link LinkToSSL (mk_coordinate (n + 1) lambda) "" (mk_coordinate m lambda) lab in lnk:: dotty_mk_set_links dotnodes sigma' p f cycle ) @@ -635,11 +635,11 @@ let filter_useless_spec_dollar_box (nodes: dotty_node list) (links: link list) = let tmp_nodes = ref nodes in let tmp_links = ref links in let remove_links_from ln = - IList.filter - (fun n' -> not (List.mem ~equal:equal_link ln n')) + List.filter + ~f:(fun n' -> not (List.mem ~equal:equal_link ln n')) !tmp_links in let remove_node n ns = - IList.filter (fun n' -> match n' with + List.filter ~f:(fun n' -> match n' with | Dotpointsto _ -> (get_coordinate_id n') <> (get_coordinate_id n) | _ -> true ) ns in @@ -774,7 +774,7 @@ and dotty_pp_state f pe cycle dotnode = | Dotpointsto(coo, e1, c) when !print_full_prop -> dotty_exp coo e1 c false | Dotstruct(coo, e1, l, c,te) -> let l' = if !print_full_prop then l - else IList.filter (fun edge -> in_cycle cycle edge) l in + else List.filter ~f:(fun edge -> in_cycle cycle edge) l in print_struct f pe e1 te l' coo c | Dotarray(coo, e1, e2, l, _, c) when !print_full_prop -> print_array f pe e1 e2 l coo c | Dotlseg(coo, e1, _, Sil.Lseg_NE, nesting, _) when !print_full_prop -> @@ -1119,7 +1119,7 @@ let atom_to_xml_string a = (* return the dangling node corresponding to an expression it exists or None *) let exp_dangling_node e = - let entry_e = IList.filter (fun b -> match b with + let entry_e = List.filter ~f:(fun b -> match b with | VH_dangling(_, e') -> Exp.equal e e' | _ -> false ) !set_dangling_nodes in match entry_e with |[] -> None @@ -1202,10 +1202,10 @@ let make_set_dangling_nodes allocated_nodes (sigma: Sil.hpred list) = | e:: l' -> if (List.exists ~f:(Exp.equal e) seen_exp) then filter_duplicate l' seen_exp else e:: filter_duplicate l' (e:: seen_exp) in - let rhs_exp_list = IList.flatten (IList.map get_rhs_predicate sigma) in + let rhs_exp_list = List.concat (IList.map get_rhs_predicate sigma) in let candidate_dangling_exps = filter_duplicate rhs_exp_list [] in (* get rid of allocated ones*) - let dangling_exps = IList.filter is_not_allocated candidate_dangling_exps in + let dangling_exps = List.filter ~f:is_not_allocated candidate_dangling_exps in IList.map make_new_dangling dangling_exps (* return a list of pairs (n,field_lab) where n is a target node*) @@ -1287,8 +1287,8 @@ let prop_to_set_of_visual_heaps prop = incr global_node_counter; while (!working_list <> []) do set_dangling_nodes:=[]; - let (n, h) = IList.hd !working_list in - working_list:= IList.tl !working_list; + let (n, h) = List.hd_exn !working_list in + working_list:= List.tl_exn !working_list; let nodes = make_visual_heap_nodes h in set_dangling_nodes:= make_set_dangling_nodes nodes h; let edges = make_visual_heap_edges nodes h prop in diff --git a/infer/src/backend/errdesc.ml b/infer/src/backend/errdesc.ml index 4145e3aa1..5a825d407 100644 --- a/infer/src/backend/errdesc.ml +++ b/infer/src/backend/errdesc.ml @@ -78,9 +78,9 @@ let find_in_node_or_preds start_node f_node_instr = begin visited := Procdesc.NodeSet.add node !visited; let instrs = Procdesc.Node.get_instrs node in - match IList.find_map_opt (f_node_instr node) (IList.rev instrs) with + match List.find_map ~f:(f_node_instr node) (IList.rev instrs) with | Some res -> Some res - | None -> IList.find_map_opt find (Procdesc.Node.get_preds node) + | None -> List.find_map ~f:find (Procdesc.Node.get_preds node) end in find start_node @@ -537,9 +537,9 @@ let explain_leak tenv hpred prop alloc_att_opt bucket = Pvar.d pvar; L.d_ln ()); [pvar] | _ -> [] in - let nullify_pvars = IList.flatten (IList.map get_nullify node_instrs) in + let nullify_pvars = List.concat (IList.map get_nullify node_instrs) in let nullify_pvars_notmp = - IList.filter (fun pvar -> not (Pvar.is_frontend_tmp pvar)) nullify_pvars in + List.filter ~f:(fun pvar -> not (Pvar.is_frontend_tmp pvar)) nullify_pvars in value_str_from_pvars_vpath nullify_pvars_notmp vpath | Some (Sil.Store (lexp, _, _, _)) when is_none vpath -> if verbose @@ -581,11 +581,9 @@ let vpath_find tenv prop _exp : DExp.t option * Typ.t option = let typo = match texp with | Exp.Sizeof (Tstruct name, _, _) -> ( match Tenv.lookup tenv name with - | Some {fields} -> ( - match IList.find (fun (f', _, _) -> Ident.equal_fieldname f' f) fields with - | _, t, _ -> Some t - | exception Not_found -> None - ) + | Some {fields} -> + List.find ~f:(fun (f', _, _) -> Ident.equal_fieldname f' f) fields |> + Option.map ~f:snd3 | _ -> None ) diff --git a/infer/src/backend/infer.ml b/infer/src/backend/infer.ml index 2baf1848a..07059c552 100644 --- a/infer/src/backend/infer.ml +++ b/infer/src/backend/infer.ml @@ -225,7 +225,7 @@ let capture = function ["--java-jar-compiler"; p]) @ (match IList.rev Config.buck_build_args with | args when in_buck_mode -> - IList.map (fun arg -> ["--Xbuck"; "'" ^ arg ^ "'"]) args |> IList.flatten + IList.map (fun arg -> ["--Xbuck"; "'" ^ arg ^ "'"]) args |> List.concat | _ -> []) @ (if not Config.debug_mode then [] else ["--debug"]) @ diff --git a/infer/src/backend/interproc.ml b/infer/src/backend/interproc.ml index bf9904c63..6492a933a 100644 --- a/infer/src/backend/interproc.ml +++ b/infer/src/backend/interproc.ml @@ -394,8 +394,8 @@ let check_assignement_guard pdesc node = let is_prune_exp e = let prune_var n = let ins = Procdesc.Node.get_instrs n in - let pi = IList.filter is_prune_instr ins in - let leti = IList.filter is_load_instr ins in + let pi = List.filter ~f:is_prune_instr ins in + let leti = List.filter ~f:is_load_instr ins in match pi, leti with | [Sil.Prune (Exp.Var (e1), _, _, _)], [Sil.Load (e2, e', _, _)] | [Sil.Prune (Exp.UnOp (Unop.LNot, Exp.Var e1, _), _, _, _)], @@ -406,7 +406,7 @@ let check_assignement_guard pdesc node = L.d_strln ("Found " ^ (Exp.to_string e') ^ " as prune var"); [e'] | _ -> [] in - let prune_vars = IList.flatten(IList.map (fun n -> prune_var n) succs) in + let prune_vars = List.concat(IList.map (fun n -> prune_var n) succs) in IList.for_all (fun e' -> Exp.equal e' e) prune_vars in let succs_loc = IList.map (fun n -> Procdesc.Node.get_loc n) succs in let succs_are_all_prune_nodes () = @@ -441,10 +441,10 @@ let check_assignement_guard pdesc node = (* at this point all successors are at the same location, so we can take the first*) | loc_succ:: _ -> let set_instr_at_succs_loc = - IList.filter - (fun i -> - Location.equal (Sil.instr_get_loc i) loc_succ && - is_set_instr i) + List.filter + ~f:(fun i -> + Location.equal (Sil.instr_get_loc i) loc_succ && + is_set_instr i) instr in (match set_instr_at_succs_loc with | [Sil.Store (e, _, _, _)] -> @@ -616,17 +616,17 @@ let forward_tabulate tenv pdesc wl source = [reachable_hpreds]. *) let get_fld_typ_path_opt src_exps sink_exp_ reachable_hpreds_ = let strexp_matches target_exp = function - | (_, Sil.Eexp (e, _)) -> Exp.equal target_exp e + | Sil.Eexp (e, _) -> Exp.equal target_exp e | _ -> false in let extend_path hpred (sink_exp, path, reachable_hpreds) = match hpred with | Sil.Hpointsto (lhs, Sil.Estruct (flds, _), Exp.Sizeof (typ, _, _)) -> - (try - let fld, _ = IList.find (fun fld -> strexp_matches sink_exp fld) flds in - let reachable_hpreds' = Sil.HpredSet.remove hpred reachable_hpreds in - (lhs, (Some fld, typ) :: path, reachable_hpreds') - with Not_found -> (sink_exp, path, reachable_hpreds)) + List.find ~f:(function _, se -> strexp_matches sink_exp se) flds |> + Option.value_map ~f:(function fld, _ -> + let reachable_hpreds' = Sil.HpredSet.remove hpred reachable_hpreds in + (lhs, (Some fld, typ) :: path, reachable_hpreds')) + ~default:(sink_exp, path, reachable_hpreds) | Sil.Hpointsto (lhs, Sil.Earray (_, elems, _), Exp.Sizeof (typ, _, _)) -> - if List.exists ~f:(fun pair -> strexp_matches sink_exp pair) elems + if List.exists ~f:(function _, se -> strexp_matches sink_exp se) elems then let reachable_hpreds' = Sil.HpredSet.remove hpred reachable_hpreds in (* None means "no field name" ~=~ nameless array index *) @@ -1405,7 +1405,7 @@ let interprocedural_algorithm exe_env : unit = let summary = Specs.get_summary_unsafe "main_algorithm" proc_name in Int.equal (Specs.get_timestamp summary) 0 in let procs_to_analyze = - IList.filter filter_initial (Cg.get_defined_nodes call_graph) in + List.filter ~f:filter_initial (Cg.get_defined_nodes call_graph) in let to_analyze proc_name = match Exe_env.get_proc_desc exe_env proc_name with | Some proc_desc -> diff --git a/infer/src/backend/match.ml b/infer/src/backend/match.ml index 99e29c9d0..0e3301d26 100644 --- a/infer/src/backend/match.ml +++ b/infer/src/backend/match.ml @@ -41,7 +41,7 @@ let rec exp_match e1 sub vars e2 : (Sil.subst * Ident.t list) option = in if (Exp.equal e1 e2_inst) then Some(sub, vars) else None in match e1, e2 with | _, Exp.Var id2 when (Ident.is_primed id2 && mem_idlist id2 vars) -> - let vars_new = IList.filter (fun id -> not (Ident.equal id id2)) vars in + let vars_new = List.filter ~f:(fun id -> not (Ident.equal id id2)) vars in let sub_new = match (Sil.extend_sub sub id2 e1) with | None -> assert false (* happens when vars contains the same variable twice. *) | Some sub_new -> sub_new @@ -545,7 +545,7 @@ and generate_todos_from_iel mode todos iel1 iel2 = let corres_extend_front e1 e2 corres = let filter (e1', e2') = (Exp.equal e1 e1') || (Exp.equal e2 e2') in let checker e1' e2' = (Exp.equal e1 e1') && (Exp.equal e2 e2') - in match (IList.filter filter corres) with + in match (List.filter ~f:filter corres) with | [] -> Some ((e1, e2) :: corres) | [(e1', e2')] when checker e1' e2' -> Some corres | _ -> None @@ -557,7 +557,7 @@ let corres_extensible corres e1 e2 = let corres_related corres e1 e2 = let filter (e1', e2') = (Exp.equal e1 e1') || (Exp.equal e2 e2') in let checker e1' e2' = (Exp.equal e1 e1') && (Exp.equal e2 e2') in - match (IList.filter filter corres) with + match (List.filter ~f:filter corres) with | [] -> Exp.equal e1 e2 | [(e1', e2')] when checker e1' e2' -> true | _ -> false @@ -714,12 +714,12 @@ let generic_para_create tenv corres sigma1 elist1 = let not_same_consts = function | Exp.Const c1, Exp.Const c2 -> not (Const.equal c1 c2) | _ -> true in - let new_corres' = IList.filter not_same_consts corres in + let new_corres' = List.filter ~f:not_same_consts corres in let add_fresh_id pair = (pair, Ident.create_fresh Ident.kprimed) in IList.map add_fresh_id new_corres' in let (es_shared, ids_shared, ids_exists) = let not_in_elist1 ((e1, _), _) = not (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 = List.filter ~f:not_in_elist1 corres_ids in let should_be_shared ((e1, e2), _) = Exp.equal e1 e2 in let shared, exists = IList.partition should_be_shared corres_ids_no_elist1 in let es_shared = IList.map (fun ((e1, _), _) -> e1) shared in @@ -739,11 +739,10 @@ let hpara_create tenv corres sigma1 root1 next1 = let renaming, body, ids_exists, ids_shared, es_shared = generic_para_create tenv corres sigma1 [root1; next1] in let get_id1 e1 = - try - let is_equal_to_e1 (e1', _) = Exp.equal e1 e1' in - let _, id = IList.find is_equal_to_e1 renaming in - id - with Not_found -> assert false in + let is_equal_to_e1 (e1', _) = Exp.equal e1 e1' in + match List.find ~f:is_equal_to_e1 renaming with + | Some (_, id) -> id + | None -> assert false in let id_root = get_id1 root1 in let id_next = get_id1 next1 in let hpara = @@ -762,11 +761,10 @@ let hpara_dll_create tenv corres sigma1 root1 blink1 flink1 = let renaming, body, ids_exists, ids_shared, es_shared = generic_para_create tenv corres sigma1 [root1; blink1; flink1] in let get_id1 e1 = - try - let is_equal_to_e1 (e1', _) = Exp.equal e1 e1' in - let _, id = IList.find is_equal_to_e1 renaming in - id - with Not_found -> assert false in + let is_equal_to_e1 (e1', _) = Exp.equal e1 e1' in + match List.find ~f:is_equal_to_e1 renaming with + | Some (_, id) -> id + | None -> assert false in let id_root = get_id1 root1 in let id_blink = get_id1 blink1 in let id_flink = get_id1 flink1 in diff --git a/infer/src/backend/paths.ml b/infer/src/backend/paths.ml index 58c8ba9ca..d61516425 100644 --- a/infer/src/backend/paths.ml +++ b/infer/src/backend/paths.ml @@ -593,7 +593,7 @@ end = struct let filter f ps = let elements = ref [] in PropMap.iter (fun p _ -> elements := p :: !elements) ps; - elements := IList.filter (fun p -> not (f p)) !elements; + elements := List.filter ~f:(fun p -> not (f p)) !elements; let filtered_map = ref ps in IList.iter (fun p -> filtered_map := PropMap.remove p !filtered_map) !elements; !filtered_map diff --git a/infer/src/backend/preanal.ml b/infer/src/backend/preanal.ml index 69b2c5b13..f4ae1667e 100644 --- a/infer/src/backend/preanal.ml +++ b/infer/src/backend/preanal.ml @@ -212,7 +212,7 @@ let add_nullify_instrs pdesc tenv liveness_inv_map = let node_add_nullify_instructions node pvars = let loc = Procdesc.Node.get_last_loc node in let nullify_instrs = - IList.filter is_local pvars + List.filter ~f:is_local pvars |> IList.map (fun pvar -> Sil.Nullify (pvar, loc)) in if nullify_instrs <> [] then Procdesc.Node.append_instrs node (IList.rev nullify_instrs) in diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index 19b4dc580..b1b798f68 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -419,7 +419,7 @@ let write_proc_html source whole_seconds pdesc = begin let pname = Procdesc.get_proc_name pdesc in let nodes = IList.sort Procdesc.Node.compare (Procdesc.get_nodes pdesc) in - let linenum = (Procdesc.Node.get_loc (IList.hd nodes)).Location.line in + let linenum = (Procdesc.Node.get_loc (List.hd_exn nodes)).Location.line in let fd, fmt = Io_infer.Html.create (DB.Results_dir.Abs_source_dir source) diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index 5c4a61798..a34919142 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -271,9 +271,9 @@ let create_pvar_env (sigma: sigma) : (Exp.t -> Exp.t) = | _ -> () in IList.iter filter sigma; let find e = - try - snd (IList.find (fun (e1, _) -> Exp.equal e1 e) !env) - with Not_found -> e in + List.find ~f:(fun (e1, _) -> Exp.equal e1 e) !env |> + Option.map ~f:snd |> + Option.value ~default:e in find (** Update the object substitution given the stack variables in the prop *) @@ -412,10 +412,10 @@ let sigma_fav_in_pvars_add fav sigma = IList.iter (hpred_fav_in_pvars_add fav) sigma let sigma_fpv sigma = - IList.flatten (IList.map Sil.hpred_fpv sigma) + List.concat (IList.map Sil.hpred_fpv sigma) let pi_fpv pi = - IList.flatten (IList.map Sil.atom_fpv pi) + List.concat (IList.map Sil.atom_fpv pi) let prop_fpv prop = (Sil.sub_fpv prop.sub) @ @@ -1465,17 +1465,17 @@ module Normalize = struct lt_list_tightened in le_ineq_list @ lt_ineq_list in let nonineq_list' = - IList.filter - (fun (a : Sil.atom) -> match a with - | Aneq (Const (Cint n), e) - | Aneq (e, Const (Cint n)) -> - (not (List.exists - ~f:(fun (e', n') -> Exp.equal e e' && IntLit.lt n' n) - le_list_tightened)) && - (not (List.exists - ~f:(fun (n', e') -> Exp.equal e e' && IntLit.leq n n') - lt_list_tightened)) - | _ -> true) + List.filter + ~f:(fun (a : Sil.atom) -> match a with + | Aneq (Const (Cint n), e) + | Aneq (e, Const (Cint n)) -> + (not (List.exists + ~f:(fun (e', n') -> Exp.equal e e' && IntLit.lt n' n) + le_list_tightened)) && + (not (List.exists + ~f:(fun (n', e') -> Exp.equal e e' && IntLit.leq n n') + lt_list_tightened)) + | _ -> true) nonineq_list in (ineq_list', nonineq_list') @@ -1512,7 +1512,7 @@ module Normalize = struct let pi' = IList.stable_sort Sil.compare_atom - ((IList.filter filter_useful_atom nonineq_list) @ ineq_list) in + ((List.filter ~f:filter_useful_atom nonineq_list) @ ineq_list) in let pi'' = pi_sorted_remove_redundant pi' in if equal_pi pi0 pi'' then pi0 else pi'' @@ -1550,7 +1550,7 @@ module Normalize = struct (** This function assumes that if (x,Exp.Var(y)) in sub, then compare x y = 1 *) let sub_normalize sub = let f (id, e) = (not (Ident.is_primed id)) && (not (Sil.ident_in_exp id e)) in - let sub' = Sil.sub_filter_pair f sub in + let sub' = Sil.sub_filter_pair ~f sub in if Sil.equal_subst sub sub' then sub else sub' (** Conjoin a pure atomic predicate by normal conjunction. *) @@ -1924,9 +1924,9 @@ let prop_rename_array_indices tenv prop = let rec select_minimal_indices indices_seen = function | [] -> IList.rev indices_seen | index:: indices_rest -> - let indices_seen' = IList.filter (not_same_base_lt_offsets index) indices_seen in + let indices_seen' = List.filter ~f:(not_same_base_lt_offsets index) indices_seen in let indices_seen_new = index:: indices_seen' in - let indices_rest_new = IList.filter (not_same_base_lt_offsets index) indices_rest in + let indices_rest_new = List.filter ~f:(not_same_base_lt_offsets index) indices_rest in select_minimal_indices indices_seen_new indices_rest_new in let minimal_indices = select_minimal_indices [] indices in let subst = compute_reindexing_from_indices minimal_indices in @@ -1936,7 +1936,7 @@ let prop_rename_array_indices tenv prop = let compute_renaming fav = let ids = Sil.fav_to_list fav in let ids_primed, ids_nonprimed = IList.partition Ident.is_primed ids in - let ids_footprint = IList.filter Ident.is_footprint ids_nonprimed in + let ids_footprint = List.filter ~f:Ident.is_footprint ids_nonprimed in let id_base_primed = Ident.create Ident.kprimed 0 in let id_base_footprint = Ident.create Ident.kfootprint 0 in @@ -2190,7 +2190,7 @@ let remove_seed_captured_vars_block tenv captured_vars prop = | _ -> false in let sigma = prop.sigma in let sigma' = - IList.filter (fun hpred -> not (hpred_seed_captured hpred)) sigma in + List.filter ~f:(fun hpred -> not (hpred_seed_captured hpred)) sigma in Normalize.normalize tenv (set prop ~sigma:sigma') (** {2 Prop iterators} *) @@ -2425,7 +2425,7 @@ let rec strexp_gc_fields (fav: Sil.fav) (se : Sil.strexp) = | Estruct (fsel, inst) -> let fselo = IList.map (fun (f, se) -> (f, strexp_gc_fields fav se)) fsel in let fsel' = - let fselo' = IList.filter (function | (_, Some _) -> true | _ -> false) fselo in + let fselo' = List.filter ~f:(function | (_, Some _) -> true | _ -> false) fselo in IList.map (function (f, seo) -> (f, unSome seo)) fselo' in if [%compare.equal: (Ident.fieldname * Sil.strexp) list] fsel fsel' then Some se else Some (Sil.Estruct (fsel', inst)) @@ -2567,8 +2567,8 @@ module CategorizePreconditions = struct let check_sigma sigma = IList.for_all hpred_filter sigma in check_pi pre.pi && check_sigma pre.sigma in - let pres_no_constraints = IList.filter (check_pre hpred_is_var) preconditions in - let pres_only_allocation = IList.filter (check_pre hpred_only_allocation) preconditions in + let pres_no_constraints = List.filter ~f:(check_pre hpred_is_var) preconditions in + let pres_only_allocation = List.filter ~f:(check_pre hpred_only_allocation) preconditions in match preconditions, pres_no_constraints, pres_only_allocation with | [], _, _ -> NoPres diff --git a/infer/src/backend/propgraph.ml b/infer/src/backend/propgraph.ml index f7ab1359e..29682b415 100644 --- a/infer/src/backend/propgraph.ml +++ b/infer/src/backend/propgraph.ml @@ -79,7 +79,7 @@ let edge_from_source g n footprint_part is_hpred = match edge_get_source hpred with | Some e -> Exp.equal n e | None -> false in - match IList.filter starts_from edges with + match List.filter ~f:starts_from edges with | [] -> None | edge:: _ -> Some edge @@ -106,8 +106,7 @@ let edge_equal e1 e2 = match e1, e2 with (** [contains_edge footprint_part g e] returns true if the graph [g] contains edge [e], searching the footprint part if [footprint_part] is true. *) let contains_edge (footprint_part: bool) (g: t) (e: edge) = - try ignore (IList.find (fun e' -> edge_equal e e') (get_edges footprint_part g)); true - with Not_found -> false + List.exists ~f:(fun e' -> edge_equal e e') (get_edges footprint_part g) (** [iter_edges footprint_part f g] iterates function [f] on the edges in [g] in the same order as returned by [get_edges]; if [footprint_part] is true the edges are taken from the footprint part. *) @@ -166,7 +165,7 @@ let compute_edge_diff (oldedge: edge) (newedge: edge) : Obj.t list = match olded compute_exp_diff e1 e2 | Eatom (Sil.Apred (_, es1)), Eatom (Sil.Apred (_, es2)) | Eatom (Sil.Anpred (_, es1)), Eatom (Sil.Anpred (_, es2)) -> - IList.flatten (try IList.map2 compute_exp_diff es1 es2 with IList.Fail -> []) + List.concat (try IList.map2 compute_exp_diff es1 es2 with IList.Fail -> []) | Esub_entry (_, e1), Esub_entry (_, e2) -> compute_exp_diff e1 e2 | _ -> [Obj.repr newedge] diff --git a/infer/src/backend/propset.ml b/infer/src/backend/propset.ml index c631c4aad..43576cc9b 100644 --- a/infer/src/backend/propset.ml +++ b/infer/src/backend/propset.ml @@ -72,7 +72,7 @@ let to_proplist pset = (** Apply function to all the elements of [propset], removing those where it returns [None]. *) let map_option tenv f pset = let plisto = IList.map f (to_proplist pset) in - let plisto = IList.filter (function | Some _ -> true | None -> false) plisto in + let plisto = List.filter ~f:(function | Some _ -> true | None -> false) plisto in let plist = IList.map (function Some p -> p | None -> assert false) plisto in from_proplist tenv plist diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index cac9951c7..a10b6558a 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -20,10 +20,10 @@ let decrease_indent_when_exception thunk = with exn when SymOp.exn_not_failure exn -> (L.d_decrease_indent 1; raise exn) let compute_max_from_nonempty_int_list l = - IList.hd (IList.rev (IList.sort IntLit.compare_value l)) + uw (List.max_elt ~cmp:IntLit.compare_value l) let compute_min_from_nonempty_int_list l = - IList.hd (IList.sort IntLit.compare_value l) + uw (List.min_elt ~cmp:IntLit.compare_value l) let rec list_rev_acc acc = function | [] -> acc @@ -129,7 +129,7 @@ end = struct let remove_redundancy constraints = let constraints' = sort_then_remove_redundancy constraints in - IList.filter (fun entry -> List.exists ~f:(equal entry) constraints') constraints + List.filter ~f:(fun entry -> List.exists ~f:(equal entry) constraints') constraints let rec combine acc_todos acc_seen constraints_new constraints_old = match constraints_new, constraints_old with @@ -477,7 +477,7 @@ end = struct | Exp.Const (Const.Cint n1) -> Some n1 | _ -> let e_upper_list = - IList.filter (function + List.filter ~f:(function | e', Exp.Const (Const.Cint _) -> Exp.equal e1 e' | _, _ -> false) leqs in let upper_list = @@ -494,7 +494,7 @@ end = struct | Exp.Sizeof _ -> Some IntLit.zero | _ -> let e_lower_list = - IList.filter (function + List.filter ~f:(function | Exp.Const (Const.Cint _), e' -> Exp.equal e1 e' | _, _ -> false) lts in let lower_list = @@ -2143,7 +2143,7 @@ let check_implication_base pname tenv check_frame_empty calc_missing prop1 prop2 let filter (id, e) = Ident.is_normal id && Sil.fav_for_all (Sil.exp_fav e) Ident.is_normal in let sub1_base = - Sil.sub_filter_pair filter prop1.Prop.sub in + Sil.sub_filter_pair ~f:filter prop1.Prop.sub in let pi1, pi2 = Prop.get_pure prop1, Prop.get_pure prop2 in let sigma1, sigma2 = prop1.Prop.sigma, prop2.Prop.sigma in let subs = pre_check_pure_implication tenv calc_missing (prop1.Prop.sub, sub1_base) pi1 pi2 in diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index b25e876f3..c85076644 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -105,8 +105,10 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp | Tstruct name, (Off_fld (f, _)) :: off' -> ( match Tenv.lookup tenv name with | Some ({ fields; statics; } as struct_typ) -> ( - match IList.find (fun (f', _, _) -> Ident.equal_fieldname f f') (fields @ statics) with - | _, t', _ -> + match List.find + ~f:(fun (f', _, _) -> Ident.equal_fieldname f f') + (fields @ statics) with + | Some (_, t', _) -> let atoms', se', res_t' = create_struct_values pname tenv orig_prop footprint_part kind max_stamp t' off' inst in @@ -117,7 +119,7 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp IList.sort StructTyp.compare_field (IList.map replace_typ_of_f fields) in ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; (atoms', se, t) - | exception Not_found -> + | None -> fail t off __POS__ ) | None -> @@ -206,10 +208,10 @@ let rec _strexp_extend_values | (Off_fld (f, _)) :: off', Sil.Estruct (fsel, inst'), Tstruct name -> ( match Tenv.lookup tenv name with | Some ({ fields; statics; } as struct_typ) -> ( - match IList.find (fun (f', _, _) -> Ident.equal_fieldname f f') (fields @ statics) with - | _, typ', _ -> ( - match IList.find (fun (f', _) -> Ident.equal_fieldname f f') fsel with - | _, se' -> + match List.find ~f:(fun (f', _, _) -> Ident.equal_fieldname f f') (fields @ statics) with + | Some (_, typ', _) -> ( + match List.find ~f:(fun (f', _) -> Ident.equal_fieldname f f') fsel with + | Some (_, se') -> let atoms_se_typ_list' = _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se' typ' off' inst in @@ -217,7 +219,9 @@ let rec _strexp_extend_values let replace_fse ((f1, _) as ft1) = if Ident.equal_fieldname f1 f then (f1, res_se') else ft1 in let res_fsel' = - IList.sort [%compare: Ident.fieldname * Sil.strexp] (IList.map replace_fse fsel) in + IList.sort + [%compare: Ident.fieldname * Sil.strexp] + (IList.map replace_fse fsel) in let replace_fta ((f1, _, a1) as fta1) = if Ident.equal_fieldname f f1 then (f1, res_typ', a1) else fta1 in let fields' = @@ -225,11 +229,12 @@ let rec _strexp_extend_values ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; (res_atoms', Sil.Estruct (res_fsel', inst'), typ) :: acc in IList.fold_left replace [] atoms_se_typ_list' - | exception Not_found -> + | None -> let atoms', se', res_typ' = create_struct_values pname tenv orig_prop footprint_part kind max_stamp typ' off' inst in - let res_fsel' = IList.sort [%compare: Ident.fieldname * Sil.strexp] ((f, se'):: fsel) in + let res_fsel' = + IList.sort [%compare: Ident.fieldname * Sil.strexp] ((f, se'):: fsel) in let replace_fta (f', t', a') = if Ident.equal_fieldname f' f then (f, res_typ', a') else (f', t', a') in let fields' = @@ -237,7 +242,7 @@ let rec _strexp_extend_values ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; [(atoms', Sil.Estruct (res_fsel', inst'), typ)] ) - | exception Not_found -> + | None -> raise (Exceptions.Missing_fld (f, __POS__)) ) | None -> @@ -260,8 +265,8 @@ let rec _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se_new typ_new off inst | (Off_index e) :: off', Sil.Earray (len, esel, inst_arr), Tarray (typ', len_for_typ') -> ( bounds_check tenv pname orig_prop len e (State.get_loc ()); - match IList.find (fun (e', _) -> Exp.equal e e') esel with - | _, se' -> + match List.find ~f:(fun (e', _) -> Exp.equal e e') esel with + | Some (_, se') -> let atoms_se_typ_list' = _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se' typ' off' inst in @@ -276,7 +281,7 @@ let rec _strexp_extend_values else raise (Exceptions.Bad_footprint __POS__) in IList.fold_left replace [] atoms_se_typ_list' - | exception Not_found -> + | None -> array_case_analysis_index pname tenv orig_prop footprint_part kind max_stamp len esel @@ -330,7 +335,7 @@ and array_case_analysis_index pname tenv orig_prop [(atoms, array_new, typ_new)] end in let rec handle_case acc isel_seen_rev = function - | [] -> IList.flatten (IList.rev (res_new:: acc)) + | [] -> List.concat (IList.rev (res_new:: acc)) | (i, se) as ise :: isel_unseen -> let atoms_se_typ_list = _strexp_extend_values @@ -397,7 +402,7 @@ let strexp_extend_values let atoms_se_typ_list_filtered = let check_neg_atom atom = Prover.check_atom tenv Prop.prop_emp (Prover.atom_negate tenv atom) in let check_not_inconsistent (atoms, _, _) = not (List.exists ~f:check_neg_atom atoms) in - IList.filter check_not_inconsistent atoms_se_typ_list in + List.filter ~f:check_not_inconsistent atoms_se_typ_list in if Config.trace_rearrange then L.d_strln "exiting strexp_extend_values"; let len, st = match te with | Exp.Sizeof(_, len, st) -> (len, st) @@ -468,10 +473,10 @@ let prop_iter_check_fields_ptsto_shallow tenv iter lexp = | (Sil.Off_fld (fld, _)):: off' -> (match se with | Sil.Estruct (fsel, _) -> - (try - let _, se' = IList.find (fun (fld', _) -> Ident.equal_fieldname fld fld') fsel in - check_offset se' off' - with Not_found -> Some fld) + (match List.find ~f:(fun (fld', _) -> Ident.equal_fieldname fld fld') fsel with + | Some (_, se') -> + check_offset se' off' + | None -> Some fld) | _ -> Some fld) | (Sil.Off_index _):: _ -> None in check_offset se offset @@ -669,7 +674,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = None else None in - IList.find_map_opt annot_extract_guarded_by_str item_annot in + List.find_map ~f:annot_extract_guarded_by_str item_annot in let extract_suppress_warnings_str item_annot = let annot_suppress_warnings_str ((annot: Annot.t), _) = if Annotations.annot_ends_with annot Annotations.suppress_lint @@ -681,7 +686,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = None else None in - IList.find_map_opt annot_suppress_warnings_str item_annot in + List.find_map ~f:annot_suppress_warnings_str item_annot in (* if [fld] is annotated with @GuardedBy("mLock"), return mLock *) let get_guarded_by_fld_str fld typ = match StructTyp.get_field_type_and_annotation ~lookup fld typ with @@ -709,7 +714,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = match StructTyp.get_field_type_and_annotation ~lookup fld typ with | Some (fld_typ, _) when f fld fld_typ -> Some (strexp, fld_typ) | _ -> None in - IList.find_map_opt match_one flds in + List.find_map ~f:match_one flds in (* sometimes, programmers will write @GuardedBy("T.f") with the meaning "guarded by the field f of the object of type T in the current state." note that this is ambiguous when there are @@ -725,13 +730,14 @@ let add_guarded_by_constraints tenv prop lexp pdesc = begin match get_fld_strexp_and_typ typ typ_matches_guarded_by flds with | Some (Sil.Eexp (matching_exp, _), _) -> - IList.find_map_opt - (function - | Sil.Hpointsto (lhs_exp, Estruct (matching_flds, _), Sizeof (fld_typ, _, _)) - when Exp.equal lhs_exp matching_exp -> - get_fld_strexp_and_typ fld_typ (is_guarded_by_fld field_part) matching_flds - | _ -> - None) + List.find_map + ~f:(function + | Sil.Hpointsto (lhs_exp, Estruct (matching_flds, _), Sizeof (fld_typ, _, _)) + when Exp.equal lhs_exp matching_exp -> + get_fld_strexp_and_typ + fld_typ (is_guarded_by_fld field_part) matching_flds + | _ -> + None) sigma | _ -> None @@ -739,37 +745,37 @@ let add_guarded_by_constraints tenv prop lexp pdesc = | _ -> None in - IList.find_map_opt - (function - | Sil.Hpointsto ((Const (Cclass clazz) as lhs_exp), _, Exp.Sizeof (typ, _, _)) - | Sil.Hpointsto (_, Sil.Eexp (Const (Cclass clazz) as lhs_exp, _), Exp.Sizeof (typ, _, _)) - when guarded_by_str_is_class guarded_by_str0 (Ident.name_to_string clazz) -> - Some (Sil.Eexp (lhs_exp, Sil.inst_none), typ) - | Sil.Hpointsto (_, Estruct (flds, _), Exp.Sizeof (typ, _, _)) -> - begin - (* first, try to find a field that exactly matches the guarded-by string *) - match get_fld_strexp_and_typ typ (is_guarded_by_fld guarded_by_str0) flds with - | None when guarded_by_str_is_this guarded_by_str0 -> - (* if the guarded-by string is "OuterClass.this", look for "this$n" for some n. - note that this is a bit sketchy when there are mutliple this$n's, but there's - nothing we can do to disambiguate them. *) - get_fld_strexp_and_typ - typ - (fun f _ -> Ident.java_fieldname_is_outer_instance f) - flds - | None -> - (* can't find an exact match. try a different convention. *) - match_on_field_type typ flds - | Some _ as res_opt -> - res_opt - end - | Sil.Hpointsto (Lvar pvar, rhs_exp, Exp.Sizeof (typ, _, _)) - when (guarded_by_str_is_current_class_this guarded_by_str0 pname || - guarded_by_str_is_super_class_this guarded_by_str0 pname - ) && Pvar.is_this pvar -> - Some (rhs_exp, typ) - | _ -> - None) + List.find_map + ~f:(function + | Sil.Hpointsto ((Const (Cclass clazz) as lhs_exp), _, Exp.Sizeof (typ, _, _)) + | Sil.Hpointsto (_, Sil.Eexp (Const (Cclass clazz) as lhs_exp, _), Exp.Sizeof (typ, _, _)) + when guarded_by_str_is_class guarded_by_str0 (Ident.name_to_string clazz) -> + Some (Sil.Eexp (lhs_exp, Sil.inst_none), typ) + | Sil.Hpointsto (_, Estruct (flds, _), Exp.Sizeof (typ, _, _)) -> + begin + (* first, try to find a field that exactly matches the guarded-by string *) + match get_fld_strexp_and_typ typ (is_guarded_by_fld guarded_by_str0) flds with + | None when guarded_by_str_is_this guarded_by_str0 -> + (* if the guarded-by string is "OuterClass.this", look for "this$n" for some n. + note that this is a bit sketchy when there are mutliple this$n's, but there's + nothing we can do to disambiguate them. *) + get_fld_strexp_and_typ + typ + (fun f _ -> Ident.java_fieldname_is_outer_instance f) + flds + | None -> + (* can't find an exact match. try a different convention. *) + match_on_field_type typ flds + | Some _ as res_opt -> + res_opt + end + | Sil.Hpointsto (Lvar pvar, rhs_exp, Exp.Sizeof (typ, _, _)) + when (guarded_by_str_is_current_class_this guarded_by_str0 pname || + guarded_by_str_is_super_class_this guarded_by_str0 pname + ) && Pvar.is_this pvar -> + Some (rhs_exp, typ) + | _ -> + None) sigma in (* warn if the access to [lexp] is not protected by the [guarded_by_fld_str] lock *) let enforce_guarded_access_ accessed_fld guarded_by_str prop = @@ -981,7 +987,7 @@ let iter_rearrange_ptsto pname tenv orig_prop iter lexp inst = let filter it = let p = Prop.prop_iter_to_prop tenv it in not (Prover.check_inconsistency tenv p) in - IList.filter filter (IList.map handle_case atoms_se_te_list) + List.filter ~f:filter (IList.map handle_case atoms_se_te_list) | _ -> [iter] end in begin @@ -1109,9 +1115,9 @@ let type_at_offset tenv texp off = | (Off_fld (f, _)) :: off', Tstruct name -> ( match Tenv.lookup tenv name with | Some { fields } -> ( - match IList.find (fun (f', _, _) -> Ident.equal_fieldname f f') fields with - | _, typ', _ -> strip_offset off' typ' - | exception Not_found -> None + match List.find ~f:(fun (f', _, _) -> Ident.equal_fieldname f f') fields with + | Some (_, typ', _) -> strip_offset off' typ' + | None -> None ) | None -> None @@ -1209,7 +1215,7 @@ let rec iter_rearrange else iter_rearrange pname tenv (Prop.lexp_normalize_prop tenv prop' lexp) typ prop' iter' inst in let rec f_many_iters iters_lst = function - | [] -> IList.flatten (IList.rev iters_lst) + | [] -> List.concat (IList.rev iters_lst) | iter':: iters' -> let iters_res' = f_one_iter iter' in f_many_iters (iters_res':: iters_lst) iters' in diff --git a/infer/src/backend/state.ml b/infer/src/backend/state.ml index eb5356453..8a221ec97 100644 --- a/infer/src/backend/state.ml +++ b/infer/src/backend/state.ml @@ -215,7 +215,7 @@ let mk_find_duplicate_nodes proc_desc : (Procdesc.Node.t -> Procdesc.NodeSet.t) let duplicates = let equal_normalized_instrs (_, normalized_instrs') = List.equal ~equal:Sil.equal_instr node_normalized_instrs normalized_instrs' in - IList.filter equal_normalized_instrs elements in + List.filter ~f:equal_normalized_instrs elements in IList.fold_left (fun nset (node', _) -> Procdesc.NodeSet.add node' nset) Procdesc.NodeSet.empty duplicates diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index c949120da..b1916b6b6 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -46,7 +46,7 @@ let unroll_type tenv (typ: Typ.t) (off: Sil.offset) = (** Given a node, returns a list of pvar of blocks that have been nullified in the block. *) let get_blocks_nullified node = - let null_blocks = IList.flatten(IList.map (fun i -> match i with + let null_blocks = List.concat (IList.map (fun i -> match i with | Sil.Nullify(pvar, _) when Sil.is_block_pvar pvar -> [pvar] | _ -> []) (Procdesc.Node.get_instrs node)) in null_blocks @@ -142,8 +142,8 @@ let rec apply_offlist match Tenv.lookup tenv name with | Some ({fields} as struct_typ) -> ( let t' = unroll_type tenv typ (Sil.Off_fld (fld, fld_typ)) in - match IList.find (fun fse -> Ident.equal_fieldname fld (fst fse)) fsel with - | _, se' -> + match List.find ~f:(fun fse -> Ident.equal_fieldname fld (fst fse)) fsel with + | Some (_, se') -> let res_e', res_se', res_t', res_pred_insts_op' = apply_offlist pdesc tenv p fp_root nullify_struct @@ -156,7 +156,7 @@ let rec apply_offlist let fields' = IList.map replace_fta fields in ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; (res_e', res_se, typ, res_pred_insts_op') - | exception Not_found -> + | None -> (* This case should not happen. The rearrangement should have materialized all the accessed cells. *) pp_error(); @@ -172,26 +172,25 @@ let rec apply_offlist | (Sil.Off_index idx) :: offlist', Sil.Earray (len, esel, inst1), Typ.Tarray (t', len') -> ( let nidx = Prop.exp_normalize_prop tenv p idx in - try - let idx_ese', se' = IList.find (fun ese -> Prover.check_equal tenv p nidx (fst ese)) esel in - let res_e', res_se', res_t', res_pred_insts_op' = - apply_offlist - pdesc tenv p fp_root nullify_struct - (root_lexp, se', t') offlist' f inst lookup_inst in - let replace_ese ese = - if Exp.equal idx_ese' (fst ese) - then (idx_ese', res_se') - else ese in - let res_se = Sil.Earray (len, IList.map replace_ese esel, inst1) in - let res_t = Typ.Tarray (res_t', len') in - (res_e', res_se, res_t, res_pred_insts_op') - with Not_found -> - (* return a nondeterministic value if the index is not found after rearrangement *) - L.d_str "apply_offlist: index "; Sil.d_exp idx; - L.d_strln " not materialized -- returning nondeterministic value"; - let res_e' = Exp.Var (Ident.create_fresh Ident.kprimed) in - (res_e', strexp, typ, None) - ) + match List.find ~f:(fun ese -> Prover.check_equal tenv p nidx (fst ese)) esel with + | Some (idx_ese', se') -> + let res_e', res_se', res_t', res_pred_insts_op' = + apply_offlist + pdesc tenv p fp_root nullify_struct + (root_lexp, se', t') offlist' f inst lookup_inst in + let replace_ese ese = + if Exp.equal idx_ese' (fst ese) + then (idx_ese', res_se') + else ese in + let res_se = Sil.Earray (len, IList.map replace_ese esel, inst1) in + let res_t = Typ.Tarray (res_t', len') in + (res_e', res_se, res_t, res_pred_insts_op') + | None -> + (* return a nondeterministic value if the index is not found after rearrangement *) + L.d_str "apply_offlist: index "; Sil.d_exp idx; + L.d_strln " not materialized -- returning nondeterministic value"; + let res_e' = Exp.Var (Ident.create_fresh Ident.kprimed) in + (res_e', strexp, typ, None)) | (Sil.Off_index _) :: _, _, _ -> (* This case should not happen. The rearrangement should have materialized all the accessed cells. *) @@ -423,10 +422,9 @@ let check_arith_norm_exp tenv pname exp prop = (** Check if [cond] is testing for NULL a pointer already dereferenced *) let check_already_dereferenced tenv pname cond prop = let find_hpred lhs = - try Some (IList.find (function + List.find ~f:(function | Sil.Hpointsto (e, _, _) -> Exp.equal e lhs - | _ -> false) prop.Prop.sigma) - with Not_found -> None in + | _ -> false) prop.Prop.sigma in let rec is_check_zero = function | Exp.Var id -> Some id @@ -568,7 +566,7 @@ let resolve_virtual_pname tenv prop actuals callee_pname call_flags : Procname.t let target_receiver_typ = get_receiver_typ target_pname actual_receiver_typ in Prover.Subtyping_check.check_subtype tenv target_receiver_typ 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 = List.filter ~f:may_dispatch_to targets in (* make sure [resolved_pname] is not a duplicate *) if List.mem ~equal:Procname.equal feasible_targets resolved_pname then feasible_targets @@ -748,7 +746,7 @@ let handle_objc_instance_method_call_or_skip tenv actual_pars path callee_pname let propset = prune_ne tenv ~positive:false receiver Exp.zero pre_with_attr_or_null in if Propset.is_empty propset then [] else - let prop = IList.hd (Propset.to_proplist propset) in + let prop = List.hd_exn (Propset.to_proplist propset) in let path = Paths.Path.add_description path path_description in [(prop, path)] in res_null @ (res ()) @@ -1161,7 +1159,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path else proc_call (Option.value_exn resolved_summary_opt) (call_args prop resolved_pname n_actual_params ret_id loc) in - IList.flatten (IList.map do_call sentinel_result) + List.concat (IList.map do_call sentinel_result) ) ) | Sil.Call (ret_id, fun_exp, actual_params, loc, call_flags) -> (* Call via function pointer *) @@ -1244,7 +1242,7 @@ and instrs ?(mask_errors=false) tenv pdesc instrs ppl = ("Generated Instruction Failed with: " ^ (Localise.to_string err_name)^loc ); L.d_ln(); [(p, path)] in - let f plist instr = IList.flatten (IList.map (exe_instr instr) plist) in + let f plist instr = List.concat (IList.map (exe_instr instr) plist) in IList.fold_left f ppl instrs and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname callee_loc = @@ -1301,11 +1299,11 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call (* bind actual passed by ref to the abduced value pointed to by the synthetic pvar *) let prop' = let filtered_sigma = - IList.filter - (function - | Sil.Hpointsto (lhs, _, _) when Exp.equal lhs actual -> - false - | _ -> true) + List.filter + ~f:(function + | Sil.Hpointsto (lhs, _, _) when Exp.equal lhs actual -> + false + | _ -> true) prop.Prop.sigma in Prop.normalize tenv (Prop.set prop ~sigma:filtered_sigma) in IList.fold_left @@ -1341,7 +1339,7 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call not is_const | None -> true in - IList.filter is_not_const actuals_by_ref in + List.filter ~f:is_not_const actuals_by_ref in IList.fold_left do_actual_by_ref prop non_const_actuals_by_ref and check_untainted tenv exp taint_kind caller_pname callee_pname prop = @@ -1391,11 +1389,10 @@ and unknown_or_scan_call ~is_scan ret_type_option ret_annots | param_nums -> let check_taint_if_nums_match (prop_acc, param_num) (actual_exp, _actual_typ) = let prop_acc' = - try - let _, taint_kind = - IList.find (fun (num, _) -> Int.equal num param_num) param_nums in - check_untainted tenv actual_exp taint_kind caller_pname callee_pname prop_acc - with Not_found -> prop_acc in + match List.find ~f:(fun (num, _) -> Int.equal num param_num) param_nums with + | Some (_, taint_kind) -> + check_untainted tenv actual_exp taint_kind caller_pname callee_pname prop_acc + | None -> prop_acc in prop_acc', param_num + 1 in IList.fold_left check_taint_if_nums_match diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index 29982ad8d..d44e5439e 100644 --- a/infer/src/backend/tabulation.ml +++ b/infer/src/backend/tabulation.ml @@ -156,7 +156,7 @@ let process_splitting let sub = Sil.sub_join sub1 sub2 in let sub1_inverse = let sub1_list = Sil.sub_to_list sub1 in - let sub1_list' = IList.filter (function (_, Exp.Var _) -> true | _ -> false) sub1_list in + let sub1_list' = List.filter ~f:(function (_, Exp.Var _) -> true | _ -> false) sub1_list in let sub1_inverse_list = IList.map (function (id, Exp.Var id') -> (id', Exp.Var id) | _ -> assert false) @@ -243,7 +243,7 @@ let process_splitting | _ -> L.d_warning "Missing fields in complex pred: "; Sil.d_hpred hpred; L.d_ln (); false in - IList.filter filter sigma in + List.filter ~f:filter sigma in let norm_frame = Prop.sigma_sub sub' frame in { sub = sub'; frame = norm_frame; @@ -342,14 +342,14 @@ let check_dereferences tenv callee_pname actual_pre sub spec_pre formal_params = a less interesting PRECONDITION_NOT_MET * whenever possible *) (* TOOD (t4893533): use this trick outside of angelic mode and in other parts of the code *) - Some - (try - IList.find - (fun err -> match err with - | (Deref_null _, _) -> true - | _ -> false ) - deref_err_list - with Not_found -> deref_err) + (match + List.find + ~f:(fun err -> match err with + | (Deref_null _, _) -> true + | _ -> false ) + deref_err_list with + | Some x -> Some x + | None -> Some deref_err) else Some deref_err let post_process_sigma tenv (sigma: Sil.hpred list) loc : Sil.hpred list = @@ -720,7 +720,8 @@ let combine tenv let post_sigma = sigma_star_fld tenv post_p.Prop.sigma split.frame_fld in let post_sigma' = sigma_star_typ post_sigma split.frame_typ in Prop.set post_p ~sigma:post_sigma' in - let post_p1 = Prop.prop_sigma_star (prop_copy_footprint_pure tenv actual_pre post_p') split.frame in + let post_p1 = + Prop.prop_sigma_star (prop_copy_footprint_pure tenv actual_pre post_p') split.frame in let handle_null_case_analysis sigma = let id_assigned_to_null id = @@ -838,7 +839,10 @@ let check_taint_on_variadic_function tenv callee_pname caller_pname actual_param | [(tp, _)] when tp < 0 -> (* All actual params from abs(tp) should not be tainted. If we find one we give the warning *) let tp_abs = abs tp in - L.d_strln ("Checking tainted actual parameters from parameter number "^ (string_of_int tp_abs) ^ " onwards."); + L.d_strln + ("Checking tainted actual parameters from parameter number " ^ + (string_of_int tp_abs) ^ + " onwards."); let actual_params' = n_tail actual_params tp_abs in L.d_str "Paramters to be checked: [ "; IList.iter(fun (e,_) -> @@ -903,7 +907,7 @@ let mk_posts tenv ret_id prop callee_pname callee_attrs posts = Prover.check_equal tenv (Prop.normalize tenv prop) e Exp.zero | _ -> false) prop.Prop.sigma in - IList.filter (fun (prop, _) -> not (returns_null prop)) posts + List.filter ~f:(fun (prop, _) -> not (returns_null prop)) posts else posts in let mk_retval_tainted posts = match Taint.returns_tainted callee_pname (Some callee_attrs) with @@ -982,7 +986,7 @@ let do_taint_check tenv caller_pname callee_pname calling_prop missing_pi sub ac untaint_atoms) taint_untaint_exp_map) in check_taint_on_variadic_function tenv callee_pname caller_pname actual_params calling_prop; - IList.filter not_untaint_atom missing_pi_sub + List.filter ~f:not_untaint_atom missing_pi_sub let class_cast_exn tenv pname_opt texp1 texp2 exp ml_loc = let desc = @@ -1081,7 +1085,7 @@ let exe_spec | _ -> false in (* missing fields minus hidden fields *) let missing_fld_nohidden = - IList.filter (fun hp -> not (hpred_missing_hidden hp)) missing_fld in + List.filter ~f:(fun hp -> not (hpred_missing_hidden hp)) missing_fld in if not !Config.footprint && split.missing_sigma <> [] then begin L.d_strln "Implication error: missing_sigma not empty in re-execution"; @@ -1099,15 +1103,16 @@ let remove_constant_string_class tenv prop = let filter = function | Sil.Hpointsto (Exp.Const (Const.Cstr _ | Const.Cclass _), _, _) -> false | _ -> true in - let sigma = IList.filter filter prop.Prop.sigma in - let sigmafp = IList.filter filter prop.Prop.sigma_fp in + let sigma = List.filter ~f:filter prop.Prop.sigma in + let sigmafp = List.filter ~f:filter prop.Prop.sigma_fp in let prop' = Prop.set prop ~sigma ~sigma_fp:sigmafp in Prop.normalize tenv prop' (** existentially quantify the path identifier generated by the prover to keep track of expansions of lhs paths and remove pointsto's whose lhs is a constant string *) -let quantify_path_idents_remove_constant_strings tenv (prop: Prop.normal Prop.t) : Prop.normal Prop.t = +let quantify_path_idents_remove_constant_strings tenv (prop: Prop.normal Prop.t) + : Prop.normal Prop.t = let fav = Prop.prop_fav prop in Sil.fav_filter_ident fav Ident.is_path; remove_constant_string_class tenv (Prop.exist_quantify tenv fav prop) @@ -1120,7 +1125,7 @@ let prop_pure_to_footprint tenv (p: 'a Prop.t) : Prop.normal Prop.t = let a_fav = Sil.atom_fav a in Sil.fav_for_all a_fav Ident.is_footprint in let pure = Prop.get_pure p in - let new_footprint_atoms = IList.filter is_footprint_atom_not_attribute pure in + let new_footprint_atoms = List.filter ~f:is_footprint_atom_not_attribute pure in if List.is_empty new_footprint_atoms then p else (* add pure fact to footprint *) @@ -1141,7 +1146,8 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re IList.partition (fun vr -> vr.vr_pi <> []) valid_res in let _, valid_res_cons_pre_missing = IList.partition (fun vr -> vr.incons_pre_missing) valid_res in - let deref_errors = IList.filter (function Dereference_error _ -> true | _ -> false) invalid_res in + let deref_errors = + List.filter ~f:(function Dereference_error _ -> true | _ -> false) invalid_res in let print_pi pi = L.d_str "pi: "; Prop.d_pi pi; L.d_ln () in let call_desc kind_opt = Localise.desc_precondition_not_met kind_opt callee_pname loc in @@ -1151,64 +1157,65 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re if List.is_empty valid_res_cons_pre_missing then (* no valid results where actual pre and missing are consistent *) begin - if deref_errors <> [] then (* dereference error detected *) - let extend_path path_opt path_pos_opt = match path_opt with - | None -> () - | Some path_post -> - let old_path, _ = State.get_path () in - let new_path = - Paths.Path.add_call - (include_subtrace callee_pname) old_path callee_pname path_post in - State.set_path new_path path_pos_opt in - match IList.hd deref_errors with - | Dereference_error (Deref_minusone, desc, path_opt) -> - trace_call Specs.CallStats.CR_not_met; - extend_path path_opt None; - raise (Exceptions.Dangling_pointer_dereference - (Some PredSymb.DAminusone, desc, __POS__)) - | Dereference_error (Deref_undef_exp, desc, path_opt) -> - trace_call Specs.CallStats.CR_not_met; - extend_path path_opt None; - raise (Exceptions.Dangling_pointer_dereference - (Some PredSymb.DAuninit, desc, __POS__)) - | Dereference_error (Deref_null pos, desc, path_opt) -> - trace_call Specs.CallStats.CR_not_met; - extend_path path_opt (Some pos); - if Localise.is_parameter_not_null_checked_desc desc then - raise (Exceptions.Parameter_not_null_checked (desc, __POS__)) - else if Localise.is_field_not_null_checked_desc desc then - raise (Exceptions.Field_not_null_checked (desc, __POS__)) - else if (Localise.is_empty_vector_access_desc desc) then - raise (Exceptions.Empty_vector_access (desc, __POS__)) - else raise (Exceptions.Null_dereference (desc, __POS__)) - | Dereference_error (Deref_freed _, desc, path_opt) -> - trace_call Specs.CallStats.CR_not_met; - extend_path path_opt None; - raise (Exceptions.Use_after_free (desc, __POS__)) - | Dereference_error (Deref_undef (_, _, pos), desc, path_opt) -> - trace_call Specs.CallStats.CR_not_met; - extend_path path_opt (Some pos); - raise (Exceptions.Skip_pointer_dereference (desc, __POS__)) - | Prover_checks _ - | Cannot_combine - | Missing_sigma_not_empty - | Missing_fld_not_empty -> - trace_call Specs.CallStats.CR_not_met; - assert false - else (* no dereference error detected *) - let desc = - if List.exists ~f:(function Cannot_combine -> true | _ -> false) invalid_res then - call_desc (Some Localise.Pnm_dangling) - else if List.exists ~f:(function - | Prover_checks (check :: _) -> - trace_call Specs.CallStats.CR_not_met; - let exn = get_check_exn tenv check callee_pname loc __POS__ in - raise exn - | _ -> false) invalid_res then - call_desc (Some Localise.Pnm_bounds) - else call_desc None in - trace_call Specs.CallStats.CR_not_met; - raise (Exceptions.Precondition_not_met (desc, __POS__)) + match deref_errors with + | error :: _ -> (* dereference error detected *) + let extend_path path_opt path_pos_opt = match path_opt with + | None -> () + | Some path_post -> + let old_path, _ = State.get_path () in + let new_path = + Paths.Path.add_call + (include_subtrace callee_pname) old_path callee_pname path_post in + State.set_path new_path path_pos_opt in + (match error with + | Dereference_error (Deref_minusone, desc, path_opt) -> + trace_call Specs.CallStats.CR_not_met; + extend_path path_opt None; + raise (Exceptions.Dangling_pointer_dereference + (Some PredSymb.DAminusone, desc, __POS__)) + | Dereference_error (Deref_undef_exp, desc, path_opt) -> + trace_call Specs.CallStats.CR_not_met; + extend_path path_opt None; + raise (Exceptions.Dangling_pointer_dereference + (Some PredSymb.DAuninit, desc, __POS__)) + | Dereference_error (Deref_null pos, desc, path_opt) -> + trace_call Specs.CallStats.CR_not_met; + extend_path path_opt (Some pos); + if Localise.is_parameter_not_null_checked_desc desc then + raise (Exceptions.Parameter_not_null_checked (desc, __POS__)) + else if Localise.is_field_not_null_checked_desc desc then + raise (Exceptions.Field_not_null_checked (desc, __POS__)) + else if (Localise.is_empty_vector_access_desc desc) then + raise (Exceptions.Empty_vector_access (desc, __POS__)) + else raise (Exceptions.Null_dereference (desc, __POS__)) + | Dereference_error (Deref_freed _, desc, path_opt) -> + trace_call Specs.CallStats.CR_not_met; + extend_path path_opt None; + raise (Exceptions.Use_after_free (desc, __POS__)) + | Dereference_error (Deref_undef (_, _, pos), desc, path_opt) -> + trace_call Specs.CallStats.CR_not_met; + extend_path path_opt (Some pos); + raise (Exceptions.Skip_pointer_dereference (desc, __POS__)) + | Prover_checks _ + | Cannot_combine + | Missing_sigma_not_empty + | Missing_fld_not_empty -> + trace_call Specs.CallStats.CR_not_met; + assert false) + | [] -> (* no dereference error detected *) + let desc = + if List.exists ~f:(function Cannot_combine -> true | _ -> false) invalid_res then + call_desc (Some Localise.Pnm_dangling) + else if List.exists ~f:(function + | Prover_checks (check :: _) -> + trace_call Specs.CallStats.CR_not_met; + let exn = get_check_exn tenv check callee_pname loc __POS__ in + raise exn + | _ -> false) invalid_res then + call_desc (Some Localise.Pnm_bounds) + else call_desc None in + trace_call Specs.CallStats.CR_not_met; + raise (Exceptions.Precondition_not_met (desc, __POS__)) end else (* combine the valid results, and store diverging states *) let process_valid_res vr = @@ -1224,10 +1231,10 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re vr.vr_cons_res in IList.map (fun (p, path) -> (prop_pure_to_footprint tenv p, path)) - (IList.flatten (IList.map process_valid_res valid_res)) + (List.concat (IList.map process_valid_res valid_res)) end else if valid_res_no_miss_pi <> [] then - IList.flatten (IList.map (fun vr -> vr.vr_cons_res) valid_res_no_miss_pi) + List.concat (IList.map (fun vr -> vr.vr_cons_res) valid_res_no_miss_pi) else if List.is_empty valid_res_miss_pi then raise (Exceptions.Precondition_not_met (call_desc None, __POS__)) else @@ -1243,7 +1250,7 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re | Some cover -> L.d_strln "Found minimum cover"; IList.iter print_pi (IList.map fst cover); - IList.flatten (IList.map snd cover) + List.concat (IList.map snd cover) end in trace_call Specs.CallStats.CR_success; let res = diff --git a/infer/src/backend/taint.ml b/infer/src/backend/taint.ml index 38590d62c..e18f6a4a6 100644 --- a/infer/src/backend/taint.ml +++ b/infer/src/backend/taint.ml @@ -306,24 +306,21 @@ let attrs_opt_get_annots = function let returns_tainted callee_pname callee_attrs_opt = let procname_matches taint_info = Procname.equal taint_info.PredSymb.taint_source callee_pname in - try - let taint_info = IList.find procname_matches sources in - Some taint_info.PredSymb.taint_kind - with Not_found -> - let ret_annot, _ = attrs_opt_get_annots callee_attrs_opt in - if Annotations.ia_is_integrity_source ret_annot - then Some PredSymb.Tk_integrity_annotation - else if Annotations.ia_is_privacy_source ret_annot - then Some PredSymb.Tk_privacy_annotation - else None + match List.find ~f:procname_matches sources with + | Some taint_info -> + Some taint_info.PredSymb.taint_kind + | None -> + let ret_annot, _ = attrs_opt_get_annots callee_attrs_opt in + if Annotations.ia_is_integrity_source ret_annot + then Some PredSymb.Tk_integrity_annotation + else if Annotations.ia_is_privacy_source ret_annot + then Some PredSymb.Tk_privacy_annotation + else None let find_callee taint_infos callee_pname = - try - Some - (IList.find - (fun (taint_info, _) -> Procname.equal taint_info.PredSymb.taint_source callee_pname) - taint_infos) - with Not_found -> None + List.find + ~f:(fun (taint_info, _) -> Procname.equal taint_info.PredSymb.taint_source callee_pname) + taint_infos (** returns list of zero-indexed argument numbers of [callee_pname] that may be tainted *) let accepts_sensitive_params callee_pname callee_attrs_opt = @@ -361,8 +358,7 @@ let has_taint_annotation fieldname (struct_typ: StructTyp.t) = (* add tainting attributes to a list of paramenters *) let get_params_to_taint tainted_param_nums formal_params = let get_taint_kind index = - try Some (IList.find (fun (taint_index, _) -> Int.equal index taint_index) tainted_param_nums) - with Not_found -> None in + List.find ~f:(fun (taint_index, _) -> Int.equal index taint_index) tainted_param_nums in let collect_params_to_taint params_to_taint_acc (index, param) = match get_taint_kind index with | Some (_, taint_kind) -> (param, taint_kind) :: params_to_taint_acc diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index 5374755dd..da50aab10 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/infer/src/base/CommandLineOption.ml @@ -181,7 +181,7 @@ let pad_and_xform doc_width left_width desc = wrap_line "" doc_width s else [s] in IList.map wrap_line lines in - let doc = indent_doc (String.concat ~sep:"\n" (IList.flatten wrapped_lines)) in + let doc = indent_doc (String.concat ~sep:"\n" (List.concat wrapped_lines)) in xdesc {desc with doc} let align desc_list = @@ -325,7 +325,7 @@ type 'a t = let string_json_decoder ~long json = [dashdash long; YBU.to_string json] -let list_json_decoder json_decoder json = IList.flatten (YBU.convert_each json_decoder json) +let list_json_decoder json_decoder json = List.concat (YBU.convert_each json_decoder json) let mk_set var value ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = let setter () = var := value in @@ -544,6 +544,7 @@ let mk_rest ?(parse_mode=Infer []) doc = let set_curr_speclist_for_parse_action ~incomplete ~usage parse_action = let full_speclist = ref [] in + let curr_usage status = prerr_endline (String.concat_array ~sep:" " !args_to_parse) ; Arg.usage !curr_speclist usage ; @@ -626,8 +627,8 @@ let set_curr_speclist_for_parse_action ~incomplete ~usage parse_action = opt = "" || IList.for_all (fun (opt', _, doc') -> (doc <> "" && doc' = "") || (not (String.equal opt opt'))) speclist in - let unique_exe_speclist = IList.filter (is_not_dup_with_doc !curr_speclist) exe_speclist in - curr_speclist := IList.filter (is_not_dup_with_doc unique_exe_speclist) !curr_speclist @ + let unique_exe_speclist = List.filter ~f:(is_not_dup_with_doc !curr_speclist) exe_speclist in + curr_speclist := List.filter ~f:(is_not_dup_with_doc unique_exe_speclist) !curr_speclist @ (match header with | Some s -> (to_arg_spec_triple (mk_header_spec s)):: unique_exe_speclist | None -> unique_exe_speclist) @@ -682,10 +683,10 @@ let decode_inferconfig_to_argv path = let one_config_item result (key, json_val) = try let {decode_json} = - IList.find - (fun {long; short} -> - String.equal key long - || (* for deprecated options *) String.equal key short) + List.find_exn + ~f:(fun {long; short} -> + String.equal key long + || (* for deprecated options *) String.equal key short) !desc_list in decode_json json_val @ result with @@ -704,7 +705,7 @@ let env_var_sep = '^' let encode_argv_to_env argv = String.concat ~sep:(String.make 1 env_var_sep) - (IList.filter (fun arg -> + (List.filter ~f:(fun arg -> not (String.contains arg env_var_sep) || ( warnf "Ignoring unsupported option containing '%c' character: %s@\n" diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index eaabd95f6..74cfbdc06 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -49,7 +49,7 @@ let string_to_analyzer = ("bufferoverrun", Bufferoverrun)] let string_of_analyzer a = - IList.find (fun (_, a') -> equal_analyzer a a') string_to_analyzer |> fst + List.find_exn ~f:(fun (_, a') -> equal_analyzer a a') string_to_analyzer |> fst let clang_frontend_action_symbols = [ ("lint", `Lint); diff --git a/infer/src/base/IList.ml b/infer/src/base/IList.ml index 235a8b496..43a4e5c73 100644 --- a/infer/src/base/IList.ml +++ b/infer/src/base/IList.ml @@ -7,16 +7,11 @@ * of patent rights can be found in the PATENTS file in the same directory. *) -type 'a t = 'a list [@@deriving compare] - let exists = List.exists -let filter = List.filter -let find = List.find let fold_left = List.fold_left let fold_left2 = List.fold_left2 let for_all = List.for_all let for_all2 = List.for_all2 -let hd = List.hd let iter = List.iter let iter2 = List.iter2 let iteri = List.iteri @@ -28,7 +23,6 @@ let rev_append = List.rev_append let rev_map = List.rev_map let sort = List.sort let stable_sort = List.stable_sort -let tl = List.tl let rec last = function | [] -> None @@ -45,13 +39,6 @@ let fold_lefti (f : 'a -> int -> 'b -> 'a) a l = fold_left (fun (i, acc) e -> i +1, f acc i e) (0, a) l |> snd -(** tail-recursive variant of List.flatten *) -let flatten = - let rec flatten acc l = match l with - | [] -> acc - | x:: l' -> flatten (rev_append x acc) l' in - fun l -> rev (flatten [] l) - let flatten_options list = fold_left (fun list -> function | Some x -> x:: list | None -> list) [] list |> rev @@ -198,17 +185,6 @@ let rec find_map_opt f = function then e' else find_map_opt f l' -(** Like find_map_opt, but with indices *) -let find_mapi_opt (f : int -> 'a -> 'b option) l = - let rec find_mapi_opt_ f i = function - | [] -> None - | e :: l' -> - let e' = f i e in - if e' <> None - then e' - else find_mapi_opt_ f (i + 1) l' in - find_mapi_opt_ f 0 l - let to_string f l = let rec aux l = match l with @@ -223,7 +199,7 @@ let mem_assoc equal a l = (** Like List.assoc but without builtin equality *) let assoc equal a l = - snd (find (fun x -> equal a (fst x)) l) + snd (List.find (fun x -> equal a (fst x)) l) let range i j = let rec aux n acc = diff --git a/infer/src/base/IList.mli b/infer/src/base/IList.mli index 02c399b75..93ffcb938 100644 --- a/infer/src/base/IList.mli +++ b/infer/src/base/IList.mli @@ -7,22 +7,13 @@ * of patent rights can be found in the PATENTS file in the same directory. *) -type 'a t = 'a list [@@deriving compare] - -val filter : ('a -> bool) -> 'a list -> 'a list - -(** tail-recursive variant of List.flatten *) -val flatten : 'a list list -> 'a list - (** Remove all None elements from the list. *) val flatten_options : ('a option) list -> 'a list -val find : ('a -> bool) -> 'a list -> 'a val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a val for_all : ('a -> bool) -> 'a list -> bool val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool -val hd : 'a list -> 'a val iter : ('a -> unit) -> 'a list -> unit val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit val iteri : (int -> 'a -> unit) -> 'a list -> unit @@ -54,7 +45,6 @@ val rev_map : ('a -> 'b) -> 'a list -> 'b list val sort : ('a -> 'a -> int) -> 'a list -> 'a list val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list -val tl : 'a list -> 'a list (** last element, if any *) val last : 'a list -> 'a option @@ -95,9 +85,6 @@ val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list (** Return the first non-None result found when applying f to elements of l *) val find_map_opt : ('a -> 'b option) -> 'a list -> 'b option -(** Like find_map_opt, but with indices *) -val find_mapi_opt : (int -> 'a -> 'b option) -> 'a list -> 'b option - val to_string : ('a -> string) -> 'a list -> string (** Creates an list, inclusive. E.g. `range 2 4` -> [2, 3, 4]. diff --git a/infer/src/base/SourceFile.ml b/infer/src/base/SourceFile.ml index 63d0d5c4a..c77aa04e1 100644 --- a/infer/src/base/SourceFile.ml +++ b/infer/src/base/SourceFile.ml @@ -128,8 +128,7 @@ let of_header header_file = let file_opt = match ext_opt with | Some ext when List.mem ~equal:String.equal header_exts ext -> ( let possible_files = IList.map (fun ext -> file_no_ext ^ "." ^ ext) source_exts in - try Some (IList.find path_exists possible_files) - with Not_found -> None + List.find ~f:path_exists possible_files ) | _ -> None in Option.map ~f:from_abs_path file_opt diff --git a/infer/src/bufferoverrun/arrayBlk.ml b/infer/src/bufferoverrun/arrayBlk.ml index 29afdcaa3..551026858 100644 --- a/infer/src/bufferoverrun/arrayBlk.ml +++ b/infer/src/bufferoverrun/arrayBlk.ml @@ -97,7 +97,7 @@ struct let s1 = Itv.get_symbols arr.offset in let s2 = Itv.get_symbols arr.size in let s3 = Itv.get_symbols arr.stride in - IList.flatten [s1; s2; s3] + List.concat [s1; s2; s3] let normalize : t -> t = fun arr -> @@ -176,7 +176,7 @@ let subst : astate -> Itv.Bound.t Itv.SubstMap.t -> astate let get_symbols : astate -> Itv.Symbol.t list = fun a -> - IList.flatten (IList.map (fun (_, ai) -> ArrInfo.get_symbols ai) (bindings a)) + List.concat (IList.map (fun (_, ai) -> ArrInfo.get_symbols ai) (bindings a)) let normalize : astate -> astate = fun a -> map ArrInfo.normalize a diff --git a/infer/src/bufferoverrun/bufferOverrunChecker.ml b/infer/src/bufferoverrun/bufferOverrunChecker.ml index 345691635..781420c06 100644 --- a/infer/src/bufferoverrun/bufferOverrunChecker.ml +++ b/infer/src/bufferoverrun/bufferOverrunChecker.ml @@ -49,7 +49,7 @@ struct = fun pname ret params node mem -> match ret with | Some (id, _) -> - let (typ, size) = get_malloc_info (IList.hd params |> fst) in + let (typ, size) = get_malloc_info (List.hd_exn params |> fst) in let size = Sem.eval size mem (CFG.loc node) |> Dom.Val.get_itv in let v = Sem.eval_array_alloc pname node typ Itv.zero size 0 1 in Dom.Mem.add_stack (Loc.of_id id) v mem @@ -59,7 +59,7 @@ struct : Procname.t -> (Ident.t * Typ.t) option -> (Exp.t * Typ.t) list -> CFG.node -> Dom.Mem.t -> Dom.Mem.t = fun pname ret params node mem -> - model_malloc pname ret (IList.tl params) node mem + model_malloc pname ret (List.tl_exn params) node mem let model_natual_itv : (Ident.t * Typ.t) option -> Dom.Mem.t -> Dom.Mem.t = fun ret mem -> diff --git a/infer/src/bufferoverrun/bufferOverrunDomain.ml b/infer/src/bufferoverrun/bufferOverrunDomain.ml index ce06cd398..ed3f6a9e9 100644 --- a/infer/src/bufferoverrun/bufferOverrunDomain.ml +++ b/infer/src/bufferoverrun/bufferOverrunDomain.ml @@ -491,7 +491,7 @@ struct let get_symbols : astate -> Itv.Symbol.t list = fun mem -> - IList.flatten (IList.map (fun (_, v) -> Val.get_symbols v) (bindings mem)) + List.concat (IList.map (fun (_, v) -> Val.get_symbols v) (bindings mem)) let get_return : astate -> Val.t = fun mem -> diff --git a/infer/src/checkers/BoundedCallTree.ml b/infer/src/checkers/BoundedCallTree.ml index ca9084f24..3415e08a0 100644 --- a/infer/src/checkers/BoundedCallTree.ml +++ b/infer/src/checkers/BoundedCallTree.ml @@ -122,19 +122,19 @@ module TransferFunctions (CFG : ProcCfg.S) = struct failwith "Proc type not supported by crashcontext: block" in String.equal frame.Stacktrace.method_str (Procname.get_method caller) && matches_class caller in - let all_frames = IList.flatten + let all_frames = List.concat (IList.map (fun trace -> trace.Stacktrace.frames) traces) in begin - try - let frame = IList.find matches_proc all_frames in - let new_astate = Domain.add pn astate in - if Stacktrace.frame_matches_location frame loc then begin - let pdesc = proc_data.ProcData.pdesc in - output_json_summary pdesc new_astate loc "call_site" get_proc_desc - end; - new_astate - with - Not_found -> astate + match List.find ~f:matches_proc all_frames with + | Some frame -> + let new_astate = Domain.add pn astate in + if Stacktrace.frame_matches_location frame loc then begin + let pdesc = proc_data.ProcData.pdesc in + output_json_summary pdesc new_astate loc "call_site" get_proc_desc + end; + new_astate + | None -> + astate end | Sil.Call _ -> (* We currently ignore calls through function pointers in C and diff --git a/infer/src/checkers/SimpleChecker.ml b/infer/src/checkers/SimpleChecker.ml index 8269bb1f2..8d984b3c9 100644 --- a/infer/src/checkers/SimpleChecker.ml +++ b/infer/src/checkers/SimpleChecker.ml @@ -90,8 +90,8 @@ module Make (Spec : Spec) : S = struct then (* should never fail since keys in the invariant map should always be real node id's *) let node = - IList.find - (fun node -> Procdesc.Node.equal_id node_id (Procdesc.Node.get_id node)) + List.find_exn + ~f:(fun node -> Procdesc.Node.equal_id node_id (Procdesc.Node.get_id node)) nodes in Domain.iter (fun astate -> diff --git a/infer/src/checkers/Siof.ml b/infer/src/checkers/Siof.ml index 5fd75b848..142e1c995 100644 --- a/infer/src/checkers/Siof.ml +++ b/infer/src/checkers/Siof.ml @@ -47,7 +47,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct && not (Pvar.is_compile_constant pv) && not (is_compile_time_constructed pdesc pv) in let globals_accesses = - Exp.get_vars e |> snd |> IList.filter is_dangerous_global + Exp.get_vars e |> snd |> List.filter ~f:is_dangerous_global |> IList.map (fun v -> (v, loc)) in GlobalsAccesses.of_list globals_accesses @@ -149,12 +149,12 @@ let report_siof trace pdesc gname loc = let has_foreign_sink (_, path) = List.exists ~f:(fun (sink, _) -> - GlobalsAccesses.exists (is_foreign tu_opt) - (SiofTrace.Sink.kind sink)) + GlobalsAccesses.exists (is_foreign tu_opt) + (SiofTrace.Sink.kind sink)) path in SiofTrace.get_reportable_sink_paths trace ~trace_of_pname - |> IList.filter has_foreign_sink + |> List.filter ~f:has_foreign_sink |> IList.iter report_one_path let siof_check pdesc gname = function diff --git a/infer/src/checkers/Stacktrace.ml b/infer/src/checkers/Stacktrace.ml index b5542372d..53b9439ba 100644 --- a/infer/src/checkers/Stacktrace.ml +++ b/infer/src/checkers/Stacktrace.ml @@ -101,7 +101,7 @@ let of_json filename json = Yojson.Basic.Util.to_list (extract_json_member frames_key) |> IList.map Yojson.Basic.Util.to_string |> IList.map String.strip - |> IList.filter (fun s -> s <> "") + |> List.filter ~f:(fun s -> s <> "") |> IList.map parse_stack_frame in make exception_name frames diff --git a/infer/src/checkers/ThreadSafety.ml b/infer/src/checkers/ThreadSafety.ml index c3df52a68..605c03f0f 100644 --- a/infer/src/checkers/ThreadSafety.ml +++ b/infer/src/checkers/ThreadSafety.ml @@ -152,7 +152,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let truncate = function | base, [] | base, _ :: [] -> base, [] - | base, accesses -> base, IList.rev (IList.tl (IList.rev accesses)) in + | base, accesses -> base, IList.rev (List.tl_exn (IList.rev accesses)) in (* we don't want to warn on writes to the field if it is (a) thread-confined, or (b) volatile *) let is_safe_write access_path tenv = @@ -714,8 +714,8 @@ let report_thread_safety_violations ( _, tenv, pname, pdesc) trace = let pp_accesses fmt sink = let _, accesses = PathDomain.Sink.kind sink in AccessPath.pp_access_list fmt accesses in - let initial_sink, _ = IList.hd (IList.rev sinks) in - let final_sink, _ = IList.hd sinks in + let initial_sink, _ = List.last_exn sinks in + let final_sink, _ = List.hd_exn sinks in let initial_sink_site = PathDomain.Sink.call_site initial_sink in let final_sink_site = PathDomain.Sink.call_site final_sink in let desc_of_sink sink = diff --git a/infer/src/checkers/Trace.ml b/infer/src/checkers/Trace.ml index c493ad113..ccd55dae1 100644 --- a/infer/src/checkers/Trace.ml +++ b/infer/src/checkers/Trace.ml @@ -104,10 +104,10 @@ module Expander (TraceElem : TraceElem.S) = struct CallSite.Set.mem (TraceElem.call_site callee_elem) seen in (* find sinks that are the same kind as the caller, but have a different procname *) let matching_elems = - IList.filter - (fun callee_elem -> - [%compare.equal : TraceElem.Kind.t] (TraceElem.kind callee_elem) elem_kind && - not (is_recursive callee_elem seen_acc')) + List.filter + ~f:(fun callee_elem -> + [%compare.equal : TraceElem.Kind.t] (TraceElem.kind callee_elem) elem_kind && + not (is_recursive callee_elem seen_acc')) elems in (* arbitrarily pick one elem and explore it further *) match matching_elems with @@ -208,8 +208,8 @@ module Make (Spec : Spec) = struct let pp_sources = pp_elems Source.call_site in let pp_sinks = pp_elems Sink.call_site in - let original_source = fst (IList.hd sources_passthroughs) in - let final_sink = fst (IList.hd sinks_passthroughs) in + let original_source = fst (List.hd_exn sources_passthroughs) in + let final_sink = fst (List.hd_exn sinks_passthroughs) in F.fprintf fmt "Error: %a -> %a. Full trace:@.%a@.Current procedure %a %a@.%a" diff --git a/infer/src/checkers/annotations.ml b/infer/src/checkers/annotations.ml index 53d16077c..647ccadbe 100644 --- a/infer/src/checkers/annotations.ml +++ b/infer/src/checkers/annotations.ml @@ -86,8 +86,8 @@ let ia_contains ia ann_name = List.exists ~f:(class_name_matches ann_name) ia let ia_get ia ann_name = - try Some (fst (IList.find (class_name_matches ann_name) ia)) - with Not_found -> None + List.find ~f:(class_name_matches ann_name) ia |> + Option.map ~f:fst let pdesc_has_parameter_annot pdesc predicate = let _, param_annotations = (Procdesc.get_attributes pdesc).ProcAttributes.method_annotation in diff --git a/infer/src/checkers/checkDeadCode.ml b/infer/src/checkers/checkDeadCode.ml index 5eb9c82a8..e38429826 100644 --- a/infer/src/checkers/checkDeadCode.ml +++ b/infer/src/checkers/checkDeadCode.ml @@ -75,8 +75,8 @@ let check_final_state tenv proc_name proc_desc final_s = if tot_nodes <> tot_visited then begin let not_visited = - IList.filter - (fun n -> not (Procdesc.NodeSet.mem n (State.get_visited final_s))) + List.filter + ~f:(fun n -> not (Procdesc.NodeSet.mem n (State.get_visited final_s))) proc_nodes in let do_node n = let loc = Procdesc.Node.get_loc n in diff --git a/infer/src/checkers/checkTraceCallSequence.ml b/infer/src/checkers/checkTraceCallSequence.ml index 421b25a0c..cd8aa144e 100644 --- a/infer/src/checkers/checkTraceCallSequence.ml +++ b/infer/src/checkers/checkTraceCallSequence.ml @@ -122,7 +122,7 @@ module State = struct (** Map a function to the elements of the set, and filter out inconsistencies. *) let map2 (f : Elem.t -> Elem.t list) (s : t) : t = let l = ElemSet.elements s in - let l' = IList.filter Elem.is_consistent (IList.flatten (IList.map f l)) in + let l' = List.filter ~f:Elem.is_consistent (List.concat (IList.map f l)) in IList.fold_right ElemSet.add l' ElemSet.empty let map (f : Elem.t -> Elem.t) s = diff --git a/infer/src/checkers/checkers.ml b/infer/src/checkers/checkers.ml index fa1e41d0f..bad9fd681 100644 --- a/infer/src/checkers/checkers.ml +++ b/infer/src/checkers/checkers.ml @@ -220,7 +220,7 @@ let callback_check_write_to_parcel_java match typ with | Typ.Tptr (Tstruct name, _) -> ( match Tenv.lookup tenv name with - | Some { methods } -> IList.filter is_parcel_constructor methods + | Some { methods } -> List.filter ~f:is_parcel_constructor methods | None -> [] ) | _ -> [] in @@ -261,11 +261,11 @@ let callback_check_write_to_parcel_java let r_call_descs = IList.map node_to_call_desc - (IList.filter is_serialization_node + (List.filter ~f:is_serialization_node (Procdesc.get_sliced_slope r_desc is_serialization_node)) in let w_call_descs = IList.map node_to_call_desc - (IList.filter is_serialization_node + (List.filter ~f:is_serialization_node (Procdesc.get_sliced_slope w_desc is_serialization_node)) in let rec check_match = function @@ -332,7 +332,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } = | Typ.Tstruct _ -> true | Typ.Tptr (Typ.Tstruct _, _) -> true | _ -> false in - IList.filter is_class_type formals in + List.filter ~f:is_class_type formals in IList.map fst class_formals) in let equal_formal_param exp formal_name = match exp with | Exp.Lvar pvar -> @@ -368,7 +368,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } = begin let was_not_found formal_name = not (Exp.Set.exists (fun exp -> equal_formal_param exp formal_name) !checks_to_formals) in - let missing = IList.filter was_not_found formal_names in + let missing = List.filter ~f:was_not_found formal_names in let loc = Procdesc.get_loc proc_desc in let pp_file_loc fmt () = F.fprintf fmt "%a:%d" SourceFile.pp loc.Location.file loc.Location.line in @@ -420,18 +420,15 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p let reverse_find_instr f node = (* this is not really sound but for the moment a sufficient approximation *) let has_instr node = - try ignore(IList.find f (Procdesc.Node.get_instrs node)); true - with Not_found -> false in + List.exists ~f (Procdesc.Node.get_instrs node) in let preds = Procdesc.Node.get_generated_slope node (fun n -> Procdesc.Node.get_sliced_preds n has_instr) in let instrs = - IList.flatten + List.concat (IList.map (fun n -> IList.rev (Procdesc.Node.get_instrs n)) preds) in - try - Some (IList.find f instrs) - with Not_found -> None in + List.find ~f instrs in let get_return_const proc_name' = try diff --git a/infer/src/checkers/fragmentRetainsViewChecker.ml b/infer/src/checkers/fragmentRetainsViewChecker.ml index 7e0ddade6..49bbcb4af 100644 --- a/infer/src/checkers/fragmentRetainsViewChecker.ml +++ b/infer/src/checkers/fragmentRetainsViewChecker.ml @@ -39,7 +39,7 @@ let callback_fragment_retains_view_java match Tenv.lookup tenv class_typename with | Some { fields } when AndroidFramework.is_fragment tenv class_typename -> let declared_view_fields = - IList.filter (is_declared_view_typ class_typename) fields in + List.filter ~f:(is_declared_view_typ class_typename) fields in let fields_nullified = PatternMatch.get_fields_nullified proc_desc in (* report if a field is declared by C, but not nulled out in C.onDestroyView *) IList.iter diff --git a/infer/src/checkers/patternMatch.ml b/infer/src/checkers/patternMatch.ml index b2c07103c..22eaa7e2b 100644 --- a/infer/src/checkers/patternMatch.ml +++ b/infer/src/checkers/patternMatch.ml @@ -48,7 +48,7 @@ let rec supertype_find_map_opt tenv f name = | Some ({supers} as struct_typ) -> begin match f name struct_typ with - | None -> IList.find_map_opt (supertype_find_map_opt tenv f) supers + | None -> List.find_map ~f:(supertype_find_map_opt tenv f) supers | result -> result end | None -> @@ -134,9 +134,11 @@ let get_field_type_name tenv | Tstruct name | Tptr (Tstruct name, _) -> ( match Tenv.lookup tenv name with | Some { fields } -> ( - match IList.find (function | (fn, _, _) -> Ident.equal_fieldname fn fieldname) fields with - | _, ft, _ -> Some (get_type_name ft) - | exception Not_found -> None + match List.find + ~f:(function | (fn, _, _) -> Ident.equal_fieldname fn fieldname) + fields with + | Some (_, ft, _) -> Some (get_type_name ft) + | None -> None ) | None -> None ) @@ -405,7 +407,7 @@ let check_current_class_attributes check tenv = function let rec find_superclasses_with_attributes check tenv tname = match Tenv.lookup tenv tname with | Some (struct_typ) -> - let result_from_supers = IList.flatten + let result_from_supers = List.concat (IList.map (find_superclasses_with_attributes check tenv) struct_typ.supers) in if check struct_typ.annots then diff --git a/infer/src/checkers/printfArgs.ml b/infer/src/checkers/printfArgs.ml index ff12f4dc4..3bcf38ea4 100644 --- a/infer/src/checkers/printfArgs.ml +++ b/infer/src/checkers/printfArgs.ml @@ -46,12 +46,9 @@ let add_printf_like_function plf = let printf_like_function (proc_name: Procname.t): printf_signature option = - try - Some ( - IList.find - (fun printf -> String.equal printf.unique_id (Procname.to_unique_id proc_name)) - !printf_like_functions) - with Not_found -> None + List.find + ~f:(fun printf -> String.equal printf.unique_id (Procname.to_unique_id proc_name)) + !printf_like_functions let default_format_type_name (format_type: string): string = diff --git a/infer/src/clang/CType_decl.ml b/infer/src/clang/CType_decl.ml index 7d973a8e7..f125a2cfe 100644 --- a/infer/src/clang/CType_decl.ml +++ b/infer/src/clang/CType_decl.ml @@ -128,7 +128,7 @@ let get_translate_as_friend_decl decl_list = let named_decl_tuple_opt = Clang_ast_proj.get_named_decl_tuple decl in Option.value_map ~f:is_translate_as_friend_name ~default:false named_decl_tuple_opt | None -> false in - match get_friend_decl_opt (IList.find is_translate_as_friend_decl decl_list) with + match get_friend_decl_opt (List.find_exn ~f:is_translate_as_friend_decl decl_list) with | Some (Clang_ast_t.ClassTemplateSpecializationDecl (_, _, _, _, _, _, _, _, [`Type t_ptr])) -> Some t_ptr | _ -> None @@ -150,7 +150,7 @@ let rec get_struct_fields tenv decl = | _ -> [] in let base_decls = get_superclass_decls decl in let base_class_fields = IList.map (get_struct_fields tenv) base_decls in - IList.flatten (base_class_fields @ (IList.map do_one_decl decl_list)) + List.concat (base_class_fields @ (IList.map do_one_decl decl_list)) (* For a record declaration it returns/constructs the type *) and get_record_declaration_type tenv decl = diff --git a/infer/src/clang/ComponentKit.ml b/infer/src/clang/ComponentKit.ml index ad0422260..74d4a7fc2 100644 --- a/infer/src/clang/ComponentKit.ml +++ b/infer/src/clang/ComponentKit.ml @@ -233,14 +233,14 @@ let component_with_multiple_factory_methods_advice context an = let attrs = match decl with | ObjCMethodDecl (decl_info, _, _) -> decl_info.Clang_ast_t.di_attributes | _ -> assert false in - let unavailable_attrs = (IList.filter is_unavailable_attr attrs) in + let unavailable_attrs = (List.filter ~f:is_unavailable_attr attrs) in let is_available = Int.equal (IList.length unavailable_attrs) 0 in (CAst_utils.is_objc_factory_method if_decl decl) && is_available in let check_interface if_decl = match if_decl with | Clang_ast_t.ObjCInterfaceDecl (_, _, decls, _, _) -> - let factory_methods = IList.filter (is_available_factory_method if_decl) decls in + let factory_methods = List.filter ~f:(is_available_factory_method if_decl) decls in CTL.True, IList.map (fun meth_decl -> { CIssue.name = "COMPONENT_WITH_MULTIPLE_FACTORY_METHODS"; severity = Exceptions.Kadvice; @@ -290,7 +290,7 @@ let rec _component_initializer_with_side_effects_advice | Clang_ast_t.DeclRefExpr (_, _, _, decl_ref_expr_info) -> let refs = [decl_ref_expr_info.drti_decl_ref; decl_ref_expr_info.drti_found_decl_ref] in - (match IList.find_map_opt CAst_utils.name_of_decl_ref_opt refs with + (match List.find_map ~f:CAst_utils.name_of_decl_ref_opt refs with | Some "dispatch_after" | Some "dispatch_async" | Some "dispatch_sync" -> diff --git a/infer/src/clang/cFrontend_checkers_main.ml b/infer/src/clang/cFrontend_checkers_main.ml index 4698962c0..9759d69dc 100644 --- a/infer/src/clang/cFrontend_checkers_main.ml +++ b/infer/src/clang/cFrontend_checkers_main.ml @@ -214,7 +214,7 @@ let do_frontend_checks trans_unit_ctx ast = let is_decl_allowed decl = let decl_info = Clang_ast_proj.get_decl_tuple decl in CLocation.should_do_frontend_check trans_unit_ctx decl_info.Clang_ast_t.di_source_range in - let allowed_decls = IList.filter is_decl_allowed decl_list in + let allowed_decls = List.filter ~f:is_decl_allowed decl_list in (* We analyze the top level and then all the allowed declarations *) CFrontend_errors.invoke_set_of_checkers_on_node context (Ctl_parser_types.Decl ast); IList.iter (do_frontend_checks_decl context) allowed_decls; diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index f618c6355..b209b63e1 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -151,7 +151,7 @@ let get_assume_not_null_calls param_decls = decl_info name qt.Clang_ast_t.qt_type_ptr in [(`ClangStmt assume_call)] | _ -> [] in - IList.flatten (IList.map do_one_param param_decls) + List.concat (IList.map do_one_param param_decls) let get_init_list_instrs method_decl_info = let create_custom_instr construct_instr = `CXXConstructorInit construct_instr in diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index 631666465..384e02b29 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -168,10 +168,10 @@ struct (f exps, !insts) let collect_exprs res_trans_list = - IList.flatten (IList.map (fun res_trans -> res_trans.exps) res_trans_list) + List.concat (IList.map (fun res_trans -> res_trans.exps) res_trans_list) let collect_initid_exprs res_trans_list = - IList.flatten (IList.map (fun res_trans -> res_trans.initd_exps) res_trans_list) + List.concat (IList.map (fun res_trans -> res_trans.initd_exps) res_trans_list) (* If e is a block and the calling node has the priority then *) (* we need to release the priority to allow*) @@ -443,7 +443,7 @@ struct let open Clang_ast_t in let decl_info = Clang_ast_proj.get_decl_tuple decl in let get_attr_opt = function DeprecatedAttr a -> Some a | _ -> None in - match IList.find_map_opt get_attr_opt decl_info.di_attributes with + match List.find_map ~f:get_attr_opt decl_info.di_attributes with | Some attribute_info -> (match attribute_info.ai_parameters with | [_; arg; _; _; _; _] -> Some arg @@ -888,7 +888,7 @@ struct Option.value_map ~f:CTrans_models.is_cf_retain_release ~default:false callee_pname_opt in let act_params = - let params = IList.tl (collect_exprs result_trans_subexprs) in + let params = List.tl_exn (collect_exprs result_trans_subexprs) in if Int.equal (IList.length params) (IList.length params_stmt) then params else (Logging.err_debug @@ -929,7 +929,7 @@ struct let sil_loc = CLocation.get_sil_location si context in (* first for method address, second for 'this' expression *) assert (Int.equal (IList.length result_trans_callee.exps) 2); - let (sil_method, _) = IList.hd result_trans_callee.exps in + let (sil_method, _) = List.hd_exn result_trans_callee.exps in let callee_pname = match sil_method with | Exp.Const (Const.Cfun pn) -> pn @@ -944,7 +944,7 @@ struct let res_trans_p = IList.map (instruction' trans_state_param) params_stmt in result_trans_callee :: res_trans_p in (* first expr is method address, rest are params including 'this' parameter *) - let actual_params = IList.tl (collect_exprs result_trans_subexprs) in + let actual_params = List.tl_exn (collect_exprs result_trans_subexprs) in match cxx_method_builtin_trans trans_state_pri sil_loc result_trans_subexprs callee_pname with | Some builtin -> builtin | _ -> diff --git a/infer/src/clang/cTrans_utils.ml b/infer/src/clang/cTrans_utils.ml index ec64554e6..e7664fd23 100644 --- a/infer/src/clang/cTrans_utils.ml +++ b/infer/src/clang/cTrans_utils.ml @@ -723,7 +723,7 @@ let var_or_zero_in_init_list tenv e typ ~return_zero:return_zero = IList.map (fun (fieldname, _, _) -> Exp.Lfield (e, fieldname, typ)) fields in let lh_types = IList.map (fun (_, fieldtype, _) -> fieldtype) fields in let exp_types = zip lh_exprs lh_types in - IList.map (fun (e, t) -> IList.flatten (var_or_zero_in_init_list' e t tns)) exp_types + IList.map (fun (e, t) -> List.concat (var_or_zero_in_init_list' e t tns)) exp_types | None -> assert false ) @@ -737,12 +737,12 @@ let var_or_zero_in_init_list tenv e typ ~return_zero:return_zero = let lh_types = replicate size arrtyp in let exp_types = zip lh_exprs lh_types in IList.map (fun (e, t) -> - IList.flatten (var_or_zero_in_init_list' e t tns)) exp_types + List.concat (var_or_zero_in_init_list' e t tns)) exp_types | Typ.Tint _ | Typ.Tfloat _ | Typ.Tptr _ -> let exp = if return_zero then Sil.zero_value_of_numerical_type typ else e in [ [(exp, typ)] ] | Typ.Tfun _ | Typ.Tvoid | Typ.Tarray _ -> assert false in - IList.flatten (var_or_zero_in_init_list' e typ String.Set.empty) + List.concat (var_or_zero_in_init_list' e typ String.Set.empty) (* (** Similar to extract_item_from_singleton but for option type *) diff --git a/infer/src/eradicate/eradicate.ml b/infer/src/eradicate/eradicate.ml index 539846e80..5ffa99119 100644 --- a/infer/src/eradicate/eradicate.ml +++ b/infer/src/eradicate/eradicate.ml @@ -232,7 +232,7 @@ struct let rec fixpoint initializers_old = let initializers_new = get_private_called initializers_old in let initializers_new' = - IList.filter (fun (pn, _) -> not (Procname.Set.mem pn !seen)) initializers_new in + List.filter ~f:(fun (pn, _) -> not (Procname.Set.mem pn !seen)) initializers_new in mark_seen initializers_new'; if initializers_new' <> [] then fixpoint initializers_new' in diff --git a/infer/src/harness/androidFramework.ml b/infer/src/harness/androidFramework.ml index e75b83ec3..69b2ffd90 100644 --- a/infer/src/harness/androidFramework.ml +++ b/infer/src/harness/androidFramework.ml @@ -88,7 +88,7 @@ let get_lifecycle_for_framework_typ_opt tenv lifecycle_typ lifecycle_proc_strs = | Some { methods } -> (* TODO (t4645631): collect the procedures for which is_java is returning false *) let lookup_proc lifecycle_proc = - IList.find (fun decl_proc -> + List.find_exn ~f:(fun decl_proc -> match decl_proc with | Procname.Java decl_proc_java -> String.equal lifecycle_proc (Procname.java_get_method decl_proc_java) diff --git a/infer/src/harness/inhabit.ml b/infer/src/harness/inhabit.ml index 18a74cd70..34f5a9880 100644 --- a/infer/src/harness/inhabit.ml +++ b/infer/src/harness/inhabit.ml @@ -60,8 +60,8 @@ let create_fresh_local_name () = incr local_name_cntr; "dummy_local" ^ string_of_int !local_name_cntr -(** more forgiving variation of IList.tl that won't raise an exception on the empty list *) -let tl_or_empty l = if List.is_empty l then l else IList.tl l +(** more forgiving variation of List.tl that won't raise an exception on the empty list *) +let tl_or_empty l = if List.is_empty l then l else List.tl_exn l let get_non_receiver_formals formals = tl_or_empty formals @@ -106,7 +106,7 @@ let rec inhabit_typ tenv typ cfg env = && IList.for_all (fun (_, typ) -> not (TypSet.mem typ env.cur_inhabiting) ) (try_get_non_receiver_formals p) in - IList.filter (fun p -> is_suitable_constructor p) methods + List.filter ~f:(fun p -> is_suitable_constructor p) methods | _ -> [] ) | _ -> [] diff --git a/infer/src/integration/CompilationDatabase.ml b/infer/src/integration/CompilationDatabase.ml index a4a4ceab7..c762dbf5d 100644 --- a/infer/src/integration/CompilationDatabase.ml +++ b/infer/src/integration/CompilationDatabase.ml @@ -58,13 +58,13 @@ let decode_json_file (database : t) json_path = | `List arguments -> IList.iter parse_json arguments | `Assoc l -> - let dir = match IList.find_map_opt get_dir l with + let dir = match List.find_map ~f:get_dir l with | Some dir -> dir | None -> exit_format_error () in - let file = match IList.find_map_opt get_file l with + let file = match List.find_map ~f:get_file l with | Some file -> file | None -> exit_format_error () in - let cmd = match IList.find_map_opt get_cmd l with + let cmd = match List.find_map ~f:get_cmd l with | Some cmd -> cmd | None -> exit_format_error () in let command, args = parse_command_and_arguments cmd in diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index 299a575c0..b26878bc8 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -100,20 +100,20 @@ let retrieve_fieldname fieldname = if Int.equal (IList.length subs) 0 then assert false else - IList.hd (IList.rev subs) + List.hd_exn (IList.rev subs) with _ -> assert false let get_field_name program static tenv cn fs = let { StructTyp.fields; statics; } = JTransType.get_class_struct_typ program tenv cn in match - IList.find - (fun (fieldname, _, _) -> String.equal (retrieve_fieldname fieldname) (JBasics.fs_name fs)) + List.find + ~f:(fun (fieldname, _, _) -> String.equal (retrieve_fieldname fieldname) (JBasics.fs_name fs)) (if static then statics else fields) with - | fieldname, _, _ -> + | Some (fieldname, _, _) -> fieldname - | exception Not_found -> + | None -> (* TODO: understand why fields cannot be found here *) L.do_err "cannot find %s.%s@." (JBasics.cn_name cn) (JBasics.fs_name fs); raise (Frontend_error "Cannot find fieldname") diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 0a4498ede..4ac1e5dcb 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -391,14 +391,14 @@ let param_type program tenv cn name vt = let get_var_type_from_sig (context : JContext.t) var = let program = context.program in - try - let tenv = JContext.get_tenv context in - let vt', var' = - IList.find - (fun (_, var') -> JBir.var_equal var var') - (JBir.params context.impl) in - Some (param_type program tenv context.cn var' vt') - with Not_found -> None + let tenv = JContext.get_tenv context in + List.find_map ~f:( + fun (vt', var') -> + if JBir.var_equal var var' + then Some (param_type program tenv context.cn var' vt') + else None + ) + (JBir.params context.impl) let get_var_type context var = diff --git a/infer/src/quandary/JavaTrace.ml b/infer/src/quandary/JavaTrace.ml index a781024b7..f00848abf 100644 --- a/infer/src/quandary/JavaTrace.ml +++ b/infer/src/quandary/JavaTrace.ml @@ -67,11 +67,11 @@ module SourceKind = struct | None -> (* check the list of externally specified sources *) let procedure = class_name ^ "." ^ method_name in - IList.find_map_opt - (fun (source_spec : QuandaryConfig.Source.t) -> - if Str.string_match source_spec.procedure procedure 0 - then Some (of_string source_spec.kind) - else None) + List.find_map + ~f:(fun (source_spec : QuandaryConfig.Source.t) -> + if Str.string_match source_spec.procedure procedure 0 + then Some (of_string source_spec.kind) + else None) external_sources end end @@ -156,7 +156,7 @@ module SinkKind = struct let actuals_to_taint, offset = if Procname.java_is_static pname || taint_this then actuals, 0 - else IList.tl actuals, 1 in + else List.tl_exn actuals, 1 in IList.mapi (fun param_num _ -> kind, param_num + offset, report_reachable) actuals_to_taint in @@ -236,19 +236,19 @@ module SinkKind = struct | class_name, method_name -> (* check the list of externally specified sinks *) let procedure = class_name ^ "." ^ method_name in - IList.find_map_opt - (fun (sink_spec : QuandaryConfig.Sink.t) -> - if Str.string_match sink_spec.procedure procedure 0 - then - let kind = of_string sink_spec.kind in - try - let n = int_of_string sink_spec.index in - Some (taint_nth n kind ~report_reachable:true) - with Failure _ -> - (* couldn't parse the index, just taint everything *) - Some (taint_all kind ~report_reachable:true) - else - None) + List.find_map + ~f:(fun (sink_spec : QuandaryConfig.Sink.t) -> + if Str.string_match sink_spec.procedure procedure 0 + then + let kind = of_string sink_spec.kind in + try + let n = int_of_string sink_spec.index in + Some (taint_nth n kind ~report_reachable:true) + with Failure _ -> + (* couldn't parse the index, just taint everything *) + Some (taint_all kind ~report_reachable:true) + else + None) external_sinks in begin match diff --git a/infer/src/quandary/TaintAnalysis.ml b/infer/src/quandary/TaintAnalysis.ml index 257c0aa08..03fd666ec 100644 --- a/infer/src/quandary/TaintAnalysis.ml +++ b/infer/src/quandary/TaintAnalysis.ml @@ -168,8 +168,8 @@ module Make (TaintSpecification : TaintSpec.S) = struct TraceDomain.empty in let pp_path_short fmt (_, sources_passthroughs, sinks_passthroughs) = - let original_source = fst (IList.hd sources_passthroughs) in - let final_sink = fst (IList.hd sinks_passthroughs) in + let original_source = fst (List.hd_exn sources_passthroughs) in + let final_sink = fst (List.hd_exn sinks_passthroughs) in F.fprintf fmt "%a -> %a" diff --git a/infer/src/unit/schedulerTests.ml b/infer/src/unit/schedulerTests.ml index 52adb679c..600481834 100644 --- a/infer/src/unit/schedulerTests.ml +++ b/infer/src/unit/schedulerTests.ml @@ -39,19 +39,17 @@ module MockProcCfg = struct let equal_id = Int.equal let succs t n = - try - let node_id = id n in - IList.find - (fun (node, _) -> equal_id (id node) node_id) - t - |> snd - with Not_found -> [] + let node_id = id n in + List.find + ~f:(fun (node, _) -> equal_id (id node) node_id) + t |> + Option.value_map ~f:snd ~default:[] let preds t n = try let node_id = id n in - IList.filter - (fun (_, succs) -> + List.filter + ~f:(fun (_, succs) -> List.exists ~f:(fun node -> equal_id (id node) node_id) succs) t |> IList.map fst