From 7d0a7568f3187db5093318c82729c5f64f6807ef Mon Sep 17 00:00:00 2001 From: Jules Villard Date: Mon, 19 Oct 2015 09:55:12 -0700 Subject: [PATCH] put Util.list_* functions into an IList module Summary: public modules are better for namespacing. How I made this diff: 1. moved list_* functions from utils.ml{,i} to iList.ml{,i} 2. shell commands: grep '^val ' infer/src/backend/iList.mli | cut -f 2 -d ' ' | tr '\n' ' ' # gives a list of former list_ functions that IList implements, fed into the loops below: LISTNAMES=" compare equal append combine exists filter flatten flatten_options find fold_left fold_left2 for_all for_all2 hd iter iter2 length fold_right map mem nth partition rev rev_append rev_map sort split stable_sort tl drop_first drop_last rev_with_acc remove_duplicates remove_irrelevant_duplicates merge_sorted_nodup intersect mem_assoc assoc map2 to_string" # replace " list_*" function calls with IList.* ones for i in $LISTNAMES; do find . -name '*.ml' -exec sed -i -e "s/ list_$i\b/ IList.$i/g" \{\} \; ; done # replace (list_* functions with (IList.* ones for i in $LISTNAMES; do find . -name '*.ml' -exec sed -i -e "s/(list_$i\b/(IList.$i/g" \{\} \; ; done # ditto with [ for i in $LISTNAMES; do find . -name '*.ml' -exec sed -i -e "s/\[list_$i\b/[IList.$i/g" \{\} \; ; done 3. Then fix up the rest by hand. In particular, stuff that called Utils.list_* explicitely, and stuff that used the "Fail" exception that has moved to IList. (may revisit this in the future) Reviewed By: jeremydubreil, cristianoc Differential Revision: D2550241 fb-gh-sync-id: cd64b10 --- infer/src/backend/DB.ml | 12 +- infer/src/backend/abs.ml | 226 +++++++------- infer/src/backend/absarray.ml | 98 +++--- infer/src/backend/autounit.ml | 48 +-- infer/src/backend/buckets.ml | 12 +- infer/src/backend/callbacks.ml | 42 ++- infer/src/backend/cfg.ml | 116 +++---- infer/src/backend/cg.ml | 34 +- infer/src/backend/cluster.ml | 24 +- infer/src/backend/clusterMakefile.ml | 6 +- infer/src/backend/dom.ml | 308 +++++++++--------- infer/src/backend/dotty.ml | 136 ++++---- infer/src/backend/errdesc.ml | 60 ++-- infer/src/backend/errlog.ml | 2 +- infer/src/backend/exe_env.ml | 2 +- infer/src/backend/fork.ml | 14 +- infer/src/backend/iList.ml | 182 +++++++++++ infer/src/backend/iList.mli | 96 ++++++ infer/src/backend/ident.ml | 4 +- infer/src/backend/inferanalyze.ml | 88 +++--- infer/src/backend/inferconfig.ml | 34 +- infer/src/backend/inferprint.ml | 58 ++-- infer/src/backend/interproc.ml | 132 ++++---- infer/src/backend/io_infer.ml | 10 +- infer/src/backend/localise.ml | 14 +- infer/src/backend/match.ml | 86 ++--- infer/src/backend/mleak_buckets.ml | 12 +- infer/src/backend/objc_models.ml | 8 +- infer/src/backend/objc_preanal.ml | 6 +- infer/src/backend/paths.ml | 20 +- infer/src/backend/preanal.ml | 60 ++-- infer/src/backend/printer.ml | 54 ++-- infer/src/backend/procname.ml | 10 +- infer/src/backend/prop.ml | 346 ++++++++++----------- infer/src/backend/propgraph.ml | 18 +- infer/src/backend/propset.ml | 14 +- infer/src/backend/prover.ml | 144 ++++----- infer/src/backend/rearrange.ml | 112 +++---- infer/src/backend/sil.ml | 259 ++++++++------- infer/src/backend/specs.ml | 42 +-- infer/src/backend/state.ml | 22 +- infer/src/backend/symExec.ml | 221 +++++++------ infer/src/backend/tabulation.ml | 180 +++++------ infer/src/backend/type_prop.ml | 36 +-- infer/src/backend/utils.ml | 211 ++----------- infer/src/backend/utils.mli | 95 +----- infer/src/checkers/annotations.ml | 20 +- infer/src/checkers/callbackChecker.ml | 10 +- infer/src/checkers/checkDeadCode.ml | 6 +- infer/src/checkers/checkers.ml | 34 +- infer/src/checkers/codeQuery.ml | 6 +- infer/src/checkers/constantPropagation.ml | 4 +- infer/src/checkers/dataflow.ml | 14 +- infer/src/checkers/eradicate.ml | 24 +- infer/src/checkers/eradicateChecks.ml | 16 +- infer/src/checkers/immutableChecker.ml | 2 +- infer/src/checkers/modelTables.ml | 4 +- infer/src/checkers/models.ml | 2 +- infer/src/checkers/patternMatch.ml | 42 +-- infer/src/checkers/printfArgs.ml | 18 +- infer/src/checkers/registerCheckers.ml | 8 +- infer/src/checkers/repeatedCallsChecker.ml | 6 +- infer/src/checkers/sqlChecker.ml | 4 +- infer/src/checkers/typeCheck.ml | 26 +- infer/src/checkers/typeState.ml | 4 +- infer/src/clang/ast_expressions.ml | 2 +- infer/src/clang/cAstProcessor.ml | 26 +- infer/src/clang/cContext.ml | 4 +- infer/src/clang/cField_decl.ml | 6 +- infer/src/clang/cFrontend.ml | 8 +- infer/src/clang/cFrontend_utils.ml | 22 +- infer/src/clang/cLocation.ml | 4 +- infer/src/clang/cMethod_decl.ml | 6 +- infer/src/clang/cMethod_signature.ml | 2 +- infer/src/clang/cMethod_trans.ml | 14 +- infer/src/clang/cTrans.ml | 164 +++++----- infer/src/clang/cTrans_utils.ml | 16 +- infer/src/clang/cTypes.ml | 2 +- infer/src/clang/cTypes_decl.ml | 10 +- infer/src/clang/cVar_decl.ml | 2 +- infer/src/clang/objcInterface_decl.ml | 10 +- infer/src/clang/objcProperty_decl.ml | 16 +- infer/src/harness/androidFramework.ml | 18 +- infer/src/harness/harness.ml | 18 +- infer/src/harness/inhabit.ml | 28 +- infer/src/harness/stacktrace.ml | 12 +- infer/src/java/jAnnotation.ml | 6 +- infer/src/java/jClasspath.ml | 20 +- infer/src/java/jFrontend.ml | 4 +- infer/src/java/jMain.ml | 2 +- infer/src/java/jTrans.ml | 38 +-- infer/src/java/jTransType.ml | 16 +- infer/src/llvm/lParser.mly | 6 +- infer/src/llvm/lTrans.ml | 14 +- infer/src/scripts/checkCopyright.ml | 10 +- 95 files changed, 2235 insertions(+), 2235 deletions(-) create mode 100644 infer/src/backend/iList.ml create mode 100644 infer/src/backend/iList.mli diff --git a/infer/src/backend/DB.ml b/infer/src/backend/DB.ml index 615cd216e..3bb5eb59e 100644 --- a/infer/src/backend/DB.ml +++ b/infer/src/backend/DB.ml @@ -141,15 +141,15 @@ let find_source_dirs () = let files_in_results_dir = Array.to_list (Sys.readdir capt_dir) in let add_cg_files_from_dir dir = let files = Array.to_list (Sys.readdir dir) in - list_iter (fun fname -> + IList.iter (fun fname -> let path = Filename.concat dir fname in if Filename.check_suffix path ".cg" then source_dirs := dir :: !source_dirs) files in - list_iter (fun fname -> + IList.iter (fun fname -> let dir = Filename.concat capt_dir fname in if Sys.is_directory dir then add_cg_files_from_dir dir) files_in_results_dir; - list_rev !source_dirs + IList.rev !source_dirs (** {2 Filename} *) @@ -273,7 +273,7 @@ module Results_dir = struct | [] -> base | name:: names -> Filename.concat (f names) (if name ==".." then Filename.parent_dir_name else name) in - f (list_rev path) + f (IList.rev path) (** convert a path to a filename *) let path_to_filename pk path = @@ -315,7 +315,7 @@ module Results_dir = struct let new_path = Filename.concat (create names) name in create_dir new_path; new_path in - let filename, dir_path = match list_rev path with + let filename, dir_path = match IList.rev path with | filename:: dir_path -> filename, dir_path | [] -> raise (Failure "create_path") in let full_fname = Filename.concat (create dir_path) filename in @@ -327,6 +327,6 @@ let global_tenv_fname () = filename_concat (captured_dir ()) basename let is_source_file path = - list_exists + IList.exists (fun ext -> Filename.check_suffix path ext) Config.source_file_extentions diff --git a/infer/src/backend/abs.ml b/infer/src/backend/abs.ml index 744a53bd7..a060b317e 100644 --- a/infer/src/backend/abs.ml +++ b/infer/src/backend/abs.ml @@ -32,7 +32,7 @@ let sigma_rewrite p r : Prop.normal Prop.t option = else let res_pi = r.r_new_pi p p_leftover sub in let res_sigma = Prop.sigma_sub sub r.r_new_sigma in - let p_with_res_pi = list_fold_left Prop.prop_atom_and p_leftover res_pi in + let p_with_res_pi = IList.fold_left Prop.prop_atom_and p_leftover res_pi in let p_new = Prop.prop_sigma_star p_with_res_pi res_sigma in Some (Prop.normalize p_new) @@ -53,42 +53,42 @@ let create_fresh_primeds_ls para = let ids_shared = let svars = para.Sil.svars in let f id = Ident.create_fresh Ident.kprimed in - list_map f svars in + IList.map f svars in let ids_tuple = (id_base, id_next, id_end, ids_shared) in let exp_base = Sil.Var id_base in let exp_next = Sil.Var id_next in let exp_end = Sil.Var id_end in - let exps_shared = list_map (fun id -> Sil.Var id) ids_shared in + let exps_shared = IList.map (fun id -> Sil.Var id) ids_shared in let exps_tuple = (exp_base, exp_next, exp_end, exps_shared) in (ids_tuple, exps_tuple) let create_condition_ls ids_private id_base p_leftover (inst: Sil.subst) = let (insts_of_private_ids, insts_of_public_ids, inst_of_base) = - let f id' = list_exists (fun id'' -> Ident.equal id' id'') ids_private in + let f id' = IList.exists (fun id'' -> Ident.equal id' id'') ids_private in let (inst_private, inst_public) = Sil.sub_domain_partition f inst in let insts_of_public_ids = Sil.sub_range inst_public in let inst_of_base = try Sil.sub_find (Ident.equal id_base) inst_public with Not_found -> assert false in 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 = list_flatten (list_map Sil.exp_fav_list insts_of_public_ids) in - let fav_insts_of_private_ids = list_flatten (list_map Sil.exp_fav_list insts_of_private_ids) 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_p_leftover, fav_in_pvars) = let sigma = Prop.get_sigma p_leftover 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 = list_flatten (list_map Sil.exp_fpv insts_of_private_ids) in + let fpv_insts_of_private_ids = IList.flatten (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@."; L.out "@[<4> private ids : %a@\n@." pp_exp_list insts_of_private_ids; L.out "@[<4> public ids : %a@\n@." pp_exp_list insts_of_public_ids; *) - (* (not (list_intersect compare fav_inst_of_base fav_in_pvars)) && *) + (* (not (IList.intersect compare fav_inst_of_base fav_in_pvars)) && *) (fpv_inst_of_base = []) && (fpv_insts_of_private_ids = []) && - (not (list_exists Ident.is_normal fav_insts_of_private_ids)) && - (not (Utils.list_intersect Ident.compare fav_insts_of_private_ids fav_p_leftover)) && - (not (Utils.list_intersect Ident.compare fav_insts_of_private_ids fav_insts_of_public_ids)) + (not (IList.exists Ident.is_normal fav_insts_of_private_ids)) && + (not (IList.intersect Ident.compare fav_insts_of_private_ids fav_p_leftover)) && + (not (IList.intersect Ident.compare fav_insts_of_private_ids fav_insts_of_public_ids)) let mk_rule_ptspts_ls impl_ok1 impl_ok2 (para: Sil.hpara) = let (ids_tuple, exps_tuple) = create_fresh_primeds_ls para in @@ -101,12 +101,12 @@ let mk_rule_ptspts_ls impl_ok1 impl_ok2 (para: Sil.hpara) = | [] -> L.out "@.@.ERROR (Empty Para): %a @.@." (Sil.pp_hpara pe_text) para; assert false | hpred :: hpreds -> let hpat = mark_impl_flag hpred in - let hpats = list_map mark_impl_flag hpreds in + let hpats = IList.map mark_impl_flag hpreds in (hpat, hpats) in let (ids_exist_snd, para_snd) = let mark_impl_flag hpred = { Match.hpred = hpred; Match.flag = impl_ok2 } in let (ids, para_body) = Sil.hpara_instantiate para exp_next exp_end exps_shared in - let para_body_hpats = list_map mark_impl_flag para_body in + let para_body_hpats = IList.map mark_impl_flag para_body in (ids, para_body_hpats) in let lseg_res = Prop.mk_lseg Sil.Lseg_NE para exp_base exp_end exps_shared in let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] in @@ -130,7 +130,7 @@ let mk_rule_ptsls_ls k2 impl_ok1 impl_ok2 para = | [] -> L.out "@.@.ERROR (Empty Para): %a @.@." (Sil.pp_hpara pe_text) para; assert false | hpred :: hpreds -> let allow_impl hpred = { Match.hpred = hpred; Match.flag = impl_ok1 } in - (allow_impl hpred, list_map allow_impl hpreds) in + (allow_impl hpred, IList.map allow_impl hpreds) in let lseg_pat = { Match.hpred = Prop.mk_lseg k2 para exp_next exp_end exps_shared; Match.flag = impl_ok2 } in let lseg_res = Prop.mk_lseg Sil.Lseg_NE para exp_base exp_end exps_shared in let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] in @@ -152,7 +152,7 @@ let mk_rule_lspts_ls k1 impl_ok1 impl_ok2 para = let (ids_exist, para_inst_pat) = let (ids, para_body) = Sil.hpara_instantiate para exp_next exp_end exps_shared in let allow_impl hpred = { Match.hpred = hpred; Match.flag = impl_ok2 } in - let para_body_pat = list_map allow_impl para_body in + let para_body_pat = IList.map allow_impl para_body in (ids, para_body_pat) in let lseg_res = Prop.mk_lseg Sil.Lseg_NE para exp_base exp_end exps_shared in let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] in @@ -241,12 +241,12 @@ let mk_rule_ptspts_dll impl_ok1 impl_ok2 para = let ids_shared = let svars = para.Sil.svars_dll in let f id = Ident.create_fresh Ident.kprimed in - list_map f svars in + IList.map f svars in let exp_iF = Sil.Var id_iF in let exp_iF' = Sil.Var id_iF' in let exp_oB = Sil.Var id_oB in let exp_oF = Sil.Var id_oF in - let exps_shared = list_map (fun id -> Sil.Var id) ids_shared in + let exps_shared = IList.map (fun id -> Sil.Var id) ids_shared in let (ids_exist_fst, para_fst) = Sil.hpara_dll_instantiate para exp_iF exp_oB exp_iF' exps_shared in let (para_fst_start, para_fst_rest) = let mark_impl_flag hpred = { Match.hpred = hpred; Match.flag = impl_ok1 } in @@ -254,12 +254,12 @@ let mk_rule_ptspts_dll impl_ok1 impl_ok2 para = | [] -> L.out "@.@.ERROR (Empty DLL para): %a@.@." (Sil.pp_hpara_dll pe_text) para; assert false | hpred :: hpreds -> let hpat = mark_impl_flag hpred in - let hpats = list_map mark_impl_flag hpreds in + let hpats = IList.map mark_impl_flag hpreds in (hpat, hpats) in let (ids_exist_snd, para_snd) = let mark_impl_flag hpred = { Match.hpred = hpred; Match.flag = impl_ok2 } in let (ids, para_body) = Sil.hpara_dll_instantiate para exp_iF' exp_iF exp_oF exps_shared in - let para_body_hpats = list_map mark_impl_flag para_body in + let para_body_hpats = IList.map mark_impl_flag para_body in (ids, para_body_hpats) in let dllseg_res = Prop.mk_dllseg Sil.Lseg_NE para exp_iF exp_oB exp_oF exp_iF' exps_shared in let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] in @@ -289,20 +289,20 @@ let mk_rule_ptsdll_dll k2 impl_ok1 impl_ok2 para = let ids_shared = let svars = para.Sil.svars_dll in let f id = Ident.create_fresh Ident.kprimed in - list_map f svars in + IList.map f svars in let exp_iF = Sil.Var id_iF in let exp_iF' = Sil.Var id_iF' in let exp_oB = Sil.Var id_oB in let exp_oF = Sil.Var id_oF in let exp_iB = Sil.Var id_iB in - let exps_shared = list_map (fun id -> Sil.Var id) ids_shared in + let exps_shared = IList.map (fun id -> Sil.Var id) ids_shared in let (ids_exist, para_inst) = Sil.hpara_dll_instantiate para exp_iF exp_oB exp_iF' exps_shared in let (para_inst_start, para_inst_rest) = match para_inst with | [] -> assert false | hpred :: hpreds -> let allow_impl hpred = { Match.hpred = hpred; Match.flag = impl_ok1 } in - (allow_impl hpred, list_map allow_impl hpreds) in + (allow_impl hpred, IList.map allow_impl hpreds) in let dllseg_pat = { Match.hpred = Prop.mk_dllseg k2 para exp_iF' exp_iF exp_oF exp_iB exps_shared; Match.flag = impl_ok2 } in let dllseg_res = Prop.mk_dllseg Sil.Lseg_NE para exp_iF exp_oB exp_oF exp_iB exps_shared in let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] in @@ -325,17 +325,17 @@ let mk_rule_dllpts_dll k1 impl_ok1 impl_ok2 para = let ids_shared = let svars = para.Sil.svars_dll in let f id = Ident.create_fresh Ident.kprimed in - list_map f svars in + IList.map f svars in let exp_iF = Sil.Var id_iF in let exp_iF' = Sil.Var id_iF' in let exp_oB = Sil.Var id_oB in let exp_oB' = Sil.Var id_oB' in let exp_oF = Sil.Var id_oF in - let exps_shared = list_map (fun id -> Sil.Var id) ids_shared in + let exps_shared = IList.map (fun id -> Sil.Var id) ids_shared in let (ids_exist, para_inst) = Sil.hpara_dll_instantiate para exp_iF' exp_oB' exp_oF exps_shared in let para_inst_pat = let allow_impl hpred = { Match.hpred = hpred; Match.flag = impl_ok2 } in - list_map allow_impl para_inst in + IList.map allow_impl para_inst in let dllseg_pat = { Match.hpred = Prop.mk_dllseg k1 para exp_iF exp_oB exp_iF' exp_oB' exps_shared; Match.flag = impl_ok1 } in let dllseg_res = Prop.mk_dllseg Sil.Lseg_NE para exp_iF exp_oB exp_oF exp_iF' exps_shared in let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] in @@ -359,14 +359,14 @@ let mk_rule_dlldll_dll k1 k2 impl_ok1 impl_ok2 para = let ids_shared = let svars = para.Sil.svars_dll in let f id = Ident.create_fresh Ident.kprimed in - list_map f svars in + IList.map f svars in let exp_iF = Sil.Var id_iF in let exp_iF' = Sil.Var id_iF' in let exp_oB = Sil.Var id_oB in let exp_oB' = Sil.Var id_oB' in let exp_oF = Sil.Var id_oF in let exp_iB = Sil.Var id_iB in - let exps_shared = list_map (fun id -> Sil.Var id) ids_shared in + let exps_shared = IList.map (fun id -> Sil.Var id) ids_shared in let lseg_fst_pat = { Match.hpred = Prop.mk_dllseg k1 para exp_iF exp_oB exp_iF' exp_oB' exps_shared; Match.flag = impl_ok1 } in let lseg_snd_pat = { Match.hpred = Prop.mk_dllseg k2 para exp_iF' exp_oB' exp_oF exp_iB exps_shared; Match.flag = impl_ok2 } in let k_res = lseg_kind_add k1 k2 in @@ -423,7 +423,7 @@ let typ_get_recursive_flds tenv te = (match typ with | Sil.Tvar _ -> assert false (* there should be no indirection *) | Sil.Tint _ | Sil.Tvoid | Sil.Tfun _ | Sil.Tptr _ | Sil.Tfloat _ | Sil.Tenum _ -> [] - | Sil.Tstruct (fld_typ_ann_list, _, _, _, _, _, _) -> list_map (fun (x, y, z) -> x) (list_filter filter fld_typ_ann_list) + | Sil.Tstruct (fld_typ_ann_list, _, _, _, _, _, _) -> IList.map (fun (x, y, z) -> x) (IList.filter filter fld_typ_ann_list) | Sil.Tarray _ -> []) | Sil.Var _ -> [] (* type of |-> not known yet *) | Sil.Const _ -> [] @@ -467,16 +467,16 @@ let discover_para_candidates tenv p = let edges = ref [] in let add_edge edg = edges := edg :: !edges in let get_edges_strexp rec_flds root se = - let is_rec_fld fld = list_exists (Sil.fld_equal fld) rec_flds in + let is_rec_fld fld = IList.exists (Sil.fld_equal fld) rec_flds in match se with | Sil.Eexp _ | Sil.Earray _ -> () | Sil.Estruct (fsel, _) -> - let fsel' = list_filter (fun (fld, _) -> is_rec_fld fld) fsel in + let fsel' = IList.filter (fun (fld, _) -> is_rec_fld fld) fsel in let process (_, nextse) = match nextse with | Sil.Eexp (next, inst) -> add_edge (root, next) | _ -> assert false in - list_iter process fsel' in + IList.iter process fsel' in let rec get_edges_sigma = function | [] -> () | Sil.Hlseg _ :: sigma_rest | Sil.Hdllseg _ :: sigma_rest -> @@ -486,13 +486,13 @@ let discover_para_candidates tenv p = get_edges_strexp rec_flds root se; get_edges_sigma sigma_rest in let rec find_all_consecutive_edges found edges_seen = function - | [] -> list_rev found + | [] -> IList.rev found | (e1, e2) :: edges_notseen -> - let edges_others = (list_rev edges_seen) @ edges_notseen in - let edges_matched = list_filter (fun (e1', _) -> Sil.exp_equal e2 e1') edges_others in + let edges_others = (IList.rev edges_seen) @ edges_notseen in + let edges_matched = IList.filter (fun (e1', _) -> Sil.exp_equal e2 e1') edges_others in let new_found = let f found_acc (_, e3) = (e1, e2, e3) :: found_acc in - list_fold_left f found edges_matched in + IList.fold_left f found edges_matched in let new_edges_seen = (e1, e2) :: edges_seen in find_all_consecutive_edges new_found new_edges_seen edges_notseen in let sigma = Prop.get_sigma p in @@ -503,19 +503,19 @@ let discover_para_dll_candidates tenv p = let edges = ref [] in let add_edge edg = (edges := edg :: !edges) in let get_edges_strexp rec_flds root se = - let is_rec_fld fld = list_exists (Sil.fld_equal fld) rec_flds in + let is_rec_fld fld = IList.exists (Sil.fld_equal fld) rec_flds in match se with | Sil.Eexp _ | Sil.Earray _ -> () | Sil.Estruct (fsel, _) -> - let fsel' = list_filter (fun (fld, _) -> is_rec_fld fld) fsel in + let fsel' = IList.filter (fun (fld, _) -> is_rec_fld fld) fsel in let convert_to_exp acc (_, se) = match se with | Sil.Eexp (e, inst) -> e:: acc | _ -> assert false in - let links = list_rev (list_fold_left convert_to_exp [] fsel') in + let links = IList.rev (IList.fold_left convert_to_exp [] fsel') in let rec iter_pairs = function | [] -> () - | x:: l -> (list_iter (fun y -> add_edge (root, x, y)) l; iter_pairs l) in + | x:: l -> (IList.iter (fun y -> add_edge (root, x, y)) l; iter_pairs l) in iter_pairs links in let rec get_edges_sigma = function | [] -> () @@ -526,13 +526,13 @@ let discover_para_dll_candidates tenv p = get_edges_strexp rec_flds root se; get_edges_sigma sigma_rest in let rec find_all_consecutive_edges found edges_seen = function - | [] -> list_rev found + | [] -> IList.rev found | (iF, blink, flink) :: edges_notseen -> - let edges_others = (list_rev edges_seen) @ edges_notseen in - let edges_matched = list_filter (fun (e1', _, _) -> Sil.exp_equal flink e1') edges_others in + let edges_others = (IList.rev edges_seen) @ edges_notseen in + let edges_matched = IList.filter (fun (e1', _, _) -> Sil.exp_equal flink e1') edges_others in let new_found = let f found_acc (_, _, flink2) = (iF, blink, flink, flink2) :: found_acc in - list_fold_left f found edges_matched in + IList.fold_left f found edges_matched in let new_edges_seen = (iF, blink, flink) :: edges_seen in find_all_consecutive_edges new_found new_edges_seen edges_notseen in let sigma = Prop.get_sigma p in @@ -542,12 +542,12 @@ let discover_para_dll_candidates tenv p = let discover_para tenv p = let candidates = discover_para_candidates tenv p in let already_defined para paras = - list_exists (fun para' -> Match.hpara_iso para para') paras in + IList.exists (fun para' -> Match.hpara_iso para para') paras in let f paras (root, next, out) = match (discover_para_roots p root next next out) with | None -> paras | Some para -> if already_defined para paras then paras else para :: paras in - list_fold_left f [] candidates + IList.fold_left f [] candidates let discover_para_dll tenv p = (* @@ -556,12 +556,12 @@ let discover_para_dll tenv p = *) let candidates = discover_para_dll_candidates tenv p in let already_defined para paras = - list_exists (fun para' -> Match.hpara_dll_iso para para') paras in + IList.exists (fun para' -> Match.hpara_dll_iso para para') paras in let f paras (iF, oB, iF', oF) = match (discover_para_dll_roots p iF oB iF' iF' iF oF) with | None -> paras | Some para -> if already_defined para paras then paras else para :: paras in - list_fold_left f [] candidates + IList.fold_left f [] candidates (****************** Start of Predicate Discovery ******************) (****************** Start of the ADT abs_rules ******************) @@ -572,12 +572,12 @@ type rule_set = para_ty * rule list type abs_rules = { mutable ar_default : rule_set list } let eqs_sub subst eqs = - list_map (fun (e1, e2) -> (Sil.exp_sub subst e1, Sil.exp_sub subst e2)) eqs + IList.map (fun (e1, e2) -> (Sil.exp_sub subst e1, Sil.exp_sub subst e2)) eqs let eqs_solve ids_in eqs_in = let rec solve (sub: Sil.subst) (eqs: (Sil.exp * Sil.exp) list) : Sil.subst option = let do_default id e eqs_rest = - if not (list_exists (fun id' -> Ident.equal id id') ids_in) then None + if not (IList.exists (fun id' -> Ident.equal id id') ids_in) then None else let sub' = match Sil.extend_sub sub id e with | None -> L.out "@.@.ERROR : Buggy Implementation.@.@."; assert false @@ -602,10 +602,10 @@ let eqs_solve ids_in eqs_in = | _ :: _ -> None in let compute_ids sub = let sub_list = Sil.sub_to_list sub in - let sub_dom = list_map fst sub_list in + let sub_dom = IList.map fst sub_list in let filter id = - not (list_exists (fun id' -> Ident.equal id id') sub_dom) in - list_filter filter ids_in in + not (IList.exists (fun id' -> Ident.equal id id') sub_dom) in + IList.filter filter ids_in in match solve Sil.sub_empty eqs_in with | None -> None | Some sub -> Some (compute_ids sub, sub) @@ -613,7 +613,7 @@ let eqs_solve ids_in eqs_in = let sigma_special_cases_eqs sigma = let rec f ids_acc eqs_acc sigma_acc = function | [] -> - [(list_rev ids_acc, list_rev eqs_acc, list_rev sigma_acc)] + [(IList.rev ids_acc, IList.rev eqs_acc, IList.rev sigma_acc)] | Sil.Hpointsto _ as hpred :: sigma_rest -> f ids_acc eqs_acc (hpred:: sigma_acc) sigma_rest | Sil.Hlseg(k, para, e1, e2, es) as hpred :: sigma_rest -> @@ -644,19 +644,19 @@ let sigma_special_cases ids sigma : (Ident.t list * Sil.hpred list) list = match (eqs_solve ids_all eqs_cur) with | None -> acc | Some (ids_res, sub) -> - (ids_res, list_map (Sil.hpred_sub sub) sigma_cur) :: acc in - list_fold_left f [] special_cases_eqs in - list_rev special_cases_rev + (ids_res, IList.map (Sil.hpred_sub sub) sigma_cur) :: acc in + IList.fold_left f [] special_cases_eqs in + IList.rev special_cases_rev let hpara_special_cases hpara : Sil.hpara list = let update_para (evars', body') = { hpara with Sil.evars = evars'; Sil.body = body'} in let special_cases = sigma_special_cases hpara.Sil.evars hpara.Sil.body in - list_map update_para special_cases + IList.map update_para special_cases let hpara_special_cases_dll hpara : Sil.hpara_dll list = let update_para (evars', body') = { hpara with Sil.evars_dll = evars'; Sil.body_dll = body'} in let special_cases = sigma_special_cases hpara.Sil.evars_dll hpara.Sil.body_dll in - list_map update_para special_cases + IList.map update_para special_cases let abs_rules : abs_rules = { ar_default = [] } @@ -694,9 +694,9 @@ let abs_rules_apply_rsets (rsets: rule_set list) (p_in: Prop.normal Prop.t) : Pr (true, p') in let rec apply_rule_set p rset = let (_, rules) = rset in - let (changed, p') = list_fold_left apply_rule (false, p) rules in + let (changed, p') = IList.fold_left apply_rule (false, p) rules in if changed then apply_rule_set p' rset else p' in - list_fold_left apply_rule_set p_in rsets + IList.fold_left apply_rule_set p_in rsets let abs_rules_apply_lists tenv (p_in: Prop.normal Prop.t) : Prop.normal Prop.t = let new_rsets = ref [] in @@ -705,16 +705,16 @@ 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 = list_flatten (list_map hpara_special_cases paras_sll) in - let closed_paras_dll = list_flatten (list_map hpara_special_cases_dll paras_dll) 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 begin (* - if list_length closed_paras_sll >= 1 then + if IList.length closed_paras_sll >= 1 then begin L.out "@.... discovered predicates ....@."; L.out "@[<4> pred : %a@\n@." pp_hpara_list closed_paras_sll; end - if list_length closed_paras_dll >= 1 then + if IList.length closed_paras_dll >= 1 then begin L.out "@.... discovered predicates ....@."; L.out "@[<4> pred : %a@\n@." pp_hpara_dll_list closed_paras_dll; @@ -726,15 +726,15 @@ let abs_rules_apply_lists tenv (p_in: Prop.normal Prop.t) : Prop.normal Prop.t = let eq_sll para = function (SLL para', _) -> Match.hpara_iso para para' | _ -> false in let eq_dll para = function (DLL para', _) -> Match.hpara_dll_iso para para' | _ -> false in let filter_sll para = - not (list_exists (eq_sll para) def_rsets) && not (list_exists (eq_sll para) !new_rsets) in + not (IList.exists (eq_sll para) def_rsets) && not (IList.exists (eq_sll para) !new_rsets) in let filter_dll para = - not (list_exists (eq_dll para) def_rsets) && not (list_exists (eq_dll para) !new_rsets) in - let todo_paras_sll = list_filter filter_sll closed_paras_sll in - let todo_paras_dll = list_filter filter_dll closed_paras_dll in + not (IList.exists (eq_dll para) def_rsets) && not (IList.exists (eq_dll para) !new_rsets) in + let todo_paras_sll = IList.filter filter_sll closed_paras_sll in + let todo_paras_dll = IList.filter filter_dll closed_paras_dll in (todo_paras_sll, todo_paras_dll) in let f_recurse () = - let todo_rsets_sll = list_map (fun para -> (SLL para, mk_rules_for_sll para)) todo_paras_sll in - let todo_rsets_dll = list_map (fun para -> (DLL para, mk_rules_for_dll para)) todo_paras_dll in + let todo_rsets_sll = IList.map (fun para -> (SLL para, mk_rules_for_sll para)) todo_paras_sll in + let todo_rsets_dll = IList.map (fun para -> (DLL para, mk_rules_for_dll para)) todo_paras_dll in new_rsets := !new_rsets @ todo_rsets_sll @ todo_rsets_dll; let p' = abs_rules_apply_rsets todo_rsets_sll p in let p'' = abs_rules_apply_rsets todo_rsets_dll p' in @@ -771,7 +771,7 @@ let is_simply_recursive tenv tname = None | Sil.Tstruct (fld_typ_ann_list, _, _, _, _, _, _) -> begin - match (list_filter filter fld_typ_ann_list) with + match (IList.filter filter fld_typ_ann_list) with | [(fld, _, _)] -> Some fld | _ -> None end @@ -784,14 +784,14 @@ let create_hpara_from_tname_flds tenv tname nfld sflds eflds inst = | None -> assert false in let id_base = Ident.create_fresh Ident.kprimed in let id_next = Ident.create_fresh Ident.kprimed in - let ids_shared = list_map (fun _ -> Ident.create_fresh Ident.kprimed) sflds in - let ids_exist = list_map (fun _ -> Ident.create_fresh Ident.kprimed) eflds in + let ids_shared = IList.map (fun _ -> Ident.create_fresh Ident.kprimed) sflds in + let ids_exist = IList.map (fun _ -> Ident.create_fresh Ident.kprimed) eflds in let exp_base = Sil.Var id_base in let fld_sexps = let ids = id_next :: (ids_shared @ ids_exist) in let flds = nfld :: (sflds @ eflds) in let f fld id = (fld, Sil.Eexp (Sil.Var id, inst)) in - try list_map2 f flds ids with Invalid_argument _ -> assert false in + try IList.map2 f flds ids with Invalid_argument _ -> assert false in let strexp_para = Sil.Estruct (fld_sexps, inst) in let ptsto_para = Prop.mk_ptsto exp_base strexp_para (Sil.Sizeof (typ, Sil.Subtype.exact)) in Prop.mk_hpara id_base id_next ids_shared ids_exist [ptsto_para] @@ -803,14 +803,14 @@ let create_dll_hpara_from_tname_flds tenv tname flink blink sflds eflds inst = let id_iF = Ident.create_fresh Ident.kprimed in let id_oB = Ident.create_fresh Ident.kprimed in let id_oF = Ident.create_fresh Ident.kprimed in - let ids_shared = list_map (fun _ -> Ident.create_fresh Ident.kprimed) sflds in - let ids_exist = list_map (fun _ -> Ident.create_fresh Ident.kprimed) eflds in + let ids_shared = IList.map (fun _ -> Ident.create_fresh Ident.kprimed) sflds in + let ids_exist = IList.map (fun _ -> Ident.create_fresh Ident.kprimed) eflds in let exp_iF = Sil.Var id_iF in let fld_sexps = let ids = id_oF:: id_oB :: (ids_shared @ ids_exist) in let flds = flink:: blink:: (sflds @ eflds) in let f fld id = (fld, Sil.Eexp (Sil.Var id, inst)) in - try list_map2 f flds ids with Invalid_argument _ -> assert false in + try IList.map2 f flds ids with Invalid_argument _ -> assert false in let strexp_para = Sil.Estruct (fld_sexps, inst) in let ptsto_para = Prop.mk_ptsto exp_iF strexp_para (Sil.Sizeof (typ, Sil.Subtype.exact)) in Prop.mk_dll_hpara id_iF id_oB id_oF ids_shared ids_exist [ptsto_para] @@ -831,7 +831,7 @@ let create_hpara_two_ptsto tname1 tenv nfld1 dfld tname2 nfld2 inst = let ids = [id_next; id_exist] in let flds = [nfld1; dfld] in let f fld id = (fld, Sil.Eexp (Sil.Var id, inst)) in - try list_map2 f flds ids with Invalid_argument _ -> assert false in + try IList.map2 f flds ids with Invalid_argument _ -> assert false in let fld_sexps2 = [(nfld2, Sil.Eexp (Sil.exp_zero, inst))] in let strexp_para1 = Sil.Estruct (fld_sexps1, inst) in @@ -857,7 +857,7 @@ let create_hpara_dll_two_ptsto tenv tname1 flink_fld1 blink_fld1 dfld tname2 nfl let ids = [ id_blink; id_flink; id_exist] in let flds = [ blink_fld1; flink_fld1; dfld] in let f fld id = (fld, Sil.Eexp (Sil.Var id, inst)) in - try list_map2 f flds ids with Invalid_argument _ -> assert false in + try IList.map2 f flds ids with Invalid_argument _ -> assert false in let fld_sexps2 = [(nfld2, Sil.Eexp (Sil.exp_zero, inst))] in let strexp_para1 = Sil.Estruct (fld_sexps1, inst) in @@ -917,7 +917,7 @@ let create_absrules_from_tdecl tenv tname = let para2 = create_hpara_from_tname_flds tenv tname_HSlist2 name_next [name_down] [] Sil.inst_abstraction in let para_nested = create_hpara_from_tname_twoflds_hpara tenv tname_HSlist2 name_next name_down para1 Sil.inst_abstraction in let para_nested_base = create_hpara_two_ptsto tname_HSlist2 tenv name_next name_down tname_list name_down Sil.inst_abstraction in - list_iter abs_rules_add_sll [para_nested_base; para2; para_nested] + IList.iter abs_rules_add_sll [para_nested_base; para2; para_nested] else if (not (!Config.on_the_fly)) && Sil.typename_equal tname tname_dllist then (* L.out "@[.... Adding Abstraction Rules for Doubly-linked Lists ....@\n@."; *) let para = create_dll_hpara_from_tname_flds tenv tname_dllist name_Flink name_Blink [] [] Sil.inst_abstraction in @@ -928,7 +928,7 @@ let create_absrules_from_tdecl tenv tname = let para2 = create_dll_hpara_from_tname_flds tenv tname_HOdllist name_Flink name_Blink [name_down] [] Sil.inst_abstraction in let para_nested = create_hpara_dll_from_tname_twoflds_hpara tenv tname_HOdllist name_Flink name_Blink name_down para1 Sil.inst_abstraction in let para_nested_base = create_hpara_dll_two_ptsto tenv tname_HOdllist name_Flink name_Blink name_down tname_list name_down Sil.inst_abstraction in - list_iter abs_rules_add_dll [para_nested_base; para2; para_nested] + IList.iter abs_rules_add_dll [para_nested_base; para2; para_nested] else if (not (!Config.on_the_fly)) then match is_simply_recursive tenv tname with | None -> () @@ -952,9 +952,9 @@ let abstract_pure_part 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 - list_filter filter pure in + IList.filter filter pure in let new_pure = - list_fold_left + IList.fold_left (fun pi a -> match a with | Sil.Aneq (Sil.Var name, _) -> a:: pi @@ -971,7 +971,7 @@ let abstract_pure_part p ~(from_abstract_footprint: bool) = | _ -> pi) | _ -> pi) [] pi_filtered in - list_rev new_pure in + IList.rev new_pure in let new_pure = do_pure (Prop.get_pure p) in let eprop' = Prop.replace_pi new_pure (Prop.replace_sub Sil.sub_empty p) in @@ -989,17 +989,17 @@ let abstract_gc p = let fav_p_without_pi = Prop.prop_fav p_without_pi in (* let weak_filter atom = let fav_atom = atom_fav atom in - list_intersect compare fav_p_without_pi fav_atom in *) + IList.intersect compare fav_p_without_pi fav_atom in *) let strong_filter = function | Sil.Aeq(e1, e2) | Sil.Aneq(e1, e2) -> let fav_e1 = Sil.exp_fav e1 in let fav_e2 = Sil.exp_fav e2 in - let intersect_e1 _ = list_intersect Ident.compare (Sil.fav_to_list fav_e1) (Sil.fav_to_list fav_p_without_pi) in - let intersect_e2 _ = list_intersect Ident.compare (Sil.fav_to_list fav_e2) (Sil.fav_to_list fav_p_without_pi) in + let intersect_e1 _ = IList.intersect Ident.compare (Sil.fav_to_list fav_e1) (Sil.fav_to_list fav_p_without_pi) in + let intersect_e2 _ = IList.intersect Ident.compare (Sil.fav_to_list fav_e2) (Sil.fav_to_list fav_p_without_pi) in let no_fav_e1 = Sil.fav_is_empty fav_e1 in let no_fav_e2 = Sil.fav_is_empty fav_e2 in (no_fav_e1 || intersect_e1 ()) && (no_fav_e2 || intersect_e2 ()) in - let new_pi = list_filter strong_filter pi in + let new_pi = IList.filter strong_filter pi in let prop = Prop.normalize (Prop.replace_pi new_pi p) in match Prop.prop_iter_create prop with | None -> prop @@ -1025,8 +1025,8 @@ let sigma_reachable root_fav sigma = let do_hpred hpred = let hp_fav_set = fav_to_set (Sil.hpred_fav hpred) in let add_entry e = edges := (e, hp_fav_set) :: !edges in - list_iter add_entry (hpred_entries hpred) in - list_iter do_hpred sigma; + IList.iter add_entry (hpred_entries hpred) in + IList.iter do_hpred sigma; let edge_fires (e, _) = match e with | Sil.Var id -> if (Ident.is_primed id || Ident.is_footprint id) then Ident.IdentSet.mem id !reach_set @@ -1056,14 +1056,14 @@ let get_cycle root prop = match e with | Sil.Eexp(e', _) -> (try - Some(list_find (fun hpred -> match hpred with + Some(IList.find (fun hpred -> match hpred with | Sil.Hpointsto(e'', _, _) -> Sil.exp_equal e'' e' | _ -> false) sigma) with _ -> None) | _ -> None in let print_cycle cyc = (L.d_str "Cycle= "; - list_iter (fun ((e, t), f, e') -> + IList.iter (fun ((e, t), f, e') -> match e, e' with | Sil.Eexp (e, _), Sil.Eexp (e', _) -> L.d_str ("("^(Sil.exp_to_string e)^": "^(Sil.typ_to_string t)^", "^(Ident.fieldname_to_string f)^", "^(Sil.exp_to_string e')^")") @@ -1078,7 +1078,7 @@ let get_cycle root prop = | (f, e):: el' -> if Sil.strexp_equal e e_root then (et_src, f, e):: path, true - else if list_mem Sil.strexp_equal e visited then + else if IList.mem Sil.strexp_equal e visited then path, false else ( let visited' = (fst et_src):: visited in @@ -1115,10 +1115,10 @@ let reachable_when_in_several_hpreds sigma : Ident.t -> bool = let add_hpred hpred = let fav = Sil.fav_new () in Sil.hpred_fav_add fav hpred; - list_iter (fun id -> add_id_hpred id hpred) (Sil.fav_to_list fav) in + IList.iter (fun id -> add_id_hpred id hpred) (Sil.fav_to_list fav) in let id_in_several_hpreds id = HpredSet.cardinal (IdMap.find id !id_hpred_map) > 1 in - list_iter add_hpred sigma; + IList.iter add_hpred sigma; id_in_several_hpreds @@ -1160,11 +1160,11 @@ let get_var_retain_cycle _prop = | _, _ -> false in let find_pvar v = try - let hp = list_find (is_pvar v) sigma in + let hp = IList.find (is_pvar v) sigma in Some (Sil.hpred_get_lhs hp) with Not_found -> None in let find_block v = - if (list_exists (is_hpred_block v) sigma) then + if (IList.exists (is_hpred_block v) sigma) then Some (Sil.Lvar Sil.block_pvar) else None in let sexp e = Sil.Eexp (e, Sil.Inone) in @@ -1184,7 +1184,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' = list_flatten (list_map find_pvar_or_block cycle) in + let cycle' = IList.flatten (IList.map find_pvar_or_block cycle) in if cycle' = [] then do_sigma sigma' else cycle' in do_sigma sigma @@ -1202,7 +1202,7 @@ let cycle_has_weak_or_unretained_or_assign_field cycle = match t with | Sil.Tstruct(nsf, sf, _, _, _, _, _) -> let ia = ref [] in - list_iter (fun (fn', t', ia') -> + IList.iter (fun (fn', t', ia') -> if Ident.fieldname_equal fn fn' then ia := ia') (nsf@sf); !ia | _ -> [] in @@ -1219,7 +1219,7 @@ let cycle_has_weak_or_unretained_or_assign_field cycle = | [] -> false | ((e, t), fn, _):: c' -> let ia = get_item_annotation t fn in - if (list_exists do_annotation ia) then true + if (IList.exists do_annotation ia) then true else do_cycle c' in do_cycle cycle @@ -1239,7 +1239,7 @@ let check_junk ?original_prop pname tenv prop = (Ident.is_primed id || Ident.is_footprint id) && not (Sil.fav_mem fav_root id) && not (id_considered_reachable id) | _ -> false in - list_for_all predicate entries in + IList.for_all predicate entries in let hpred_in_cycle hpred = (* check if the predicate belongs to a cycle in the heap *) let id_in_cycle id = let set1 = sigma_reachable (Sil.fav_from_list [id]) sigma in @@ -1257,10 +1257,10 @@ let check_junk ?original_prop pname tenv prop = Sil.strexp_fav_add fav se; Sil.fav_mem fav id | _ -> false in - hpred_is_loop || list_exists predicate entries in + hpred_is_loop || IList.exists predicate entries in let rec remove_junk_recursive sigma_done sigma_todo = match sigma_todo with - | [] -> list_rev sigma_done + | [] -> IList.rev sigma_done | hpred :: sigma_todo' -> let entries = hpred_entries hpred in if should_remove_hpred entries then @@ -1286,7 +1286,7 @@ let check_junk ?original_prop pname tenv prop = | Some (Sil.Aundef _ as a) -> res := Some a | _ -> ()) in - list_iter do_entry entries; + IList.iter do_entry entries; !res in L.d_decrease_indent 1; let is_undefined = Option.map_default Sil.attr_is_undef false alloc_attribute in @@ -1344,7 +1344,7 @@ let check_junk ?original_prop pname tenv prop = | None, Some _ -> false in (alloc_attribute = None && !leaks_reported <> []) || (* None attribute only reported if it's the first one *) - list_mem attr_opt_equal alloc_attribute !leaks_reported in + IList.mem attr_opt_equal alloc_attribute !leaks_reported in let ignore_leak = !Config.allowleak || ignore_resource || is_undefined || already_reported () in let report_and_continue = @@ -1364,7 +1364,7 @@ let check_junk ?original_prop pname tenv prop = remove_junk_recursive [] sigma in let rec remove_junk fp_part fav_root sigma = (* call remove_junk_once until sigma stops shrinking *) let sigma' = remove_junk_once fp_part fav_root sigma in - if list_length sigma' = list_length sigma then sigma' + if IList.length sigma' = IList.length sigma then sigma' else remove_junk fp_part fav_root sigma' in let sigma_new = remove_junk false fav_sub_sigmafp (Prop.get_sigma prop) in let sigma_fp_new = remove_junk true (Sil.fav_new ()) (Prop.get_sigma_footprint prop) in @@ -1408,12 +1408,12 @@ let get_local_stack cur_sigma init_sigma = | Sil.Hpointsto (Sil.Lvar pvar, _, _) -> pvar | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> assert false in let filter_local_stack old_pvars = function - | Sil.Hpointsto (Sil.Lvar pvar, _, _) -> not (list_exists (Sil.pvar_equal pvar) old_pvars) + | Sil.Hpointsto (Sil.Lvar pvar, _, _) -> not (IList.exists (Sil.pvar_equal pvar) old_pvars) | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> false in - let init_stack = list_filter filter_stack init_sigma in - let init_stack_pvars = list_map get_stack_var init_stack in - let cur_local_stack = list_filter (filter_local_stack init_stack_pvars) cur_sigma in - let cur_local_stack_pvars = list_map get_stack_var cur_local_stack in + let init_stack = IList.filter 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_pvars = IList.map get_stack_var cur_local_stack in (cur_local_stack, cur_local_stack_pvars) (** Extract the footprint, add a local stack and return it as a prop *) @@ -1428,9 +1428,9 @@ let extract_footprint_for_abs (p : 'a Prop.t) : Prop.exposed Prop.t * Sil.pvar l let remove_local_stack sigma pvars = let filter_non_stack = function - | Sil.Hpointsto (Sil.Lvar pvar, _, _) -> not (list_exists (Sil.pvar_equal pvar) pvars) + | Sil.Hpointsto (Sil.Lvar pvar, _, _) -> not (IList.exists (Sil.pvar_equal pvar) pvars) | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> true in - list_filter filter_non_stack sigma + IList.filter 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 fceea95fe..d9d4741b7 100644 --- a/infer/src/backend/absarray.ml +++ b/infer/src/backend/absarray.ml @@ -67,11 +67,11 @@ end = struct match se, t, syn_offs with | _, _, [] -> (se, t) | Sil.Estruct (fsel, _), Sil.Tstruct (ftal, sftal, _, _, _, _, _), Field (fld, _) :: syn_offs' -> - let se' = snd (list_find (fun (f', se') -> Sil.fld_equal f' fld) fsel) in - let t' = (fun (x,y,z) -> y) (list_find (fun (f', t', a') -> Sil.fld_equal f' fld) ftal) in + let se' = snd (IList.find (fun (f', se') -> Sil.fld_equal f' fld) fsel) in + let t' = (fun (x,y,z) -> y) (IList.find (fun (f', t', a') -> Sil.fld_equal f' fld) ftal) in get_strexp_at_syn_offsets se' t' syn_offs' | Sil.Earray (size, esel, _), Sil.Tarray(t', _), Index ind :: syn_offs' -> - let se' = snd (list_find (fun (i', se') -> Sil.exp_equal i' ind) esel) in + let se' = snd (IList.find (fun (i', se') -> Sil.exp_equal i' ind) esel) in get_strexp_at_syn_offsets se' t' syn_offs' | _ -> L.d_strln "Failure of get_strexp_at_syn_offsets"; @@ -85,15 +85,15 @@ end = struct | _, _, [] -> update se t | Sil.Estruct (fsel, inst), Sil.Tstruct (ftal, sftal, _, _, _, _, _), Field (fld, _) :: syn_offs' -> - let se' = snd (list_find (fun (f', _) -> Sil.fld_equal f' fld) fsel) in - let t' = (fun (x,y,z) -> y) (list_find (fun (f', _, _) -> Sil.fld_equal f' fld) ftal) in + let se' = snd (IList.find (fun (f', _) -> Sil.fld_equal f' fld) fsel) in + let t' = (fun (x,y,z) -> y) (IList.find (fun (f', _, _) -> Sil.fld_equal f' fld) ftal) in let se_mod = replace_strexp_at_syn_offsets se' t' syn_offs' update in - let fsel' = list_map (fun (f'', se'') -> if Sil.fld_equal f'' fld then (fld, se_mod) else (f'', se'')) fsel in + let fsel' = IList.map (fun (f'', se'') -> if Sil.fld_equal f'' fld then (fld, se_mod) else (f'', se'')) fsel in Sil.Estruct (fsel', inst) | Sil.Earray (size, esel, inst), Sil.Tarray (t', _), Index idx :: syn_offs' -> - let se' = snd (list_find (fun (i', _) -> Sil.exp_equal i' idx) esel) in + let se' = snd (IList.find (fun (i', _) -> Sil.exp_equal i' idx) esel) in let se_mod = replace_strexp_at_syn_offsets se' t' syn_offs' update in - let esel' = list_map (fun ese -> if Sil.exp_equal (fst ese) idx then (idx, se_mod) else ese) esel in + let esel' = IList.map (fun ese -> if Sil.exp_equal (fst ese) idx then (idx, se_mod) else ese) esel in Sil.Earray (size, esel', inst) | _ -> assert false @@ -102,10 +102,10 @@ end = struct let rec convert acc = function | [] -> acc | Field (f, t) :: syn_offs' -> - let acc' = list_map (fun e -> Sil.Lfield (e, f, t)) acc in + let acc' = IList.map (fun e -> Sil.Lfield (e, f, t)) acc in convert acc' syn_offs' | Index idx :: syn_offs' -> - let acc' = list_map (fun e -> Sil.Lindex (e, idx)) acc in + let acc' = IList.map (fun e -> Sil.Lindex (e, idx)) acc in convert acc' syn_offs' in begin convert [root] syn_offs_in @@ -116,7 +116,7 @@ end = struct let offset_to_syn_offset = function | Sil.Off_fld (fld, typ) -> Field (fld, typ) | Sil.Off_index idx -> Index idx in - let syn_offs = list_map offset_to_syn_offset offs in + let syn_offs = IList.map offset_to_syn_offset offs in (root, syn_offs) (** path to the root, size, elements and type of a new_array *) @@ -130,14 +130,14 @@ end = struct let filter = function | Sil.Hpointsto (e, _, _) -> Sil.exp_equal root e | _ -> false in - let hpred = list_find filter sigma in + let hpred = IList.find filter sigma in (sigma, hpred, syn_offs) (** Find a sub strexp with the given property. Can raise [Not_found] *) let find (sigma : sigma) (pred : sigma -> strexp_data -> bool) : t list = let found = ref [] in let rec find_offset_sexp sigma_other hpred root offs se typ = - let offs' = list_rev offs in + let offs' = IList.rev offs in let path = (root, offs') in if pred sigma_other (path, se, typ) then found := (sigma, hpred, offs') :: !found else begin @@ -153,7 +153,7 @@ end = struct | (f, se) :: fsel' -> begin try - let t = (fun (x,y,z) -> y) (list_find (fun (f', t, a) -> Sil.fld_equal f' f) ftal) in + let t = (fun (x,y,z) -> y) (IList.find (fun (f', t, a) -> Sil.fld_equal 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") @@ -193,12 +193,12 @@ end = struct (** 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 = list_filter (fun hpred' -> not (hpred' == hpred)) sigma in + let sigma_unmatched = IList.filter (fun hpred' -> not (hpred' == hpred)) sigma in (sigma_unmatched, hpred) (** Replace the current hpred *) let replace_hpred ((sigma, hpred, syn_offs) : t) hpred' = - list_map (fun hpred'' -> if hpred''== hpred then hpred' else hpred'') sigma + IList.map (fun hpred'' -> if hpred''== hpred then hpred' else hpred'') sigma (** Replace the strexp at the given offset in the given hpred *) let hpred_replace_strexp footprint_part hpred syn_offs update = @@ -206,11 +206,11 @@ end = struct let se_in = update se' t' in match se', se_in with | Sil.Earray (size, esel, inst1), Sil.Earray (_, esel_in, inst2) -> - let orig_indices = list_map fst esel in - let index_is_not_new idx = list_exists (Sil.exp_equal idx) orig_indices in + let orig_indices = IList.map fst esel in + let index_is_not_new idx = IList.exists (Sil.exp_equal idx) orig_indices in let process_index idx = if index_is_not_new idx then idx else (Sil.array_clean_new_index footprint_part idx) in - let esel_in' = list_map (fun (idx, se) -> process_index idx, se) esel_in in + let esel_in' = IList.map (fun (idx, se) -> process_index idx, se) esel_in in Sil.Earray (size, esel_in', inst2) | _, _ -> se_in in begin @@ -232,14 +232,14 @@ end = struct 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 footprint_part (new_sigma, hpred, syn_offs) se_in in - list_sort Sil.hpred_compare sigma' + IList.sort Sil.hpred_compare sigma' (** Replace the index in the array at a given position with the new index *) let replace_index footprint_part ((sigma, hpred, syn_offs) : t) (index: Sil.exp) (index': Sil.exp) = let update se' t' = match se' with | Sil.Earray (size, esel, inst) -> - let esel' = list_map (fun (e', se') -> if Sil.exp_equal e' index then (index', se') else (e', se')) esel in + let esel' = IList.map (fun (e', se') -> if Sil.exp_equal e' index then (index', se') else (e', se')) esel in Sil.Earray (size, esel', inst) | _ -> assert false in let hpred' = hpred_replace_strexp footprint_part hpred syn_offs update in @@ -255,8 +255,8 @@ let prop_replace_path_index = let elist_path = StrexpMatch.path_to_exps path in let expmap_list = - list_fold_left (fun acc_outer e_path -> - list_fold_left (fun acc_inner (old_index, new_index) -> + IList.fold_left (fun acc_outer e_path -> + IList.fold_left (fun acc_inner (old_index, new_index) -> let old_e_path_index = Prop.exp_normalize_prop p (Sil.Lindex(e_path, old_index)) in let new_e_path_index = Prop.exp_normalize_prop p (Sil.Lindex(e_path, new_index)) in (old_e_path_index, new_e_path_index) :: acc_inner @@ -264,7 +264,7 @@ let prop_replace_path_index ) [] elist_path in let expmap_fun e' = try - let _, fresh_e = list_find (fun (e, _) -> Sil.exp_equal e e') expmap_list in + let _, fresh_e = IList.find (fun (e, _) -> Sil.exp_equal e e') expmap_list in fresh_e with Not_found -> e' in Prop.prop_expmap expmap_fun p @@ -337,7 +337,7 @@ let generic_strexp_abstract let rec match_abstract p0 matchings_cur_fp = try let matched, footprint_part, matchings_cur_fp' = match_select_next matchings_cur_fp in - let n = list_length (snd matchings_cur_fp') + 1 in + let n = IList.length (snd matchings_cur_fp') + 1 in if !Config.trace_absarray then (L.d_strln ("Num of fp candidates " ^ (string_of_int n))); let strexp_data = StrexpMatch.get_data matched in let p1, changed = do_abstract footprint_part p0 strexp_data in @@ -354,7 +354,7 @@ let generic_strexp_abstract if changed then find_then_abstract (bound - 1) p1 else p0 end in let matchings_cur, matchings_fp = find_strexp_to_abstract p_in in - let num_matches = (list_length matchings_cur) + (list_length matchings_fp) in + let num_matches = (IList.length matchings_cur) + (IList.length matchings_fp) in begin find_then_abstract num_matches p_in end @@ -368,12 +368,12 @@ let index_is_pointed_to (p: Prop.normal Prop.t) (path: StrexpMatch.path) (index: let add_index_to_paths = let elist_path = StrexpMatch.path_to_exps path in let add_index i e = Prop.exp_normalize_prop p (Sil.Lindex(e, i)) in - fun i -> list_map (add_index i) elist_path in - let pointers = list_flatten (list_map add_index_to_paths indices) in + fun i -> IList.map (add_index i) elist_path in + let pointers = IList.flatten (IList.map add_index_to_paths indices) in let filter = function - | Sil.Hpointsto (_, Sil.Eexp (e, inst), _) -> list_exists (Sil.exp_equal e) pointers + | Sil.Hpointsto (_, Sil.Eexp (e, inst), _) -> IList.exists (Sil.exp_equal e) pointers | _ -> false in - list_exists filter (Prop.get_sigma p) + IList.exists filter (Prop.get_sigma p) (** Given [p] containing an array at [path], blur [index] in it *) @@ -417,7 +417,7 @@ let blur_array_indices (indices: Sil.exp list) : Prop.normal Prop.t * bool = let f prop index = blur_array_index footprint_part prop root index in - (list_fold_left f p indices, list_length indices > 0) + (IList.fold_left f p indices, IList.length indices > 0) (** Given [p] containing an array at [root], only keep [indices] in it *) @@ -433,7 +433,7 @@ let keep_only_indices let (_, se, _) = StrexpMatch.get_data matched in match se with | Sil.Earray (size, esel, inst) -> - let esel', esel_leftover' = list_partition (fun (e, _) -> list_exists (Sil.exp_equal e) indices) esel in + let esel', esel_leftover' = IList.partition (fun (e, _) -> IList.exists (Sil.exp_equal e) indices) esel in if esel_leftover' == [] then (sigma, false) else begin let se' = Sil.Earray (size, esel', inst) in @@ -454,7 +454,7 @@ let array_typ_can_abstract = function let strexp_can_abstract sigma_rest ((_, se, typ) : StrexpMatch.strexp_data) : bool = let can_abstract_se = match se with | Sil.Earray (size, esel, _) -> - let len = list_length esel in + let len = IList.length esel in len > 1 | _ -> false in can_abstract_se && array_typ_can_abstract typ @@ -482,9 +482,9 @@ let strexp_do_abstract footprint_part p ((path, se_in, typ_in) : StrexpMatch.str (blur_array_indices footprint_part) in let partition_abstract should_keep abstract ksel default_keys = - let keep_ksel, remove_ksel = list_partition should_keep ksel in + let keep_ksel, remove_ksel = IList.partition should_keep ksel in let keep_keys, remove_keys, keys = - list_map fst keep_ksel, list_map fst remove_ksel, list_map fst ksel in + IList.map fst keep_ksel, IList.map fst remove_ksel, IList.map fst ksel in let keep_keys' = if keep_keys == [] then default_keys else keep_keys in abstract keep_keys' keep_keys' in let do_array_footprint esel = @@ -492,9 +492,9 @@ let strexp_do_abstract footprint_part p ((path, se_in, typ_in) : StrexpMatch.str let should_keep (i0, _) = index_is_pointed_to p path i0 in let abstract = prune_and_blur_indices path in let default_indices = - match list_map fst esel with + match IList.map fst esel with | [] -> [] - | indices -> [list_hd (list_rev indices)] (* keep last key at least *) in + | indices -> [IList.hd (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 @@ -502,8 +502,8 @@ let strexp_do_abstract footprint_part p ((path, se_in, typ_in) : StrexpMatch.str | _ -> assert false in let filter_abstract d_keys should_keep abstract ksel default_keys = - let keep_ksel = list_filter should_keep ksel in - let keep_keys = list_map fst keep_ksel in + let keep_ksel = IList.filter should_keep ksel in + let keep_keys = IList.map fst keep_ksel in let keep_keys' = if 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 ()); abstract keep_keys' [] in @@ -553,12 +553,12 @@ let check_after_array_abstraction prop = | Sil.Eexp _ -> () | Sil.Earray (_, esel, _) -> (* check that no more than 2 elements are in the array *) let typ_elem = Sil.array_typ_elem (Some Sil.Tvoid) typ in - if list_length esel > 2 && array_typ_can_abstract typ then - if list_for_all (check_index root offs) esel then () + if IList.length esel > 2 && array_typ_can_abstract typ then + if IList.for_all (check_index root offs) esel then () else report_error prop - else list_iter (fun (ind, se) -> check_se root (offs @ [Sil.Off_index ind]) typ_elem se) esel + else IList.iter (fun (ind, se) -> check_se root (offs @ [Sil.Off_index ind]) typ_elem se) esel | Sil.Estruct (fsel, _) -> - list_iter (fun (f, se) -> + IList.iter (fun (f, se) -> let typ_f = Sil.struct_typ_fld (Some Sil.Tvoid) f typ in check_se root (offs @ [Sil.Off_fld (f, typ)]) typ_f se) fsel in let check_hpred = function @@ -566,7 +566,7 @@ let check_after_array_abstraction prop = let typ = Sil.texp_to_typ (Some Sil.Tvoid) texp in check_se root [] typ se | Sil.Hlseg _ | Sil.Hdllseg _ -> () in - let check_sigma sigma = list_iter check_hpred sigma in + let check_sigma sigma = IList.iter check_hpred sigma in (* check_footprint_pure prop; *) check_sigma (Prop.get_sigma prop); check_sigma (Prop.get_sigma_footprint prop) @@ -592,9 +592,9 @@ let remove_redundant_elements prop = let favl_curr = Sil.fav_to_list fav_curr in let favl_foot = Sil.fav_to_list fav_foot in Sil.fav_duplicates := false; - (* L.d_str "favl_curr "; list_iter (fun id -> Sil.d_exp (Sil.Var id)) favl_curr; L.d_ln(); - L.d_str "favl_foot "; list_iter (fun id -> Sil.d_exp (Sil.Var id)) favl_foot; L.d_ln(); *) - let num_occur l id = list_length (list_filter (fun id' -> Ident.equal id id') l) in + (* L.d_str "favl_curr "; IList.iter (fun id -> Sil.d_exp (Sil.Var id)) favl_curr; L.d_ln(); + L.d_str "favl_foot "; IList.iter (fun id -> Sil.d_exp (Sil.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 at_most_once v = num_occur favl_curr v <= 1 && num_occur favl_foot v <= 1 in at_most_once in @@ -613,7 +613,7 @@ let remove_redundant_elements prop = | _ -> true in let remove_redundant_se fp_part = function | Sil.Earray (size, esel, inst) -> - let esel' = list_filter (filter_redundant_e_se fp_part) esel in + let esel' = IList.filter (filter_redundant_e_se fp_part) esel in Sil.Earray (size, esel', inst) | se -> se in let remove_redundant_hpred fp_part = function @@ -621,7 +621,7 @@ let remove_redundant_elements prop = let se' = remove_redundant_se fp_part se in Sil.Hpointsto (e, se', te) | hpred -> hpred in - let remove_redundant_sigma fp_part sigma = list_map (remove_redundant_hpred fp_part) sigma in + let remove_redundant_sigma fp_part sigma = IList.map (remove_redundant_hpred fp_part) sigma in let sigma' = remove_redundant_sigma false (Prop.get_sigma prop) in let foot_sigma' = remove_redundant_sigma true (Prop.get_sigma_footprint prop) in if !modified then diff --git a/infer/src/backend/autounit.ml b/infer/src/backend/autounit.ml index 411d957b2..475aac491 100644 --- a/infer/src/backend/autounit.ml +++ b/infer/src/backend/autounit.ml @@ -57,7 +57,7 @@ end = struct let ev = ref IdMap.empty in let add_var id = ev := IdMap.add id (new_range ()) !ev in - list_iter add_var vars; + IList.iter add_var vars; !ev let gt_bottom i r = @@ -82,20 +82,20 @@ end = struct (** normalize [r]: the excluded elements must be strictly between bottom and top *) let normalize r = - r.excluded <- list_filter (fun i -> geq_bottom i r && leq_top i r) r.excluded; + r.excluded <- IList.filter (fun i -> geq_bottom i r && leq_top i r) r.excluded; let rec normalize_bottom () = match r.bottom with | None -> () | Some i -> - if list_mem Sil.Int.eq i r.excluded then begin - r.excluded <- list_filter (Sil.Int.neq i) r.excluded; + if IList.mem Sil.Int.eq i r.excluded then begin + r.excluded <- IList.filter (Sil.Int.neq i) r.excluded; r.bottom <- Some (i ++ Sil.Int.one); normalize_bottom () end in let rec normalize_top () = match r.top with | None -> () | Some i -> - if list_mem Sil.Int.eq i r.excluded then begin - r.excluded <- list_filter (Sil.Int.neq i) r.excluded; + if IList.mem Sil.Int.eq i r.excluded then begin + r.excluded <- IList.filter (Sil.Int.neq i) r.excluded; r.top <- Some (i -- Sil.Int.one); normalize_top () end in @@ -111,7 +111,7 @@ end = struct (** exclude one element from the range *) let add_excluded r id i = - if geq_bottom i r && leq_top i r && not (list_mem Sil.Int.eq i r.excluded) + if geq_bottom i r && leq_top i r && not (IList.mem Sil.Int.eq i r.excluded) then begin r.excluded <- i :: r.excluded; normalize r; @@ -140,9 +140,9 @@ end = struct let choose id rng = if debug then F.fprintf F.std_formatter "choosing %a@." (pp_range id) rng; let found = ref None in - let num_iter = list_length rng.excluded in + let num_iter = IList.length rng.excluded in let try_candidate candidate = - if geq_bottom candidate rng && leq_top candidate rng && not (list_mem Sil.Int.eq candidate rng.excluded) + if geq_bottom candidate rng && leq_top candidate rng && not (IList.mem Sil.Int.eq candidate rng.excluded) then (found := Some candidate; rng.bottom <- Some candidate; rng.top <- Some candidate; rng.excluded <- []) in let search_up () = let base = match rng.bottom with None -> Sil.Int.zero | Some n -> n in @@ -183,7 +183,7 @@ end = struct | Sil.Aneq (e1, e2) -> do_neq e1 e2 in changed := false; - list_iter do_atom pi; + IList.iter do_atom pi; if !changed then pi_iter do_le do_lt do_neq pi (** Collect constraints on [vars] from [pi], and return a satisfying instantiation *) @@ -193,7 +193,7 @@ end = struct let atom_is_relevant a = let fav = Sil.atom_fav a in Sil.fav_for_all fav (fun id -> Sil.fav_mem vars_fav id) in - let pi_relevant = list_filter atom_is_relevant pi in + let pi_relevant = IList.filter atom_is_relevant pi in let ev = new_eval vars in let update_top rng id n_op = match rng.top, n_op with | Some _, Some n -> add_top rng id n @@ -259,7 +259,7 @@ end = struct let rng = IdMap.find id ev in pi_iter do_le do_lt do_neq pi_relevant; choose id rng in - list_iter do_ident vars; + IList.iter do_ident vars; if debug then F.fprintf F.std_formatter "solution to pure constraints:@.%a@." pp_eval ev; let solution = IdMap.map (function { bottom = Some n } -> n | _ -> assert false) ev in solution @@ -337,10 +337,10 @@ let create_idmap sigma : idmap = | Sil.Hlseg (k, hpar, e, f, el) -> do_lhs_e e (Sil.Tptr (Sil.Tvoid, Sil.Pk_pointer)); do_se (Sil.Eexp (f, Sil.inst_none)) (Sil.Tptr (Sil.Tvoid, Sil.Pk_pointer)); - list_iter (fun e -> do_se (Sil.Eexp (e, Sil.inst_none)) Sil.Tvoid) el + IList.iter (fun e -> do_se (Sil.Eexp (e, Sil.inst_none)) Sil.Tvoid) el | hpred -> L.err "do_hpred not implemented %a@." (Sil.pp_hpred pe) hpred in - list_iter do_hpred sigma; + IList.iter do_hpred sigma; !idmap module Code : sig @@ -356,10 +356,10 @@ end = struct type t = string list ref let indent = ref "" let to_list code = - list_rev !code + IList.rev !code let pp fmt code = let doit line = F.fprintf fmt "%s@\n" line in - list_iter doit (to_list code); + IList.iter doit (to_list code); F.fprintf fmt "@." let empty () = ref [] let add_line code l = @@ -420,7 +420,7 @@ let pp_texp_for_malloc fmt = | Sil.Tptr (t, pk) -> Sil.Tptr (handle_arr_size t, pk) | Sil.Tstruct (ftal, sftal, csu, nameo, supers, def_mthds, iann) -> - Sil.Tstruct (list_map (fun (f, t, a) -> (f, handle_arr_size t, a)) ftal, sftal, csu, nameo, supers, def_mthds, iann) + Sil.Tstruct (IList.map (fun (f, t, a) -> (f, handle_arr_size t, a)) ftal, sftal, csu, nameo, supers, def_mthds, iann) | Sil.Tarray (t, e) -> Sil.Tarray (handle_arr_size t, e) in function @@ -439,9 +439,9 @@ let gen_sigma code proc_name spec_num env idmap sigma = Code.add_from_pp code' pp | Sil.Estruct (fsel, _) -> let accessor = if need_deref then "->" else "." in - list_iter (fun (f, se) -> do_strexp code' (base ^ accessor ^ Ident.fieldname_to_string f) false se) fsel + IList.iter (fun (f, se) -> do_strexp code' (base ^ accessor ^ Ident.fieldname_to_string f) false se) fsel | Sil.Earray (size, esel, _) -> - list_iter (fun (e, se) -> + IList.iter (fun (e, se) -> let pp f () = F.fprintf f "%a" (pp_exp_c pe) e in let index = pp_to_string pp () in do_strexp code' (base ^ "[" ^ index ^ "]") false se) esel in @@ -474,7 +474,7 @@ let gen_sigma code proc_name spec_num env idmap sigma = Code.add_from_pp code pp2 | hpred -> L.err "gen_hpred not implemented: %a@." (Sil.pp_hpred pe) hpred in - list_iter gen_hpred sigma; + IList.iter gen_hpred sigma; Code.append code post_code (* generate code corresponding to equalities in the pure part *) @@ -484,7 +484,7 @@ let gen_init_equalities code pure = let pp f () = F.fprintf f "%a = %a;" (pp_id_c pe) id (pp_exp_c pe) e in Code.add_from_pp code pp | _ -> () in - list_iter do_atom pure + IList.iter do_atom pure (** generate variable declarations *) let gen_var_decl code idmap parameters = @@ -496,7 +496,7 @@ let gen_var_decl code idmap parameters = let pp_var f () = pp_id_c pe f id in let pp f () = F.fprintf f "%a;" (Sil.pp_type_decl pe pp_var pp_exp_c) typ in Code.add_from_pp code pp in - list_iter do_parameter parameters; + IList.iter do_parameter parameters; IdMap.iter do_vinfo idmap (** initialize variables not requiring allocation *) @@ -544,7 +544,7 @@ let gen_hpara code proc_name spec_num env id hpara = let idmap = create_idmap hpara.Sil.body in let idmap_ex = let filter i = - list_exists (Ident.equal i) hpara.Sil.evars in + IList.exists (Ident.equal i) hpara.Sil.evars in filter_idmap filter idmap in let idmap_no_next = let filter i = @@ -637,7 +637,7 @@ let genmain proc_numspecs_list = Code.add_line code line done in Code.add_line code "int main() {"; Code.set_indent " "; - list_iter do_one_proc proc_numspecs_list; + IList.iter do_one_proc proc_numspecs_list; Code.add_line code "printf(\"unit test terminated\\n\");"; Code.add_line code "return 0;"; Code.set_indent ""; diff --git a/infer/src/backend/buckets.ml b/infer/src/backend/buckets.ml index 98f5e34f2..0ba1ff035 100644 --- a/infer/src/backend/buckets.ml +++ b/infer/src/backend/buckets.ml @@ -50,10 +50,10 @@ let check_access access_opt de_opt = let find_formal_ids node = (* find ids obtained by a letref on a formal parameter *) let node_instrs = Cfg.Node.get_instrs node in let formals = Cfg.Procdesc.get_formals (Cfg.Node.get_proc_desc node) in - let formal_names = list_map (fun (s, _) -> Mangled.from_string s) formals in + let formal_names = IList.map (fun (s, _) -> Mangled.from_string s) formals in let is_formal pvar = let name = Sil.pvar_get_name pvar in - list_exists (Mangled.equal name) formal_names in + IList.exists (Mangled.equal name) formal_names in let formal_ids = ref [] in let process_formal_letref = function | Sil.Letderef (id, Sil.Lvar pvar, _, _) -> @@ -61,7 +61,7 @@ let check_access access_opt de_opt = !Config.curr_language = Config.Java && Sil.pvar_is_this pvar in if not is_java_this && is_formal pvar then formal_ids := id :: !formal_ids | _ -> () in - list_iter process_formal_letref node_instrs; + IList.iter process_formal_letref node_instrs; !formal_ids in let formal_param_used_in_call = ref false in let has_call_or_sets_null node = @@ -81,14 +81,14 @@ let check_access access_opt de_opt = | Sil.Call (_, _, etl, _, _) -> let formal_ids = find_formal_ids node in let arg_is_formal_param (e, t) = match e with - | Sil.Var id -> list_exists (Ident.equal id) formal_ids + | Sil.Var id -> IList.exists (Ident.equal id) formal_ids | _ -> false in - if list_exists arg_is_formal_param etl then formal_param_used_in_call := true; + if IList.exists arg_is_formal_param etl then formal_param_used_in_call := true; true | Sil.Set (_, _, e, _) -> exp_is_null e | _ -> false in - list_exists filter (Cfg.Node.get_instrs node) in + IList.exists filter (Cfg.Node.get_instrs node) in let local_access_found = ref false in let do_node node = if (Cfg.Node.get_loc node).Location.line = line_number && has_call_or_sets_null node then diff --git a/infer/src/backend/callbacks.ml b/infer/src/backend/callbacks.ml index 175b22711..51dc97054 100644 --- a/infer/src/backend/callbacks.ml +++ b/infer/src/backend/callbacks.ml @@ -40,15 +40,15 @@ let inline_synthetic_method ret_ids etl proc_desc proc_name loc_call : Sil.instr let instr' = Sil.Set (Sil.Lfield (Sil.Lvar pvar, fn, ft), bt , e1, loc_call) in found instr instr' | Sil.Call (ret_ids', Sil.Const (Sil.Cfun pn), etl', loc', cf), _, _ - when list_length ret_ids = list_length ret_ids' - && list_length etl' = list_length etl -> + when IList.length ret_ids = IList.length ret_ids' + && IList.length etl' = IList.length etl -> let instr' = Sil.Call (ret_ids, Sil.Const (Sil.Cfun pn), etl, loc_call, cf) in found instr instr' | Sil.Call (ret_ids', Sil.Const (Sil.Cfun pn), etl', loc', cf), _, _ - when list_length ret_ids = list_length ret_ids' - && list_length etl' + 1 = list_length etl -> - let etl1 = match list_rev etl with (* remove last element *) - | _ :: l -> list_rev l + when IList.length ret_ids = IList.length ret_ids' + && IList.length etl' + 1 = IList.length etl -> + let etl1 = match IList.rev etl with (* remove last element *) + | _ :: l -> IList.rev l | [] -> assert false in let instr' = Sil.Call (ret_ids, Sil.Const (Sil.Cfun pn), etl1, loc_call, cf) in found instr instr' @@ -79,7 +79,7 @@ let proc_inline_synthetic_methods cfg proc_desc : unit = modified := true; instr' in let instrs = Cfg.Node.get_instrs node in - let instrs' = list_map do_instr instrs in + let instrs' = IList.map do_instr instrs in if !modified then Cfg.Node.replace_instrs node instrs' in Cfg.Procdesc.iter_nodes node_inline_synthetic_methods proc_desc @@ -148,7 +148,7 @@ let iterate_procedure_callbacks all_procs exe_env proc_name = Option.may (fun (idenv, tenv, proc_name, proc_desc, language) -> - list_iter + IList.iter (fun (language_opt, proc_callback) -> let language_matches = match language_opt with | Some language -> language = procedure_language @@ -172,25 +172,25 @@ let iterate_cluster_callbacks all_procs exe_env proc_names = with Not_found -> None in let procedure_definitions = - list_map (get_procedure_definition exe_env) proc_names - |> list_flatten_options in + IList.map (get_procedure_definition exe_env) proc_names + |> IList.flatten_options in let environment = - list_map + IList.map (fun (idenv, tenv, proc_name, proc_desc, _) -> (idenv, tenv, proc_name, proc_desc)) procedure_definitions in (** Procedures matching the given language or all if no language is specified. *) let relevant_procedures language_opt = Option.map_default - (fun l -> list_filter (fun p -> l = get_language p) proc_names) + (fun l -> IList.filter (fun p -> l = get_language p) proc_names) proc_names language_opt in - list_iter + IList.iter (fun (language_opt, cluster_callback) -> let proc_names = relevant_procedures language_opt in - if list_length proc_names > 0 then + if IList.length proc_names > 0 then cluster_callback all_procs get_procdesc environment) !cluster_callbacks @@ -210,7 +210,7 @@ let iterate_callbacks store_summary call_graph exe_env = | _ -> "unknown" in let cluster proc_names = let cluster_map = - list_fold_left + IList.fold_left (fun map proc_name -> let proc_cluster = cluster_id proc_name in let bucket = try StringMap.find proc_cluster map with Not_found -> [] in @@ -218,7 +218,7 @@ let iterate_callbacks store_summary call_graph exe_env = StringMap.empty proc_names in (* Return all values of the map *) - list_map snd (StringMap.bindings cluster_map) in + IList.map snd (StringMap.bindings cluster_map) in let reset_summary proc_name = let attributes_opt = Specs.proc_resolve_attributes proc_name in @@ -228,20 +228,18 @@ let iterate_callbacks store_summary call_graph exe_env = if should_reset then Specs.reset_summary call_graph proc_name attributes_opt in - (* Make sure summaries exists. *) - list_iter reset_summary procs_to_analyze; - + IList.iter reset_summary procs_to_analyze; (* Invoke callbacks. *) - list_iter + IList.iter (iterate_procedure_callbacks originally_defined_procs exe_env) procs_to_analyze; - list_iter + IList.iter (iterate_cluster_callbacks originally_defined_procs exe_env) (cluster procs_to_analyze); - list_iter store_summary procs_to_analyze; + IList.iter store_summary procs_to_analyze; Config.curr_language := saved_language diff --git a/infer/src/backend/cfg.ml b/infer/src/backend/cfg.ml index 32b1e3eef..9ac48a43c 100644 --- a/infer/src/backend/cfg.ml +++ b/infer/src/backend/cfg.ml @@ -73,7 +73,7 @@ module Node = struct let id_map = ref IntMap.empty in (* formals are the same if their types are the same *) let formals_eq formals1 formals2 = - list_equal (fun (_, typ1) (_, typ2) -> Sil.typ_compare typ1 typ2) formals1 formals2 in + IList.equal (fun (_, typ1) (_, typ2) -> Sil.typ_compare typ1 typ2) formals1 formals2 in let nodes_eq n1s n2s = (* nodes are the same if they have the same id, instructions, and succs/preds up to renaming with [exp_map] and [id_map] *) @@ -89,7 +89,7 @@ module Node = struct id_map := IntMap.add id1 id2 !id_map; 0 in let instrs_eq instrs1 instrs2 = - list_equal + IList.equal (fun i1 i2 -> let n, exp_map' = Sil.instr_compare_structural i1 i2 !exp_map in exp_map := exp_map'; @@ -97,11 +97,11 @@ module Node = struct instrs1 instrs2 in id_compare n1 n2 = 0 && - list_equal id_compare n1.nd_succs n2.nd_succs && - list_equal id_compare n1.nd_preds n2.nd_preds && + IList.equal id_compare n1.nd_succs n2.nd_succs && + IList.equal id_compare n1.nd_preds n2.nd_preds && instrs_eq n1.nd_instrs n2.nd_instrs in try - list_for_all2 node_eq n1s n2s + IList.for_all2 node_eq n1s n2s with Invalid_argument _ -> false in let att1 = pd1.pd_attributes and att2 = pd2.pd_attributes in att1.ProcAttributes.is_defined = att2.ProcAttributes.is_defined && @@ -202,8 +202,8 @@ module Node = struct let do_node acc n = visited := NodeSet.add n !visited; if f n then NodeSet.singleton n - else NodeSet.union acc (slice_nodes (list_filter (fun s -> not (NodeSet.mem s !visited)) n.nd_succs)) in - list_fold_left do_node NodeSet.empty nodes in + else NodeSet.union acc (slice_nodes (IList.filter (fun s -> not (NodeSet.mem s !visited)) n.nd_succs)) in + IList.fold_left do_node NodeSet.empty nodes in NodeSet.elements (slice_nodes node.nd_succs) let get_sliced_preds node f = @@ -212,8 +212,8 @@ module Node = struct let do_node acc n = visited := NodeSet.add n !visited; if f n then NodeSet.singleton n - else NodeSet.union acc (slice_nodes (list_filter (fun s -> not (NodeSet.mem s !visited)) n.nd_preds)) in - list_fold_left do_node NodeSet.empty nodes in + else NodeSet.union acc (slice_nodes (IList.filter (fun s -> not (NodeSet.mem s !visited)) n.nd_preds)) in + IList.fold_left do_node NodeSet.empty nodes in NodeSet.elements (slice_nodes node.nd_preds) let get_exn node = node.nd_exn @@ -224,7 +224,7 @@ module Node = struct let set_succs_exn node succs exn = node.nd_succs <- succs; node.nd_exn <- exn; - list_iter (fun n -> n.nd_preds <- (node :: n.nd_preds)) succs + IList.iter (fun n -> n.nd_preds <- (node :: n.nd_preds)) succs (** Get the predecessors of the node *) let get_preds node = node.nd_preds @@ -234,9 +234,9 @@ module Node = struct let visited = ref NodeSet.empty in let rec nodes n = visited := NodeSet.add n !visited; - let succs = list_filter (fun n -> not (NodeSet.mem n !visited)) (generator n) in - match list_length succs with - | 1 -> n:: (nodes (list_hd succs)) + let succs = IList.filter (fun n -> not (NodeSet.mem n !visited)) (generator n) in + match IList.length succs with + | 1 -> n:: (nodes (IList.hd succs)) | _ -> [n] in nodes start_node @@ -288,14 +288,14 @@ module Node = struct | _ -> callees end | _ -> callees in - list_fold_left collect [] (get_instrs node) + IList.fold_left collect [] (get_instrs node) (** Get the location of the node *) let get_loc n = n.nd_loc (** Get the source location of the last instruction in the node *) let get_last_loc n = - match list_rev (get_instrs n) with + match IList.rev (get_instrs n) with | instr :: _ -> Sil.instr_get_loc instr | [] -> n.nd_loc @@ -366,7 +366,7 @@ module Node = struct (proc_desc_get_ret_var pdesc, ret_type) in let construct_decl (x, typ) = (Sil.mk_pvar x proc_name, typ) in - let ptl = ret_var :: list_map construct_decl locals in + let ptl = ret_var :: IList.map construct_decl locals in let instr = Sil.Declare_locals (ptl, loc) in prepend_instrs_temps node [instr] [] @@ -375,7 +375,7 @@ module Node = struct let remove_node' filter_out_fun cfg node = let remove_node_in_cfg nodes = - list_filter filter_out_fun nodes in + IList.filter filter_out_fun nodes in cfg.node_list := remove_node_in_cfg !(cfg.node_list) let remove_node cfg node = @@ -390,7 +390,7 @@ module Node = struct (if remove_nodes then let pdesc = pdesc_tbl_find cfg name in let proc_nodes = - list_fold_right (fun node set -> NodeSet.add node set) + IList.fold_right (fun node set -> NodeSet.add node set) pdesc.pd_nodes NodeSet.empty in remove_node_set cfg proc_nodes); pdesc_tbl_remove cfg name @@ -418,7 +418,7 @@ module Node = struct | None -> node.nd_dist_exit <- Some dist; next_nodes := node.nd_preds @ !next_nodes in - list_iter do_node nodes; + IList.iter do_node nodes; if !next_nodes != [] then mark_distance (dist + 1) !next_nodes in mark_distance 0 [exit_node] @@ -488,8 +488,8 @@ module Node = struct let nodes = proc_desc_get_nodes proc_desc in let do_node node = incr num_nodes; - num_edges := !num_edges + list_length (get_succs node) in - list_iter do_node nodes; + num_edges := !num_edges + IList.length (get_succs node) in + IList.iter do_node nodes; let cyclo = !num_edges - !num_nodes + 2 * num_connected in (* formula for cyclomatic complexity *) cyclo @@ -545,19 +545,19 @@ module Node = struct pp_to_string pp () let proc_desc_iter_nodes f proc_desc = - list_iter f (list_rev (proc_desc_get_nodes proc_desc)) + IList.iter f (IList.rev (proc_desc_get_nodes proc_desc)) let proc_desc_fold_nodes f acc proc_desc = - (*list_fold_left (fun acc node -> f acc node) acc (list_rev (proc_desc_get_nodes proc_desc))*) - list_fold_left f acc (list_rev (proc_desc_get_nodes proc_desc)) + (*list_fold_left (fun acc node -> f acc node) acc (IList.rev (proc_desc_get_nodes proc_desc))*) + IList.fold_left f acc (IList.rev (proc_desc_get_nodes proc_desc)) (** iterate over the calls from the procedure: (callee,location) pairs *) let proc_desc_iter_calls f pdesc = let do_node node = - list_iter + IList.iter (fun callee_pname -> f (callee_pname, get_loc node)) (get_callees node) in - list_iter do_node (proc_desc_get_nodes pdesc) + IList.iter do_node (proc_desc_get_nodes pdesc) let proc_desc_iter_slope f proc_desc = let visited = ref NodeSet.empty in @@ -587,19 +587,19 @@ module Node = struct let proc_desc_iter_slope_calls f proc_desc = let do_node node = - list_iter + IList.iter (fun callee_pname -> f callee_pname) (get_callees node) in proc_desc_iter_slope do_node proc_desc let proc_desc_iter_instrs f proc_desc = let do_node node = - list_iter (fun i -> f node i) (get_instrs node) in + IList.iter (fun i -> f node i) (get_instrs node) in proc_desc_iter_nodes do_node proc_desc let proc_desc_fold_instrs f acc proc_desc = let fold_node acc node = - list_fold_left (fun acc instr -> f acc node instr) acc (get_instrs node) in + IList.fold_left (fun acc instr -> f acc node instr) acc (get_instrs node) in proc_desc_fold_nodes fold_node acc proc_desc end @@ -690,11 +690,11 @@ let get_all_procs cfg = (** Get the procedures whose body is defined in this cfg *) let get_defined_procs cfg = - list_filter Procdesc.is_defined (get_all_procs cfg) + IList.filter Procdesc.is_defined (get_all_procs cfg) (** Get the objc procedures whose body is generated *) let get_objc_generated_procs cfg = - list_filter ( + IList.filter ( fun procdesc -> (Procdesc.get_attributes procdesc).ProcAttributes.is_generated) (get_all_procs cfg) @@ -713,7 +713,7 @@ let add_removetemps_instructions cfg = let loc = Node.get_last_loc node in let temps = Node.get_temps node in if temps != [] then Node.append_instrs_temps node [Sil.Remove_temps (temps, loc)] [] in - list_iter do_node all_nodes + IList.iter do_node all_nodes (** add instructions to perform abstraction *) let add_abstraction_instructions cfg = @@ -722,10 +722,10 @@ let add_abstraction_instructions cfg = | Node.Exit_node _ -> true | _ -> false in let succ_nodes = Node.get_succs node in - if list_exists is_exit succ_nodes then true + if IList.exists is_exit succ_nodes then true else match succ_nodes with | [] -> false - | [h] -> list_length (Node.get_preds h) > 1 + | [h] -> IList.length (Node.get_preds h) > 1 | _ -> false in let node_requires_abstraction node = match Node.get_kind node with @@ -741,7 +741,7 @@ let add_abstraction_instructions cfg = let do_node node = let loc = Node.get_last_loc node in if node_requires_abstraction node then Node.append_instrs_temps node [Sil.Abstract loc] [] in - list_iter do_node all_nodes + IList.iter do_node all_nodes let get_name_of_parameter (curr_f : Procdesc.t) (x, typ) = Sil.mk_pvar (Mangled.from_string x) (Procdesc.get_proc_name curr_f) @@ -760,8 +760,8 @@ let get_name_of_objc_static_locals (curr_f : Procdesc.t) p = match hpred with | Sil.Hpointsto(e, _, _) -> [local_static e] | _ -> [] in - let vars_sigma = list_map hpred_local_static (Prop.get_sigma p) in - list_flatten (list_flatten vars_sigma) + let vars_sigma = IList.map hpred_local_static (Prop.get_sigma p) in + IList.flatten (IList.flatten vars_sigma) (* returns a list of local variables that points to an objc block in a proposition *) let get_name_of_objc_block_locals p = @@ -774,8 +774,8 @@ let get_name_of_objc_block_locals p = match hpred with | Sil.Hpointsto(e, _, _) -> [local_blocks e] | _ -> [] in - let vars_sigma = list_map hpred_local_blocks (Prop.get_sigma p) in - list_flatten (list_flatten vars_sigma) + let vars_sigma = IList.map hpred_local_blocks (Prop.get_sigma p) in + IList.flatten (IList.flatten vars_sigma) let remove_abducted_retvars p = (* compute the hpreds and pure atoms reachable from the set of seed expressions in [exps] *) @@ -785,10 +785,10 @@ let remove_abducted_retvars p = | Sil.Eexp (Sil.Const (Sil.Cexn e), _) -> Sil.ExpSet.add e exps | Sil.Eexp (e, _) -> Sil.ExpSet.add e exps | Sil.Estruct (flds, _) -> - list_fold_left (fun exps (_, strexp) -> collect_exps exps strexp) exps flds + IList.fold_left (fun exps (_, strexp) -> collect_exps exps strexp) exps flds | Sil.Earray (_, elems, _) -> - list_fold_left (fun exps (index, strexp) -> collect_exps exps strexp) exps elems in + IList.fold_left (fun exps (index, strexp) -> collect_exps exps strexp) exps elems in let rec compute_reachable_hpreds_rec sigma (reach, exps) = let add_hpred_if_reachable (reach, exps) = function | Sil.Hpointsto (lhs, rhs, _) as hpred when Sil.ExpSet.mem lhs exps -> @@ -796,7 +796,7 @@ let remove_abducted_retvars p = let exps' = collect_exps exps rhs in (reach', exps') | _ -> reach, exps in - let reach', exps' = list_fold_left add_hpred_if_reachable (reach, exps) sigma in + let reach', exps' = IList.fold_left add_hpred_if_reachable (reach, exps) sigma in if (Sil.HpredSet.cardinal reach) = (Sil.HpredSet.cardinal reach') then (reach, exps) else compute_reachable_hpreds_rec sigma (reach', exps') in let reach_hpreds, reach_exps = @@ -808,14 +808,14 @@ let remove_abducted_retvars p = | Sil.UnOp (_, e, _) | Sil.Cast (_, e) | Sil.Lfield (e, _, _) -> exp_contains e | Sil.BinOp (_, e0, e1) | Sil.Lindex (e0, e1) -> exp_contains e0 || exp_contains e1 | _ -> false in - list_filter + IList.filter (function | Sil.Aeq (lhs, rhs) | Sil.Aneq (lhs, rhs) -> exp_contains lhs || exp_contains rhs) pi in Sil.HpredSet.elements reach_hpreds, reach_pi in (* separate the abducted pvars from the normal ones, deallocate the abducted ones*) let abducted_pvars, normal_pvars = - list_fold_left + IList.fold_left (fun pvars hpred -> match hpred with | Sil.Hpointsto (Sil.Lvar pvar, _, _) -> @@ -827,7 +827,7 @@ let remove_abducted_retvars p = (Prop.get_sigma p) in let _, p' = Prop.deallocate_stack_vars p abducted_pvars in let normal_pvar_set = - list_fold_left + IList.fold_left (fun normal_pvar_set pvar -> Sil.ExpSet.add (Sil.Lvar pvar) normal_pvar_set) Sil.ExpSet.empty normal_pvars in @@ -836,7 +836,7 @@ let remove_abducted_retvars p = Prop.normalize (Prop.replace_pi pi_reach (Prop.replace_sigma sigma_reach p')) let remove_locals (curr_f : Procdesc.t) p = - let names_of_locals = list_map (get_name_of_local curr_f) (Procdesc.get_locals curr_f) in + let names_of_locals = IList.map (get_name_of_local curr_f) (Procdesc.get_locals curr_f) in let names_of_locals' = match !Config.curr_language with | Config.C_CPP -> (* in ObjC to deal with block we need to remove static locals *) let names_of_static_locals = get_name_of_objc_static_locals curr_f p in @@ -847,7 +847,7 @@ let remove_locals (curr_f : Procdesc.t) p = (removed, if !Config.angelic_execution then remove_abducted_retvars p' else p') let remove_formals (curr_f : Procdesc.t) p = - let names_of_formals = list_map (get_name_of_parameter curr_f) (Procdesc.get_formals curr_f) in + let names_of_formals = IList.map (get_name_of_parameter curr_f) (Procdesc.get_formals curr_f) in Prop.deallocate_stack_vars p names_of_formals (** remove the return variable from the prop *) @@ -874,7 +874,7 @@ let remove_seed_vars (prop: 'a Prop.t) : Prop.normal Prop.t = | Sil.Hpointsto(Sil.Lvar pv, _, _) -> not (Sil.pvar_is_seed pv) | _ -> true in let sigma = Prop.get_sigma prop in - let sigma' = list_filter hpred_not_seed sigma in + let sigma' = IList.filter hpred_not_seed sigma in Prop.normalize (Prop.replace_sigma sigma' prop) (** checks whether a cfg is connected or not *) @@ -887,26 +887,26 @@ let check_cfg_connectedness cfg = let succs = Node.get_succs n in let preds = Node.get_preds n in match Node.get_kind n with - | Node.Start_node _ -> (list_length succs = 0) || (list_length preds > 0) - | Node.Exit_node _ -> (list_length succs > 0) || (list_length preds = 0) + | Node.Start_node _ -> (IList.length succs = 0) || (IList.length preds > 0) + | Node.Exit_node _ -> (IList.length succs > 0) || (IList.length preds = 0) | Node.Stmt_node _ | Node.Prune_node _ - | Node.Skip_node _ -> (list_length succs = 0) || (list_length preds = 0) + | Node.Skip_node _ -> (IList.length succs = 0) || (IList.length preds = 0) | Node.Join_node -> (* Join node has the exception that it may be without predecessors and pointing to an exit node *) (* if the if brances end with a return *) (match succs with | [n'] when is_exit_node n' -> false - | _ -> (list_length preds = 0)) in + | _ -> (IList.length preds = 0)) in let do_pdesc pd = let pname = Procname.to_string (Procdesc.get_proc_name pd) in let nodes = Procdesc.get_nodes pd in - let broken = list_exists broken_node nodes in + let broken = IList.exists broken_node nodes in if broken then L.out "\n ***BROKEN CFG: '%s'\n" pname else L.out "\n ***CONNECTED CFG: '%s'\n" pname in let pdescs = get_all_procs cfg in - list_iter do_pdesc pdescs + IList.iter do_pdesc pdescs (** Given a mangled name of a block return its procdesc if exists*) let get_block_pdesc cfg block = @@ -915,7 +915,7 @@ let get_block_pdesc cfg block = let name = Procdesc.get_proc_name pd in (Procname.to_string name) = (Mangled.to_string block) in try - let block_pdesc = list_find is_block_pdesc pdescs in + let block_pdesc = IList.find is_block_pdesc pdescs in Some block_pdesc with Not_found -> None @@ -929,10 +929,10 @@ let remove_seed_captured_vars_block captured_vars prop = let hpred_seed_captured = function | Sil.Hpointsto(Sil.Lvar pv, _, _) -> let pname = Sil.pvar_get_name pv in - (Sil.pvar_is_seed pv) && (list_mem is_captured pname captured_vars) + (Sil.pvar_is_seed pv) && (IList.mem is_captured pname captured_vars) | _ -> false in let sigma = Prop.get_sigma prop in - let sigma' = list_filter (fun hpred -> not (hpred_seed_captured hpred)) sigma in + let sigma' = IList.filter (fun hpred -> not (hpred_seed_captured hpred)) sigma in Prop.normalize (Prop.replace_sigma sigma' prop) (** Serializer for control flow graphs *) @@ -984,7 +984,7 @@ let save_attributes filename cfg = (Location.to_string loc); *) AttributesTable.store_attributes attributes' in - list_iter save_proc (get_all_procs cfg) + IList.iter save_proc (get_all_procs cfg) (** Save a cfg into a file *) let store_cfg_to_file (filename : DB.filename) (save_sources : bool) (cfg : cfg) = diff --git a/infer/src/backend/cg.ml b/infer/src/backend/cg.ml index b6066eae7..e3e401129 100644 --- a/infer/src/backend/cg.ml +++ b/infer/src/backend/cg.ml @@ -167,7 +167,7 @@ let node_map_iter f g = let table = ref [] in Procname.Hash.iter (fun node info -> table := (node, info) :: !table) g.node_map; let cmp ((n1: Procname.t), _) ((n2: Procname.t), _) = Procname.compare n1 n2 in - list_iter (fun (n, info) -> f n info) (list_sort cmp !table) + IList.iter (fun (n, info) -> f n info) (IList.sort cmp !table) (** If not None, restrict defined nodes to the given set, and mark them as disabled. *) @@ -191,8 +191,8 @@ let get_nodes (g: t) = !nodes let map_option f l = - let lo = list_filter (function | Some _ -> true | None -> false) (list_map f l) in - list_map (function Some p -> p | None -> assert false) lo + let lo = IList.filter (function | Some _ -> true | None -> false) (IList.map f l) in + IList.map (function Some p -> p | None -> assert false) lo let compute_calls g node = { in_calls = Procname.Set.cardinal (get_ancestors g node); @@ -210,10 +210,10 @@ let get_calls (g: t) node = let get_all_nodes (g: t) = let nodes = Procname.Set.elements (get_nodes g) in - list_map (fun node -> (node, get_calls g node)) nodes + IList.map (fun node -> (node, get_calls g node)) nodes let get_nodes_and_calls (g: t) = - list_filter (fun (n, calls) -> node_defined g n) (get_all_nodes g) + IList.filter (fun (n, calls) -> node_defined g n) (get_all_nodes g) let node_get_num_ancestors g n = (n, Procname.Set.cardinal (get_ancestors g n)) @@ -280,7 +280,7 @@ let get_nodes_and_defined_children (g: t) = let nodes = ref Procname.Set.empty in node_map_iter (fun n info -> if info.defined then nodes := Procname.Set.add n !nodes) g; let nodes_list = Procname.Set.elements !nodes in - list_map (fun n -> (n, get_defined_children g n)) nodes_list + IList.map (fun n -> (n, get_defined_children g n)) nodes_list type nodes_and_edges = (node * bool * bool) list * (* nodes with defined and disabled flag *) @@ -302,8 +302,8 @@ let get_nodes_and_edges (g: t) : nodes_and_edges = let get_defined_nodes (g: t) = let (nodes, _) = get_nodes_and_edges g in let get_node (node, _, _) = node in - list_map get_node - (list_filter (fun (_, defined, _) -> defined) + IList.map get_node + (IList.filter (fun (_, defined, _) -> defined) nodes) @@ -312,8 +312,8 @@ let get_defined_nodes (g: t) = let get_originally_defined_nodes (g: t) = let (nodes, _) = get_nodes_and_edges g in let get_node (node, _, _) = node in - list_map get_node - (list_filter + IList.map get_node + (IList.filter (fun (_, defined, disabled) -> defined || disabled) nodes) @@ -328,8 +328,8 @@ let get_nLOC (g: t) = (** [extend cg1 gc2] extends [cg1] in place with nodes and edges from [gc2]; undefined nodes become defined if at least one side is. *) let extend cg_old cg_new = let nodes, edges = get_nodes_and_edges cg_new in - list_iter (fun (node, defined, disabled) -> _add_node cg_old node defined disabled) nodes; - list_iter (fun (nfrom, nto) -> add_edge cg_old nfrom nto) edges + IList.iter (fun (node, defined, disabled) -> _add_node cg_old node defined disabled) nodes; + IList.iter (fun (nfrom, nto) -> add_edge cg_old nfrom nto) edges (** Begin support for serialization *) @@ -341,12 +341,12 @@ let load_from_file (filename : DB.filename) : t option = match Serialization.from_file callgraph_serializer filename with | None -> None | Some (source, nLOC, (nodes, edges)) -> - list_iter + IList.iter (fun (node, defined, disabled) -> if defined then add_defined_node g node; if disabled then add_disabled_node g node) nodes; - list_iter (fun (nfrom, nto) -> add_edge g nfrom nto) edges; + IList.iter (fun (nfrom, nto) -> add_edge g nfrom nto) edges; g.source <- source; g.nLOC <- nLOC; Some g @@ -357,7 +357,7 @@ let store_to_file (filename : DB.filename) (call_graph : t) = let pp_graph_dotty get_specs (g: t) fmt = let nodes_with_calls = get_all_nodes g in - let num_specs n = try list_length (get_specs n) with exn when exn_not_timeout exn -> - 1 in + let num_specs n = try IList.length (get_specs n) with exn when exn_not_timeout exn -> - 1 in let get_color (n, calls) = if num_specs n != 0 then "green" else "red" in let get_shape (n, calls) = @@ -367,8 +367,8 @@ let pp_graph_dotty get_specs (g: t) fmt = let pp_node_label fmt (n, calls) = F.fprintf fmt "\"%a | calls=%d %d | specs=%d)\"" Procname.pp n calls.in_calls calls.out_calls (num_specs n) in F.fprintf fmt "digraph {@\n"; - list_iter (fun nc -> F.fprintf fmt "%a [shape=box,label=%a,color=%s,shape=%s]@\n" pp_node nc pp_node_label nc (get_color nc) (get_shape nc)) nodes_with_calls; - list_iter (fun (s, d) -> F.fprintf fmt "%a -> %a@\n" pp_node s pp_node d) (get_edges g); + IList.iter (fun nc -> F.fprintf fmt "%a [shape=box,label=%a,color=%s,shape=%s]@\n" pp_node nc pp_node_label nc (get_color nc) (get_shape nc)) nodes_with_calls; + IList.iter (fun (s, d) -> F.fprintf fmt "%a -> %a@\n" pp_node s pp_node d) (get_edges g); F.fprintf fmt "}@." (** Print the current call graph as a dotty file. If the filename is [None], use the current file dir inside the DB dir. *) diff --git a/infer/src/backend/cluster.ml b/infer/src/backend/cluster.ml index 10d8aced3..74e645e73 100644 --- a/infer/src/backend/cluster.ml +++ b/infer/src/backend/cluster.ml @@ -75,7 +75,7 @@ let create_ondemand source_dir = | None -> [[ce]] | Some defined_procs -> - list_map mk_cluster defined_procs in + IList.map mk_cluster defined_procs in clusters let create_bottomup source_file naprocs active_procs = @@ -86,16 +86,16 @@ let create_bottomup source_file naprocs active_procs = ce_ondemand = None; } -let cluster_nfiles cluster = list_length cluster +let cluster_nfiles cluster = IList.length cluster let cluster_naprocs cluster = - list_fold_left (fun n ce -> ce.ce_naprocs + n) 0 cluster + IList.fold_left (fun n ce -> ce.ce_naprocs + n) 0 cluster let clusters_nfiles clusters = - list_fold_left (fun n cluster -> cluster_nfiles cluster + n) 0 clusters + IList.fold_left (fun n cluster -> cluster_nfiles cluster + n) 0 clusters let clusters_naprocs clusters = - list_fold_left (fun n cluster -> cluster_naprocs cluster + n) 0 clusters + IList.fold_left (fun n cluster -> cluster_naprocs cluster + n) 0 clusters let print_clusters_stats clusters = let pp_cluster num cluster = @@ -104,7 +104,7 @@ let print_clusters_stats clusters = (cluster_nfiles cluster) (cluster_naprocs cluster) in let i = ref 0 in - list_iter + IList.iter (fun cluster -> incr i; pp_cluster !i cluster) @@ -112,7 +112,7 @@ let print_clusters_stats clusters = let cluster_split_prefix (cluster : t) size = let rec split (cluster_seen : t) (cluster_todo : t) n = - if n <= 0 then (list_rev cluster_seen, cluster_todo) + if n <= 0 then (IList.rev cluster_seen, cluster_todo) else match cluster_todo with | [] -> raise Not_found | ce :: todo' -> split (ce :: cluster_seen) todo' (n - ce.ce_naprocs) in @@ -137,7 +137,7 @@ let combine_split_clusters (clusters : t list) max_size desired_size = L.err "current size: %d@." !current_size; assert false end; - let next_cluster = list_hd !old_clusters in + let next_cluster = IList.hd !old_clusters in let next_size = cluster_naprocs next_cluster in let new_size = !current_size + next_size in if (new_size > max_size || new_size > desired_size) && !current_size > 0 then @@ -152,13 +152,13 @@ let combine_split_clusters (clusters : t list) max_size desired_size = current := []; current_size := 0; new_clusters := !new_clusters @ [next_cluster']; - old_clusters := next_cluster'' :: (list_tl !old_clusters) + old_clusters := next_cluster'' :: (IList.tl !old_clusters) end else begin current := !current @ next_cluster; current_size := !current_size + next_size; - old_clusters := list_tl !old_clusters + old_clusters := IList.tl !old_clusters end done; if !current_size > 0 then new_clusters := !new_clusters @ [!current]; @@ -175,8 +175,8 @@ let get_active_procs cluster = let add proc = if not (Procname.Set.mem proc !procset) then procset := Procname.Set.add proc !procset in - list_iter add cluster_elem.ce_active_procs in - list_iter do_cluster_elem cluster; + IList.iter add cluster_elem.ce_active_procs in + IList.iter do_cluster_elem cluster; Some !procset let cl_name n = "cl" ^ string_of_int n diff --git a/infer/src/backend/clusterMakefile.ml b/infer/src/backend/clusterMakefile.ml index 53631e7fd..af225a178 100644 --- a/infer/src/backend/clusterMakefile.ml +++ b/infer/src/backend/clusterMakefile.ml @@ -39,7 +39,7 @@ let create_cluster_makefile_and_exit let fmt = Format.formatter_of_out_channel outc in let file_to_cluster = ref DB.SourceFileMap.empty in let cluster_nr = ref 0 in - let tot_clusters_nr = list_length clusters in + let tot_clusters_nr = IList.length clusters in let do_cluster cluster = incr cluster_nr; let dependent_clusters = ref IntSet.empty in @@ -69,12 +69,12 @@ let create_cluster_makefile_and_exit file_to_cluster := DB.SourceFileMap.add source_file !cluster_nr !file_to_cluster; () (* L.err "file %s has %d children@." file (StringSet.cardinal children) *) in - list_iter do_file cluster; + IList.iter do_file cluster; Cluster.pp_cluster_dependency !cluster_nr tot_clusters_nr cluster print_files fmt (IntSet.elements !dependent_clusters); (* L.err "cluster %d has %d dependencies@." !cluster_nr (IntSet.cardinal !dependent_clusters) *) in pp_prolog fmt tot_clusters_nr; - list_iter do_cluster clusters; + IList.iter do_cluster clusters; pp_epilog fmt (); exit 0 diff --git a/infer/src/backend/dom.ml b/infer/src/backend/dom.ml index 933ed7907..2918f1d80 100644 --- a/infer/src/backend/dom.ml +++ b/infer/src/backend/dom.ml @@ -49,19 +49,19 @@ let sigma_equal sigma1 sigma2 = match (sigma1_rest, sigma2_rest) with | [], [] -> () | [], _:: _ | _:: _, [] -> - (L.d_strln "failure reason 1"; raise Fail) + (L.d_strln "failure reason 1"; raise IList.Fail) | hpred1:: sigma1_rest', hpred2:: sigma2_rest' -> if Sil.hpred_equal hpred1 hpred2 then f sigma1_rest' sigma2_rest' - else (L.d_strln "failure reason 2"; raise Fail) in - let sigma1_sorted = list_sort Sil.hpred_compare sigma1 in - let sigma2_sorted = list_sort Sil.hpred_compare sigma2 in + else (L.d_strln "failure reason 2"; raise IList.Fail) in + let sigma1_sorted = IList.sort Sil.hpred_compare sigma1 in + let sigma2_sorted = IList.sort Sil.hpred_compare sigma2 in f sigma1_sorted sigma2_sorted let sigma_get_start_lexps_sort sigma = let exp_compare_neg e1 e2 = - (Sil.exp_compare e1 e2) in let filter e = Sil.fav_for_all (Sil.exp_fav e) Ident.is_normal in let lexps = Sil.hpred_list_get_lexps filter sigma in - list_sort exp_compare_neg lexps + IList.sort exp_compare_neg lexps (** {2 Utility functions for side} *) @@ -163,14 +163,14 @@ end = struct let new_c = lookup_const' const_tbl new_r in let old_c = lookup_const' const_tbl old_r in let res_c = Sil.ExpSet.union new_c old_c in - if Sil.ExpSet.cardinal res_c > 1 then (L.d_strln "failure reason 3"; raise Fail); + if Sil.ExpSet.cardinal res_c > 1 then (L.d_strln "failure reason 3"; raise IList.Fail); Hashtbl.replace tbl old_r new_r; Hashtbl.replace const_tbl new_r res_c let replace_const' tbl const_tbl e c = let r = find' tbl e in let set = Sil.ExpSet.add c (lookup_const' const_tbl r) in - if Sil.ExpSet.cardinal set > 1 then (L.d_strln "failure reason 4"; raise Fail); + if Sil.ExpSet.cardinal set > 1 then (L.d_strln "failure reason 4"; raise IList.Fail); Hashtbl.replace const_tbl r set let add side e e' = @@ -186,34 +186,34 @@ end = struct | true, true -> union' tbl const_tbl e e' | true, false -> replace_const' tbl const_tbl e e' | false, true -> replace_const' tbl const_tbl e' e - | _ -> L.d_strln "failure reason 5"; raise Fail + | _ -> L.d_strln "failure reason 5"; raise IList.Fail end | Sil.Var id, Sil.Const _ | Sil.Var id, Sil.Lvar _ -> if (can_rename id) then replace_const' tbl const_tbl e e' - else (L.d_strln "failure reason 6"; raise Fail) + else (L.d_strln "failure reason 6"; raise IList.Fail) | Sil.Const _, Sil.Var id' | Sil.Lvar _, Sil.Var id' -> if (can_rename id') then replace_const' tbl const_tbl e' e - else (L.d_strln "failure reason 7"; raise Fail) + else (L.d_strln "failure reason 7"; raise IList.Fail) | _ -> - if not (Sil.exp_equal e e') then (L.d_strln "failure reason 8"; raise Fail) else () + if not (Sil.exp_equal e e') then (L.d_strln "failure reason 8"; raise IList.Fail) else () let check side es = let f = function Sil.Var id -> can_rename id | _ -> false in - let vars, nonvars = list_partition f es in + let vars, nonvars = IList.partition f es in let tbl, const_tbl = match side with | Lhs -> equiv_tbl1, const_tbl1 | Rhs -> equiv_tbl2, const_tbl2 in - if (list_length nonvars > 1) then false + if (IList.length nonvars > 1) then false else match vars, nonvars with | [], _ | [_], [] -> true | v:: vars', _ -> let r = find' tbl v in let set = lookup_const' const_tbl r in - (list_for_all (fun v' -> Sil.exp_equal (find' tbl v') r) vars') && - (list_for_all (fun c -> Sil.ExpSet.mem c set) nonvars) + (IList.for_all (fun v' -> Sil.exp_equal (find' tbl v') r) vars') && + (IList.for_all (fun c -> Sil.ExpSet.mem c set) nonvars) end @@ -240,7 +240,7 @@ end = struct let get_lexp_set' sigma = let lexp_lst = Sil.hpred_list_get_lexps (fun _ -> true) sigma in - list_fold_left (fun set e -> Sil.ExpSet.add e set) Sil.ExpSet.empty lexp_lst + IList.fold_left (fun set e -> Sil.ExpSet.add e set) Sil.ExpSet.empty lexp_lst let init sigma1 sigma2 = lexps1 := get_lexp_set' sigma1; lexps2 := get_lexp_set' sigma2 @@ -276,13 +276,13 @@ module CheckJoinPre : InfoLossCheckerSig = struct let side_op = opposite side in match e with | Sil.Lvar _ -> false - | Sil.Var id when Ident.is_normal id -> list_length es >= 1 + | Sil.Var id when Ident.is_normal id -> IList.length es >= 1 | Sil.Var id -> if !Config.join_cond = 0 then - list_exists (Sil.exp_equal Sil.exp_zero) es + IList.exists (Sil.exp_equal Sil.exp_zero) es else if Dangling.check side e then begin - let r = list_exists (fun e' -> not (Dangling.check side_op e')) es in + let r = IList.exists (fun e' -> not (Dangling.check side_op e')) es in if r then begin L.d_str ".... Dangling Check (dang e:"; Sil.d_exp e; L.d_str ") (? es:"; Sil.d_exp_list es; L.d_strln ") ...."; @@ -292,7 +292,7 @@ module CheckJoinPre : InfoLossCheckerSig = struct end else begin - let r = list_exists (Dangling.check side_op) es in + let r = IList.exists (Dangling.check side_op) es in if r then begin L.d_str ".... Dangling Check (notdang e:"; Sil.d_exp e; L.d_str ") (? es:"; Sil.d_exp_list es; L.d_strln ") ...."; @@ -325,7 +325,7 @@ module CheckJoinPost : InfoLossCheckerSig = struct let fail_case side e es = match e with | Sil.Lvar _ -> false - | Sil.Var id when Ident.is_normal id -> list_length es >= 1 + | Sil.Var id when Ident.is_normal id -> IList.length es >= 1 | Sil.Var id -> false | _ -> false @@ -476,7 +476,7 @@ end = struct let get_fresh_exp e1 e2 = try - let (_, _, e) = list_find (fun (e1', e2', _) -> Sil.exp_equal e1 e1' && Sil.exp_equal e2 e2') !t in + let (_, _, e) = IList.find (fun (e1', e2', _) -> Sil.exp_equal e1 e1' && Sil.exp_equal e2 e2') !t in e with Not_found -> let e = Sil.exp_get_undefined (JoinState.get_footprint ()) in @@ -485,7 +485,7 @@ end = struct let lookup side e = try - let (e1, e2, e) = list_find (fun (e1', e2', _) -> Sil.exp_equal e (select side e1' e2')) !t in + let (e1, e2, e) = IList.find (fun (e1', e2', _) -> Sil.exp_equal e (select side e1' e2')) !t in Some (e, select (opposite side) e1 e2) with Not_found -> None @@ -495,10 +495,10 @@ end = struct let ineq_upper = Prop.mk_inequality (Sil.BinOp(Sil.Le, e, upper)) in ineq_lower:: ineq_upper:: acc - let minus2_to_2 = list_map Sil.Int.of_int [-2; -1; 0; 1; 2] + let minus2_to_2 = IList.map Sil.Int.of_int [-2; -1; 0; 1; 2] let get_induced_pi () = - let t_sorted = list_sort entry_compare !t in + let t_sorted = IList.sort entry_compare !t in let add_and_chk_eq e1 e1' n = match e1, e1' with @@ -511,7 +511,7 @@ end = struct | [] -> eqs_acc, t_seen | ((e1', e2', e') as entry'):: t_rest' -> try - let n = list_find (fun n -> add_and_chk_eq e1 e1' n && add_and_chk_eq e2 e2' n) minus2_to_2 in + 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' @@ -534,7 +534,7 @@ end = struct let e_upper1 = Sil.exp_int upper1 in get_induced_atom acc e_strict_lower1 e_upper1 e | _ -> acc in - list_fold_left f_ineqs eqs t_minimal + IList.fold_left f_ineqs eqs t_minimal end @@ -577,7 +577,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' = list_filter f !tbl in + let t' = IList.filter f !tbl in tbl := t'; t' @@ -592,19 +592,19 @@ end = struct | Sil.Lvar _ | Sil.Var _ | Sil.BinOp (Sil.PlusA, Sil.Var _, _) -> let is_same_e (e1, e2, _) = Sil.exp_equal e (select side e1 e2) in - let assoc = list_filter is_same_e !tbl in - list_map (fun (e1, e2, _) -> select side_op e1 e2) assoc + let assoc = IList.filter 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 (); - raise Fail in + raise IList.Fail in lost_little side e assoc_es in - let lhs_es = list_map (fun (e1, _, _) -> e1) !tbl in - let rhs_es = list_map (fun (_, e2, _) -> e2) !tbl in - (list_for_all (f Rhs) rhs_es) && (list_for_all (f Lhs) lhs_es) + let lhs_es = IList.map (fun (e1, _, _) -> e1) !tbl in + let rhs_es = IList.map (fun (_, e2, _) -> e2) !tbl in + (IList.for_all (f Rhs) rhs_es) && (IList.for_all (f Lhs) lhs_es) let lookup_side' side e = let f (e1, e2, _) = Sil.exp_equal e (select side e1 e2) in - list_filter f !tbl + IList.filter f !tbl let lookup_side_induced' side e = let res = ref [] in @@ -621,8 +621,8 @@ end = struct res := v'::!res | _ -> () in begin - list_iter f !tbl; - list_rev !res + IList.iter f !tbl; + IList.rev !res end (* Return the triple whose side is [e], if it exists unique *) @@ -633,30 +633,30 @@ end = struct let r = lookup_side' side e in match r with | [(e1, e2, id) as t] -> if todo then Todo.push t; id - | _ -> L.d_strln "failure reason 9"; raise Fail + | _ -> L.d_strln "failure reason 9"; raise IList.Fail end | Sil.Var _ | Sil.Const _ | Sil.Lvar _ -> if todo then Todo.push (e, e, e); e - | _ -> L.d_strln "failure reason 10"; raise Fail + | _ -> L.d_strln "failure reason 10"; raise IList.Fail let lookup side e = lookup' false side e let lookup_todo side e = lookup' true side e - let lookup_list side l = list_map (lookup side) l - let lookup_list_todo side l = list_map (lookup_todo side) l + let lookup_list side l = IList.map (lookup side) l + let lookup_list_todo side l = IList.map (lookup_todo side) l let to_subst_proj (side: side) vars = let renaming_restricted = - list_filter (function (_, _, Sil.Var i) -> Sil.fav_mem vars i | _ -> assert false) !tbl in + IList.filter (function (_, _, Sil.Var i) -> Sil.fav_mem vars i | _ -> assert false) !tbl in let sub_list_side = - list_map + IList.map (function (e1, e2, Sil.Var i) -> (i, select side e1 e2) | _ -> assert false) renaming_restricted in let sub_list_side_sorted = - list_sort (fun (i, e) (i', e') -> Sil.exp_compare e e') sub_list_side in + IList.sort (fun (i, e) (i', e') -> Sil.exp_compare e e') sub_list_side in let rec find_duplicates = function | (i, e):: ((i', e'):: l' as t) -> Sil.exp_equal e e' || find_duplicates t | _ -> false in - if find_duplicates sub_list_side_sorted then (L.d_strln "failure reason 11"; raise Fail) + if find_duplicates sub_list_side_sorted then (L.d_strln "failure reason 11"; raise IList.Fail) else Sil.sub_of_list sub_list_side let to_subst_emb (side : side) = @@ -665,25 +665,25 @@ end = struct match select side e1 e2 with | Sil.Var i -> can_rename i | _ -> false in - list_filter pick_id_case !tbl in + IList.filter pick_id_case !tbl in let sub_list = let project (e1, e2, e) = match select side e1 e2 with | Sil.Var i -> (i, e) | _ -> assert false in - list_map project renaming_restricted in + IList.map project renaming_restricted in let sub_list_sorted = let compare (i, _) (i', _) = Ident.compare i i' in - list_sort compare sub_list in + IList.sort compare sub_list in let rec find_duplicates = function | (i, _):: ((i', _):: l' as t) -> Ident.equal i i' || find_duplicates t | _ -> false in - if find_duplicates sub_list_sorted then (L.d_strln "failure reason 12"; raise Fail) + if find_duplicates sub_list_sorted then (L.d_strln "failure reason 12"; raise IList.Fail) else Sil.sub_of_list sub_list_sorted let get e1 e2 = let f (e1', e2', _) = Sil.exp_equal e1 e1' && Sil.exp_equal e2 e2' in - match (list_filter f !tbl) with + match (IList.filter f !tbl) with | [] -> None | (_, _, e):: _ -> Some e @@ -768,7 +768,7 @@ end = struct let extend e1 e2 default_op = try let eq_to_e (f1, f2, _) = Sil.exp_equal e1 f1 && Sil.exp_equal e2 f2 in - let _, _, res = list_find eq_to_e !tbl in + let _, _, res = IList.find eq_to_e !tbl in res with Not_found -> let fav1 = Sil.exp_fav e1 in @@ -778,7 +778,7 @@ end = struct 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 (Sil.exp_equal e1 e2) then e1 else (L.d_strln "failure reason 13"; raise Fail) + if (Sil.exp_equal e1 e2) then e1 else (L.d_strln "failure reason 13"; raise IList.Fail) else match default_op with | ExtDefault e -> e @@ -860,13 +860,13 @@ let ident_same_kind_primed_footprint id1 id2 = let ident_partial_join (id1: Ident.t) (id2: Ident.t) = match Ident.is_normal id1, Ident.is_normal id2 with | true, true -> - if Ident.equal id1 id2 then Sil.Var id1 else (L.d_strln "failure reason 14"; raise Fail) + if Ident.equal id1 id2 then Sil.Var id1 else (L.d_strln "failure reason 14"; raise IList.Fail) | true, _ | _, true -> Rename.extend (Sil.Var id1) (Sil.Var id2) Rename.ExtFresh | _ -> begin if not (ident_same_kind_primed_footprint id1 id2) then - (L.d_strln "failure reason 15"; raise Fail) + (L.d_strln "failure reason 15"; raise IList.Fail) else let e1 = Sil.Var id1 in let e2 = Sil.Var id2 in @@ -877,7 +877,7 @@ let ident_partial_meet (id1: Ident.t) (id2: Ident.t) = match Ident.is_normal id1, Ident.is_normal id2 with | true, true -> if Ident.equal id1 id2 then Sil.Var id1 - else (L.d_strln "failure reason 16"; raise Fail) + else (L.d_strln "failure reason 16"; raise IList.Fail) | true, _ -> let e1, e2 = Sil.Var id1, Sil.Var id2 in Rename.extend e1 e2 (Rename.ExtDefault(e1)) @@ -890,7 +890,7 @@ let ident_partial_meet (id1: Ident.t) (id2: Ident.t) = else if Ident.is_footprint id1 && Ident.equal id1 id2 then let e = Sil.Var id1 in Rename.extend e e (Rename.ExtDefault(e)) else - (L.d_strln "failure reason 17"; raise Fail) + (L.d_strln "failure reason 17"; raise IList.Fail) (** {2 Join and Meet for Exps} *) @@ -901,10 +901,10 @@ let const_partial_join c1 c2 = | Sil.Cstr _, Sil.Cstr _ | Sil.Cclass _, Sil.Cclass _ | Sil.Cattribute _, Sil.Cattribute _ -> - (L.d_strln "failure reason 18"; raise Fail) + (L.d_strln "failure reason 18"; raise IList.Fail) | _ -> if (!Config.abs_val >= 2) then FreshVarExp.get_fresh_exp (Sil.Const c1) (Sil.Const c2) - else (L.d_strln "failure reason 19"; raise Fail) + else (L.d_strln "failure reason 19"; raise IList.Fail) let rec exp_partial_join (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = (* L.d_str "exp_partial_join "; Sil.d_exp e1; L.d_str " "; Sil.d_exp e2; L.d_ln (); *) @@ -915,7 +915,7 @@ let rec exp_partial_join (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = | Sil.Var id, Sil.Const c | Sil.Const c, Sil.Var id -> if Ident.is_normal id then - (L.d_strln "failure reason 20"; raise Fail) + (L.d_strln "failure reason 20"; raise IList.Fail) else Rename.extend e1 e2 Rename.ExtFresh | Sil.Const c1, Sil.Const c2 -> @@ -923,7 +923,7 @@ let rec exp_partial_join (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = | Sil.Var id, Sil.Lvar _ | Sil.Lvar _, Sil.Var id -> - if Ident.is_normal id then (L.d_strln "failure reason 21"; raise Fail) + if Ident.is_normal id then (L.d_strln "failure reason 21"; raise IList.Fail) else Rename.extend e1 e2 Rename.ExtFresh | Sil.BinOp(Sil.PlusA, Sil.Var id1, Sil.Const _), Sil.Var id2 @@ -941,12 +941,12 @@ let rec exp_partial_join (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = let e_res = Rename.extend (Sil.exp_int c1') (Sil.Var id2) Rename.ExtFresh in Sil.BinOp(Sil.PlusA, e_res, Sil.exp_int c2) | Sil.Cast(t1, e1), Sil.Cast(t2, e2) -> - if not (Sil.typ_equal t1 t2) then (L.d_strln "failure reason 22"; raise Fail) + if not (Sil.typ_equal t1 t2) then (L.d_strln "failure reason 22"; raise IList.Fail) else let e1'' = exp_partial_join e1 e2 in Sil.Cast (t1, e1'') | Sil.UnOp(unop1, e1, topt1), Sil.UnOp(unop2, e2, topt2) -> - if not (Sil.unop_equal unop1 unop2) then (L.d_strln "failure reason 23"; raise Fail) + if not (Sil.unop_equal unop1 unop2) then (L.d_strln "failure reason 23"; raise IList.Fail) else Sil.UnOp (unop1, exp_partial_join e1 e2, topt1) (* should be topt1 = topt2 *) | Sil.BinOp(Sil.PlusPI, e1, e1'), Sil.BinOp(Sil.PlusPI, e2, e2') -> let e1'' = exp_partial_join e1 e2 in @@ -955,16 +955,16 @@ let rec exp_partial_join (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = | _ -> FreshVarExp.get_fresh_exp e1 e2 in Sil.BinOp(Sil.PlusPI, e1'', e2'') | Sil.BinOp(binop1, e1, e1'), Sil.BinOp(binop2, e2, e2') -> - if not (Sil.binop_equal binop1 binop2) then (L.d_strln "failure reason 24"; raise Fail) + if not (Sil.binop_equal binop1 binop2) then (L.d_strln "failure reason 24"; raise IList.Fail) else let e1'' = exp_partial_join e1 e2 in let e2'' = exp_partial_join e1' e2' in Sil.BinOp(binop1, e1'', e2'') | Sil.Lvar(pvar1), Sil.Lvar(pvar2) -> - if not (Sil.pvar_equal pvar1 pvar2) then (L.d_strln "failure reason 25"; raise Fail) + if not (Sil.pvar_equal pvar1 pvar2) then (L.d_strln "failure reason 25"; raise IList.Fail) else e1 | Sil.Lfield(e1, f1, t1), Sil.Lfield(e2, f2, t2) -> - if not (Sil.fld_equal f1 f2) then (L.d_strln "failure reason 26"; raise Fail) + if not (Sil.fld_equal f1 f2) then (L.d_strln "failure reason 26"; raise IList.Fail) else Sil.Lfield(exp_partial_join e1 e2, f1, t1) (* should be t1 = t2 *) | Sil.Lindex(e1, e1'), Sil.Lindex(e2, e2') -> let e1'' = exp_partial_join e1 e2 in @@ -974,7 +974,7 @@ let rec exp_partial_join (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = Sil.Sizeof (typ_partial_join t1 t2, Sil.Subtype.join st1 st2) | _ -> L.d_str "exp_partial_join no match "; Sil.d_exp e1; L.d_str " "; Sil.d_exp e2; L.d_ln (); - raise Fail + raise IList.Fail and size_partial_join size1 size2 = match size1, size2 with | Sil.BinOp(Sil.PlusA, e1, Sil.Const c1), Sil.BinOp(Sil.PlusA, e2, Sil.Const c2) -> @@ -997,7 +997,7 @@ and typ_partial_join t1 t2 = match t1, t2 with | _ when Sil.typ_equal t1 t2 -> t1 (* common case *) | _ -> L.d_str "typ_partial_join no match "; Sil.d_typ_full t1; L.d_str " "; Sil.d_typ_full t2; L.d_ln (); - raise Fail + raise IList.Fail let rec exp_partial_meet (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = match e1, e2 with @@ -1006,23 +1006,23 @@ let rec exp_partial_meet (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = | Sil.Var id, Sil.Const _ -> if not (Ident.is_normal id) then Rename.extend e1 e2 (Rename.ExtDefault(e2)) - else (L.d_strln "failure reason 27"; raise Fail) + else (L.d_strln "failure reason 27"; raise IList.Fail) | Sil.Const _, Sil.Var id -> if not (Ident.is_normal id) then Rename.extend e1 e2 (Rename.ExtDefault(e1)) - else (L.d_strln "failure reason 28"; raise Fail) + else (L.d_strln "failure reason 28"; raise IList.Fail) | Sil.Const c1, Sil.Const c2 -> - if (Sil.const_equal c1 c2) then e1 else (L.d_strln "failure reason 29"; raise Fail) + if (Sil.const_equal c1 c2) then e1 else (L.d_strln "failure reason 29"; raise IList.Fail) | Sil.Cast(t1, e1), Sil.Cast(t2, e2) -> - if not (Sil.typ_equal t1 t2) then (L.d_strln "failure reason 30"; raise Fail) + if not (Sil.typ_equal t1 t2) then (L.d_strln "failure reason 30"; raise IList.Fail) else let e1'' = exp_partial_meet e1 e2 in Sil.Cast (t1, e1'') | Sil.UnOp(unop1, e1, topt1), Sil.UnOp(unop2, e2, topt2) -> - if not (Sil.unop_equal unop1 unop2) then (L.d_strln "failure reason 31"; raise Fail) + if not (Sil.unop_equal unop1 unop2) then (L.d_strln "failure reason 31"; raise IList.Fail) else Sil.UnOp (unop1, exp_partial_meet e1 e2, topt1) (* should be topt1 = topt2 *) | Sil.BinOp(binop1, e1, e1'), Sil.BinOp(binop2, e2, e2') -> - if not (Sil.binop_equal binop1 binop2) then (L.d_strln "failure reason 32"; raise Fail) + if not (Sil.binop_equal binop1 binop2) then (L.d_strln "failure reason 32"; raise IList.Fail) else let e1'' = exp_partial_meet e1 e2 in let e2'' = exp_partial_meet e1' e2' in @@ -1030,26 +1030,26 @@ let rec exp_partial_meet (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = | Sil.Var id, Sil.Lvar _ -> if not (Ident.is_normal id) then Rename.extend e1 e2 (Rename.ExtDefault(e2)) - else (L.d_strln "failure reason 33"; raise Fail) + else (L.d_strln "failure reason 33"; raise IList.Fail) | Sil.Lvar _, Sil.Var id -> if not (Ident.is_normal id) then Rename.extend e1 e2 (Rename.ExtDefault(e1)) - else (L.d_strln "failure reason 34"; raise Fail) + else (L.d_strln "failure reason 34"; raise IList.Fail) | Sil.Lvar(pvar1), Sil.Lvar(pvar2) -> - if not (Sil.pvar_equal pvar1 pvar2) then (L.d_strln "failure reason 35"; raise Fail) + if not (Sil.pvar_equal pvar1 pvar2) then (L.d_strln "failure reason 35"; raise IList.Fail) else e1 | Sil.Lfield(e1, f1, t1), Sil.Lfield(e2, f2, t2) -> - if not (Sil.fld_equal f1 f2) then (L.d_strln "failure reason 36"; raise Fail) + if not (Sil.fld_equal f1 f2) then (L.d_strln "failure reason 36"; raise IList.Fail) else Sil.Lfield(exp_partial_meet e1 e2, f1, t1) (* should be t1 = t2 *) | Sil.Lindex(e1, e1'), Sil.Lindex(e2, e2') -> let e1'' = exp_partial_meet e1 e2 in let e2'' = exp_partial_meet e1' e2' in Sil.Lindex(e1'', e2'') - | _ -> (L.d_strln "failure reason 37"; raise Fail) + | _ -> (L.d_strln "failure reason 37"; raise IList.Fail) -let exp_list_partial_join = list_map2 exp_partial_join +let exp_list_partial_join = IList.map2 exp_partial_join -let exp_list_partial_meet = list_map2 exp_partial_meet +let exp_list_partial_meet = IList.map2 exp_partial_meet let run_without_absval f e1 e2 = let old_abs_val = !Config.abs_val in @@ -1080,12 +1080,12 @@ let rec strexp_partial_join mode (strexp1: Sil.strexp) (strexp2: Sil.strexp) : S let rec f_fld_se_list inst mode acc fld_se_list1 fld_se_list2 = match fld_se_list1, fld_se_list2 with - | [], [] -> Sil.Estruct (list_rev acc, inst) + | [], [] -> Sil.Estruct (IList.rev acc, inst) | [], other_fsel | other_fsel, [] -> begin match mode with - | JoinState.Pre -> (L.d_strln "failure reason 42"; raise Fail) - | JoinState.Post -> Sil.Estruct (list_rev acc, inst) + | JoinState.Pre -> (L.d_strln "failure reason 42"; raise IList.Fail) + | JoinState.Post -> Sil.Estruct (IList.rev acc, inst) end | (fld1, se1):: fld_se_list1', (fld2, se2):: fld_se_list2' -> let comparison = Sil.fld_compare fld1 fld2 in @@ -1096,7 +1096,7 @@ let rec strexp_partial_join mode (strexp1: Sil.strexp) (strexp2: Sil.strexp) : S else begin match mode with | JoinState.Pre -> - (L.d_strln "failure reason 43"; raise Fail) + (L.d_strln "failure reason 43"; raise IList.Fail) | JoinState.Post -> if comparison < 0 then begin f_fld_se_list inst mode acc fld_se_list1' fld_se_list2 @@ -1110,13 +1110,13 @@ let rec strexp_partial_join mode (strexp1: Sil.strexp) (strexp2: Sil.strexp) : S let rec f_idx_se_list inst size idx_se_list_acc idx_se_list1 idx_se_list2 = match idx_se_list1, idx_se_list2 with - | [], [] -> Sil.Earray (size, list_rev idx_se_list_acc, inst) + | [], [] -> Sil.Earray (size, IList.rev idx_se_list_acc, inst) | [], other_isel | other_isel, [] -> begin match mode with - | JoinState.Pre -> (L.d_strln "failure reason 44"; raise Fail) + | JoinState.Pre -> (L.d_strln "failure reason 44"; raise IList.Fail) | JoinState.Post -> - Sil.Earray (size, list_rev idx_se_list_acc, inst) + Sil.Earray (size, IList.rev idx_se_list_acc, inst) end | (idx1, se1):: idx_se_list1', (idx2, se2):: idx_se_list2' -> let idx = exp_partial_join idx1 idx2 in @@ -1134,19 +1134,19 @@ let rec strexp_partial_join mode (strexp1: Sil.strexp) (strexp2: Sil.strexp) : S let size = size_partial_join size1 size2 in let inst = Sil.inst_partial_join inst1 inst2 in f_idx_se_list inst size [] idx_se_list1 idx_se_list2 - | _ -> L.d_strln "no match in strexp_partial_join"; raise Fail + | _ -> L.d_strln "no match in strexp_partial_join"; raise IList.Fail let rec strexp_partial_meet (strexp1: Sil.strexp) (strexp2: Sil.strexp) : Sil.strexp = let construct side rev_list ref_list = let construct_offset_se (off, se) = (off, strexp_construct_fresh side se) in - let acc = list_map construct_offset_se ref_list in - list_rev_with_acc acc rev_list in + let acc = IList.map construct_offset_se ref_list in + IList.rev_with_acc acc rev_list in let rec f_fld_se_list inst acc fld_se_list1 fld_se_list2 = match fld_se_list1, fld_se_list2 with | [], [] -> - Sil.Estruct (list_rev acc, inst) + Sil.Estruct (IList.rev acc, inst) | [], _ -> Sil.Estruct (construct Rhs acc fld_se_list2, inst) | _, [] -> @@ -1169,7 +1169,7 @@ let rec strexp_partial_meet (strexp1: Sil.strexp) (strexp2: Sil.strexp) : Sil.st let rec f_idx_se_list inst size acc idx_se_list1 idx_se_list2 = match idx_se_list1, idx_se_list2 with | [],[] -> - Sil.Earray (size, list_rev acc, inst) + Sil.Earray (size, IList.rev acc, inst) | [], _ -> Sil.Earray (size, construct Rhs acc idx_se_list2, inst) | _, [] -> @@ -1190,7 +1190,7 @@ let rec strexp_partial_meet (strexp1: Sil.strexp) (strexp2: Sil.strexp) : Sil.st when Sil.exp_equal size1 size2 -> let inst = Sil.inst_partial_meet inst1 inst2 in f_idx_se_list inst size1 [] idx_se_list1 idx_se_list2 - | _ -> (L.d_strln "failure reason 52"; raise Fail) + | _ -> (L.d_strln "failure reason 52"; raise IList.Fail) (** {2 Join and Meet for kind, hpara, hpara_dll} *) @@ -1210,7 +1210,7 @@ let hpara_partial_join (hpara1: Sil.hpara) (hpara2: Sil.hpara) : Sil.hpara = else if Match.hpara_match_with_impl true hpara1 hpara2 then hpara2 else - (L.d_strln "failure reason 53"; raise Fail) + (L.d_strln "failure reason 53"; raise IList.Fail) let hpara_partial_meet (hpara1: Sil.hpara) (hpara2: Sil.hpara) : Sil.hpara = if Match.hpara_match_with_impl true hpara2 hpara1 then @@ -1218,7 +1218,7 @@ let hpara_partial_meet (hpara1: Sil.hpara) (hpara2: Sil.hpara) : Sil.hpara = else if Match.hpara_match_with_impl true hpara1 hpara2 then hpara1 else - (L.d_strln "failure reason 54"; raise Fail) + (L.d_strln "failure reason 54"; raise IList.Fail) let hpara_dll_partial_join (hpara1: Sil.hpara_dll) (hpara2: Sil.hpara_dll) : Sil.hpara_dll = if Match.hpara_dll_match_with_impl true hpara2 hpara1 then @@ -1226,7 +1226,7 @@ let hpara_dll_partial_join (hpara1: Sil.hpara_dll) (hpara2: Sil.hpara_dll) : Sil else if Match.hpara_dll_match_with_impl true hpara1 hpara2 then hpara2 else - (L.d_strln "failure reason 55"; raise Fail) + (L.d_strln "failure reason 55"; raise IList.Fail) let hpara_dll_partial_meet (hpara1: Sil.hpara_dll) (hpara2: Sil.hpara_dll) : Sil.hpara_dll = if Match.hpara_dll_match_with_impl true hpara2 hpara1 then @@ -1234,7 +1234,7 @@ let hpara_dll_partial_meet (hpara1: Sil.hpara_dll) (hpara2: Sil.hpara_dll) : Sil else if Match.hpara_dll_match_with_impl true hpara1 hpara2 then hpara1 else - (L.d_strln "failure reason 56"; raise Fail) + (L.d_strln "failure reason 56"; raise IList.Fail) (** {2 Join and Meet for hpred} *) @@ -1257,7 +1257,7 @@ let hpred_partial_join mode (todo: Sil.exp * Sil.exp * Sil.exp) (hpred1: Sil.hpr let iF', iB' = if (fwd1 && fwd2) then (e, exp_partial_join iB1 iB2) else if (not fwd1 && not fwd2) then (exp_partial_join iF1 iF2, e) - else (L.d_strln "failure reason 57"; raise Fail) in + else (L.d_strln "failure reason 57"; raise IList.Fail) in let oF' = exp_partial_join oF1 oF2 in let oB' = exp_partial_join oB1 oB2 in let shared' = exp_list_partial_join shared1 shared2 in @@ -1271,7 +1271,7 @@ let hpred_partial_meet (todo: Sil.exp * Sil.exp * Sil.exp) (hpred1: Sil.hpred) ( | Sil.Hpointsto (e1, se1, te1), Sil.Hpointsto (e2, se2, te2) when Sil.exp_equal te1 te2 -> Prop.mk_ptsto e (strexp_partial_meet se1 se2) te1 | Sil.Hpointsto _, _ | _, Sil.Hpointsto _ -> - (L.d_strln "failure reason 58"; raise Fail) + (L.d_strln "failure reason 58"; raise IList.Fail) | Sil.Hlseg (k1, hpara1, root1, next1, shared1), Sil.Hlseg (k2, hpara2, root2, next2, shared2) -> let hpara' = hpara_partial_meet hpara1 hpara2 in let next' = exp_partial_meet next1 next2 in @@ -1285,7 +1285,7 @@ let hpred_partial_meet (todo: Sil.exp * Sil.exp * Sil.exp) (hpred1: Sil.hpred) ( let iF', iB' = if (fwd1 && fwd2) then (e, exp_partial_meet iB1 iB2) else if (not fwd1 && not fwd2) then (exp_partial_meet iF1 iF2, e) - else (L.d_strln "failure reason 59"; raise Fail) in + else (L.d_strln "failure reason 59"; raise IList.Fail) in let oF' = exp_partial_meet oF1 oF2 in let oB' = exp_partial_meet oB1 oB2 in let shared' = exp_list_partial_meet shared1 shared2 in @@ -1308,7 +1308,7 @@ let find_hpred_by_address (e: Sil.exp) (sigma: sigma) : Sil.hpred option * sigma | [] -> None, sigma | hpred:: sigma -> if contains_e hpred then - Some hpred, (list_rev sigma_acc) @ sigma + Some hpred, (IList.rev sigma_acc) @ sigma else f (hpred:: sigma_acc) sigma in f [] sigma @@ -1339,7 +1339,7 @@ let rec sigma_partial_join' mode (sigma_acc: sigma) let lookup_and_expand side e e' = match (Rename.get_others side e, side) with - | None, _ -> (L.d_strln "failure reason 60"; raise Fail) + | None, _ -> (L.d_strln "failure reason 60"; raise IList.Fail) | Some(e_res, e_op), Lhs -> (e_res, exp_partial_join e' e_op) | Some(e_res, e_op), Rhs -> (e_res, exp_partial_join e_op e') in @@ -1401,7 +1401,7 @@ let rec sigma_partial_join' mode (sigma_acc: sigma) 'todo' describes the start point. *) let cut_sigma side todo (target: sigma) (other: sigma) = - let list_is_empty l = if l != [] then (L.d_strln "failure reason 61"; raise Fail) in + let list_is_empty l = if l != [] then (L.d_strln "failure reason 61"; raise IList.Fail) in let x = Todo.take () in Todo.push todo; let res = @@ -1455,7 +1455,7 @@ let rec sigma_partial_join' mode (sigma_acc: sigma) let sigma_acc' = join_list_and_non Lhs e lseg e1 e2 :: sigma_acc in sigma_partial_join' mode sigma_acc' sigma1 sigma2 else - (L.d_strln "failure reason 62"; raise Fail) + (L.d_strln "failure reason 62"; raise IList.Fail) | None, Some (Sil.Hlseg (k, _, _, _, _) as lseg) | None, Some (Sil.Hdllseg (k, _, _, _, _, _, _) as lseg) -> @@ -1463,9 +1463,9 @@ let rec sigma_partial_join' mode (sigma_acc: sigma) let sigma_acc' = join_list_and_non Rhs e lseg e2 e1 :: sigma_acc in sigma_partial_join' mode sigma_acc' sigma1 sigma2 else - (L.d_strln "failure reason 63"; raise Fail) + (L.d_strln "failure reason 63"; raise IList.Fail) - | None, _ | _, None -> (L.d_strln "failure reason 64"; raise Fail) + | None, _ | _, None -> (L.d_strln "failure reason 64"; raise IList.Fail) | Some (hpred1), Some (hpred2) when same_pred hpred1 hpred2 -> let hpred_res1 = hpred_partial_join mode todo_curr hpred1 hpred2 in @@ -1517,7 +1517,7 @@ let rec sigma_partial_join' mode (sigma_acc: sigma) with Todo.Empty -> match sigma1_in, sigma2_in with - | _:: _, _:: _ -> L.d_strln "todo is empty, but the sigmas are not"; raise Fail + | _:: _, _:: _ -> L.d_strln "todo is empty, but the sigmas are not"; raise IList.Fail | _ -> sigma_acc, sigma1_in, sigma2_in let sigma_partial_join mode (sigma1: sigma) (sigma2: sigma) : (sigma * sigma * sigma) = @@ -1530,7 +1530,7 @@ let sigma_partial_join mode (sigma1: sigma) (sigma2: sigma) : (sigma * sigma * s else begin L.d_strln "failed Rename.check"; CheckJoin.final (); - raise Fail + raise IList.Fail end with | exn -> (CheckJoin.final (); raise exn) @@ -1565,12 +1565,12 @@ let rec sigma_partial_meet' (sigma_acc: sigma) (sigma1_in: sigma) (sigma2_in: si sigma_partial_meet' (hpred':: sigma_acc) sigma1 sigma2 | Some _, Some _ -> - (L.d_strln "failure reason 65"; raise Fail) + (L.d_strln "failure reason 65"; raise IList.Fail) with Todo.Empty -> match sigma1_in, sigma2_in with | [], [] -> sigma_acc - | _, _ -> L.d_strln "todo is empty, but the sigmas are not"; raise Fail + | _, _ -> L.d_strln "todo is empty, but the sigmas are not"; raise IList.Fail let sigma_partial_meet (sigma1: sigma) (sigma2: sigma) : sigma = sigma_partial_meet' [] sigma1 sigma2 @@ -1595,13 +1595,13 @@ let pi_partial_join mode | Sil.Hpointsto (_, Sil.Earray (Sil.Const (Sil.Cint n), _, _), _) -> (if Sil.Int.geq n Sil.Int.one then size_list := n::!size_list) | _ -> () in - list_iter do_hpred (Prop.get_sigma prop); + IList.iter do_hpred (Prop.get_sigma prop); !size_list in let bounds = let bounds1 = get_array_size ep1 in let bounds2 = get_array_size ep2 in - let bounds_sorted = list_sort Sil.Int.compare_value (bounds1@bounds2) in - list_rev (list_remove_duplicates Sil.Int.compare_value bounds_sorted) in + let bounds_sorted = IList.sort Sil.Int.compare_value (bounds1@bounds2) in + IList.rev (IList.remove_duplicates Sil.Int.compare_value bounds_sorted) in let widening_atom a = (* widening heuristic for upper bound: take the size of some array, -2 and -1 *) match Prop.atom_exp_le_const a, bounds with @@ -1639,11 +1639,11 @@ let pi_partial_join mode (* check for atoms in pre mode: fail if the negation is implied by the other side *) let not_a = Prop.atom_negate a in if (Prover.check_atom p not_a) then - (L.d_str "join_atom_check failed on "; Sil.d_atom a; L.d_ln (); raise Fail) in + (L.d_str "join_atom_check failed on "; Sil.d_atom a; L.d_ln (); raise IList.Fail) in let join_atom_check_attribute p a = (* check for attribute: fail if the attribute is not in the other side *) if not (Prover.check_atom p a) then - (L.d_str "join_atom_check_attribute failed on "; Sil.d_atom a; L.d_ln (); raise Fail) in + (L.d_str "join_atom_check_attribute failed on "; Sil.d_atom a; L.d_ln (); raise IList.Fail) in let join_atom side p_op pi_op a = (* try to find the atom corresponding to a on the other side, and check if it is implied *) match Rename.get_other_atoms side a with @@ -1658,10 +1658,10 @@ let pi_partial_join mode begin match Prop.atom_const_lt_exp a_op with | None -> Some a_res - | Some (n, e) -> if list_exists (is_stronger_lt n e) pi_op then (widening_atom a_res) else Some a_res + | Some (n, e) -> if IList.exists (is_stronger_lt n e) pi_op then (widening_atom a_res) else Some a_res end | Some (e, n) -> - if list_exists (is_stronger_le e n) pi_op then (widening_atom a_res) else Some a_res + if IList.exists (is_stronger_le e n) pi_op then (widening_atom a_res) else Some a_res end in let handle_atom_with_widening size p_op pi_op atom_list a = (* find a join for the atom, if it fails apply widening heuristing and try again *) @@ -1691,17 +1691,17 @@ let pi_partial_join mode end; let atom_list1 = let p2 = Prop.normalize ep2 in - list_fold_left (handle_atom_with_widening Lhs p2 pi2) [] pi1 in + IList.fold_left (handle_atom_with_widening Lhs p2 pi2) [] pi1 in if !Config.trace_join then (L.d_str "atom_list1: "; Prop.d_pi atom_list1; L.d_ln ()); let atom_list_combined = let p1 = Prop.normalize ep1 in - list_fold_left (handle_atom_with_widening Rhs p1 pi1) atom_list1 pi2 in + IList.fold_left (handle_atom_with_widening Rhs p1 pi1) atom_list1 pi2 in if !Config.trace_join then (L.d_str "atom_list_combined: "; Prop.d_pi atom_list_combined; L.d_ln ()); let atom_list_filtered = - list_filter filter_atom atom_list_combined in + IList.filter filter_atom atom_list_combined in if !Config.trace_join then (L.d_str "atom_list_filtered: "; Prop.d_pi atom_list_filtered; L.d_ln ()); let atom_list_res = - list_rev atom_list_filtered in + IList.rev atom_list_filtered in atom_list_res end @@ -1714,9 +1714,9 @@ let pi_partial_meet (p: Prop.normal Prop.t) (ep1: 'a Prop.t) (ep2: 'b Prop.t) : let handle_atom sub dom atom = let fav_list = Sil.fav_to_list (Sil.atom_fav atom) in - if list_for_all (fun id -> Ident.IdentSet.mem id dom) fav_list then + if IList.for_all (fun id -> Ident.IdentSet.mem id dom) fav_list then Sil.atom_sub sub atom - else (L.d_str "handle_atom failed on "; Sil.d_atom atom; L.d_ln (); raise Fail) in + else (L.d_str "handle_atom failed on "; Sil.d_atom atom; L.d_ln (); raise IList.Fail) in let f1 p' atom = Prop.prop_atom_and p' (handle_atom sub1 dom1 atom) in let f2 p' atom = @@ -1725,9 +1725,9 @@ let pi_partial_meet (p: Prop.normal Prop.t) (ep1: 'a Prop.t) (ep2: 'b Prop.t) : let pi1 = Prop.get_pi ep1 in let pi2 = Prop.get_pi ep2 in - let p_pi1 = list_fold_left f1 p pi1 in - let p_pi2 = list_fold_left f2 p_pi1 pi2 in - if (Prover.check_inconsistency_base p_pi2) then (L.d_strln "check_inconsistency_base failed"; raise Fail) + let p_pi1 = IList.fold_left f1 p pi1 in + let p_pi2 = IList.fold_left f2 p_pi1 pi2 in + if (Prover.check_inconsistency_base p_pi2) then (L.d_strln "check_inconsistency_base failed"; raise IList.Fail) else p_pi2 (** {2 Join and Meet for Prop} *) @@ -1739,20 +1739,20 @@ let eprop_partial_meet (ep1: 'a Prop.t) (ep2: 'b Prop.t) : 'c Prop.t = let es1 = sigma_get_start_lexps_sort sigma1 in let es2 = sigma_get_start_lexps_sort sigma2 in - let es = list_merge_sorted_nodup Sil.exp_compare [] es1 es2 in + let es = IList.merge_sorted_nodup Sil.exp_compare [] es1 es2 in let sub_check _ = let sub1 = Prop.get_sub ep1 in let sub2 = Prop.get_sub ep2 in let range1 = Sil.sub_range sub1 in let f e = Sil.fav_for_all (Sil.exp_fav e) Ident.is_normal in - Sil.sub_equal sub1 sub2 && list_for_all f range1 in + Sil.sub_equal sub1 sub2 && IList.for_all f range1 in if not (sub_check ()) then - (L.d_strln "sub_check() failed"; raise Fail) + (L.d_strln "sub_check() failed"; raise IList.Fail) else begin - let todos = list_map (fun x -> (x, x, x)) es in - list_iter Todo.push todos; + let todos = IList.map (fun x -> (x, x, x)) es in + IList.iter Todo.push todos; let sigma_new = sigma_partial_meet sigma1 sigma2 in let ep = Prop.replace_sigma sigma_new ep1 in let ep' = Prop.replace_pi [] ep in @@ -1772,7 +1772,7 @@ let prop_partial_meet p1 p2 = begin Rename.final (); FreshVarExp.final (); Todo.final (); match exn with - | Fail -> None + | IList.Fail -> None | _ -> raise exn end @@ -1783,7 +1783,7 @@ let eprop_partial_join' mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed Prop. let es1 = sigma_get_start_lexps_sort sigma1 in let es2 = sigma_get_start_lexps_sort sigma2 in - let simple_check = list_length es1 = list_length es2 in + let simple_check = IList.length es1 = IList.length es2 in let rec expensive_check es1' es2' = match (es1', es2') with | [], [] -> true @@ -1798,7 +1798,7 @@ let eprop_partial_join' mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed Prop. let f e = Sil.fav_for_all (Sil.exp_fav e) Ident.is_normal in Sil.sub_range_partition f sub_common in let eqs1, eqs2 = - let sub_to_eqs sub = list_map (fun (id, e) -> Sil.Aeq(Sil.Var id, e)) (Sil.sub_to_list sub) in + let sub_to_eqs sub = IList.map (fun (id, e) -> Sil.Aeq(Sil.Var id, e)) (Sil.sub_to_list sub) in let eqs1 = sub_to_eqs sub1_only @ sub_to_eqs sub_common_other in let eqs2 = sub_to_eqs sub2_only in (eqs1, eqs2) in @@ -1808,10 +1808,10 @@ let eprop_partial_join' mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed Prop. begin if not simple_check then L.d_strln "simple_check failed" else L.d_strln "expensive_check failed"; - raise Fail + raise IList.Fail end; - let todos = list_map (fun x -> (x, x, x)) es1 in - list_iter Todo.push todos; + let todos = IList.map (fun x -> (x, x, x)) es1 in + IList.iter Todo.push todos; match sigma_partial_join mode sigma1 sigma2 with | sigma_new, [], [] -> L.d_strln "sigma_partial_join succeeded"; @@ -1827,10 +1827,10 @@ let eprop_partial_join' mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed Prop. L.d_strln "pi_partial_join succeeded"; let pi_from_fresh_vars = FreshVarExp.get_induced_pi () in let pi_all = pi' @ pi_from_fresh_vars in - list_fold_left Prop.prop_atom_and p_sub_sigma pi_all in + IList.fold_left Prop.prop_atom_and p_sub_sigma pi_all in p_sub_sigma_pi | _ -> - L.d_strln "leftovers not empty"; raise Fail + L.d_strln "leftovers not empty"; raise IList.Fail let footprint_partial_join' (p1: Prop.normal Prop.t) (p2: Prop.normal Prop.t) : Prop.normal Prop.t * Prop.normal Prop.t = if not !Config.footprint then p1, p2 @@ -1841,11 +1841,11 @@ let footprint_partial_join' (p1: Prop.normal Prop.t) (p2: Prop.normal Prop.t) : let fp_pi = (* Prop.get_pure efp in *) let fp_pi0 = Prop.get_pure efp in let f a = Sil.fav_for_all (Sil.atom_fav a) Ident.is_footprint in - list_filter f fp_pi0 in + IList.filter f fp_pi0 in let fp_sigma = (* Prop.get_sigma efp in *) let fp_sigma0 = Prop.get_sigma efp in let f a = Sil.fav_exists (Sil.hpred_fav a) (fun a -> not (Ident.is_footprint a)) in - if list_exists f fp_sigma0 then (L.d_strln "failure reason 66"; raise Fail); + if IList.exists f fp_sigma0 then (L.d_strln "failure reason 66"; raise IList.Fail); fp_sigma0 in let ep1' = Prop.replace_sigma_footprint fp_sigma (Prop.replace_pi_footprint fp_pi p1) in let ep2' = Prop.replace_sigma_footprint fp_sigma (Prop.replace_pi_footprint fp_pi p2) in @@ -1875,7 +1875,7 @@ let prop_partial_join pname tenv mode p1 p2 = begin Rename.final (); FreshVarExp.final (); Todo.final (); (if !Config.footprint then JoinState.set_footprint false); - (match exn with Fail -> None | _ -> raise exn) + (match exn with IList.Fail -> None | _ -> raise exn) end end | Some _ -> res_by_implication_only @@ -1892,7 +1892,7 @@ let eprop_partial_join mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed Prop.t let list_reduce name dd f list = let rec element_list_reduce acc (x, p1) = function - | [] -> ((x, p1), list_rev acc) + | [] -> ((x, p1), IList.rev acc) | (y, p2):: ys -> begin L.d_strln ("COMBINE[" ^ name ^ "] ...."); L.d_str "ENTRY1: "; L.d_ln (); dd x; L.d_ln (); @@ -1908,7 +1908,7 @@ let list_reduce name dd f list = element_list_reduce acc (x', p1) ys end in let rec reduce acc = function - | [] -> list_rev acc + | [] -> IList.rev acc | x:: xs -> let (x', xs') = element_list_reduce [] x xs in reduce (x':: acc) xs' in @@ -1929,7 +1929,7 @@ let jprop_partial_join mode jp1 jp2 = let p = eprop_partial_join mode p1 p2 in let p_renamed = Prop.prop_rename_primed_footprint_vars p in Some (Specs.Jprop.Joined (0, p_renamed, jp1, jp2)) - with Fail -> None + with IList.Fail -> None let jplist_collapse mode jplist = let f = jprop_partial_join mode in @@ -1946,21 +1946,21 @@ let jprop_list_add_ids jplist = let jp2' = do_jprop jp2 in incr seq_number; Specs.Jprop.Joined (!seq_number, p, jp1', jp2') in - list_map (fun (p, path) -> (do_jprop p, path)) jplist + IList.map (fun (p, path) -> (do_jprop p, path)) jplist let proplist_collapse mode plist = - let jplist = list_map (fun (p, path) -> (Specs.Jprop.Prop (0, p), path)) plist in + let jplist = IList.map (fun (p, path) -> (Specs.Jprop.Prop (0, p), path)) plist in let jplist_joined = jplist_collapse mode (jplist_collapse mode jplist) in jprop_list_add_ids jplist_joined let proplist_collapse_pre plist = - let plist' = list_map (fun p -> (p, ())) plist in - list_map fst (proplist_collapse JoinState.Pre plist') + let plist' = IList.map (fun p -> (p, ())) plist in + IList.map fst (proplist_collapse JoinState.Pre plist') let pathset_collapse pset = let plist = Paths.PathSet.elements pset in let plist' = proplist_collapse JoinState.Post plist in - Paths.PathSet.from_renamed_list (list_map (fun (p, path) -> (Specs.Jprop.to_prop p, path)) plist') + Paths.PathSet.from_renamed_list (IList.map (fun (p, path) -> (Specs.Jprop.to_prop p, path)) plist') let join_time = ref 0.0 @@ -1975,7 +1975,7 @@ let pathset_join let ppalist1 = pset_to_plist pset1 in let ppalist2 = pset_to_plist pset2 in let rec join_proppath_plist ppalist2_acc ((p2, pa2) as ppa2) = function - | [] -> (ppa2, list_rev ppalist2_acc) + | [] -> (ppa2, IList.rev ppalist2_acc) | ((p2', pa2') as ppa2') :: ppalist2_rest -> begin L.d_strln ".... JOIN ...."; L.d_strln "JOIN SYM HEAP1: "; Prop.d_prop p2; L.d_ln (); @@ -1997,7 +1997,7 @@ let pathset_join let (ppa2_new, ppalist1_cur') = join_proppath_plist [] ppa2'' ppalist1_cur in join ppalist1_cur' (ppa2_new:: ppalist2_acc') ppalist2_rest' in let _ppalist1_res, _ppalist2_res = join ppalist1 [] ppalist2 in - let ren l = list_map (fun (p, x) -> (Prop.prop_rename_primed_footprint_vars p, x)) l in + let ren l = IList.map (fun (p, x) -> (Prop.prop_rename_primed_footprint_vars p, x)) l in let ppalist1_res, ppalist2_res = ren _ppalist1_res, ren _ppalist2_res in let res = (Paths.PathSet.from_renamed_list ppalist1_res, Paths.PathSet.from_renamed_list ppalist2_res) in join_time := !join_time +. (Unix.gettimeofday () -. initial_time); @@ -2034,10 +2034,10 @@ let proplist_meet_generate plist = (* use porig instead of pcombined because it might be combinable with more othe props *) (* e.g. porig might contain a global var to add to the ture branch of a conditional *) (* but pcombined might have been combined with the false branch already *) - let pplist' = list_map (combine porig) pplist in + let pplist' = IList.map (combine porig) pplist in props_done := Propset.add pcombined !props_done; proplist_meet pplist' in - proplist_meet (list_map (fun p -> (p, p)) plist); + proplist_meet (IList.map (fun p -> (p, p)) plist); !props_done diff --git a/infer/src/backend/dotty.ml b/infer/src/backend/dotty.ml index 3ccc2bc34..d958610b7 100644 --- a/infer/src/backend/dotty.ml +++ b/infer/src/backend/dotty.ml @@ -98,7 +98,7 @@ let invisible_arrows = ref false let print_stack_info = ref false let exp_is_neq_zero e = - list_exists (fun e' -> Sil.exp_equal e e') !exps_neq_zero + IList.exists (fun e' -> Sil.exp_equal e e') !exps_neq_zero (* replace a dollar sign in a name with a D. We need this because dotty get confused if there is*) (* a dollar sign i a label*) @@ -220,7 +220,7 @@ let rec select_nodes_exp_lambda dotnodes e lambda = (* this is written in this strange way for legacy reason. It should be changed a bit*) let look_up dotnodes e lambda = let r = select_nodes_exp_lambda dotnodes e lambda in - let r'= list_map get_coordinate_id r in + let r'= IList.map get_coordinate_id r in r' @ look_up_for_back_pointer e dotnodes lambda let pp_nesting fmt nesting = @@ -232,7 +232,7 @@ let reset_dotty_spec_counter () = spec_counter:= 0 let max_map f l = let curr_max = ref 0 in - list_iter (fun x -> curr_max := max !curr_max (f x)) l; + IList.iter (fun x -> curr_max := max !curr_max (f x)) l; ! curr_max let rec sigma_nesting_level sigma = @@ -284,7 +284,7 @@ let make_dangling_boxes pe allocated_nodes (sigma_lambda: (Sil.hpred * int) list let is_allocated d = match d with | Dotdangling(_, e, _) -> - list_exists (fun a -> match a with + IList.exists (fun a -> match a with | Dotpointsto(_, e', _) | Dotarray(_, _, e', _, _, _) | Dotlseg(_, e', _, _, _, _) @@ -296,7 +296,7 @@ let make_dangling_boxes pe allocated_nodes (sigma_lambda: (Sil.hpred * int) list match l with | [] -> [] | Dotdangling(coo, e, color):: l' -> - if (list_exists (Sil.exp_equal e) seen_exp) then filter_duplicate l' seen_exp + if (IList.exists (Sil.exp_equal e) seen_exp) then filter_duplicate l' seen_exp else Dotdangling(coo, e, color):: filter_duplicate l' (e:: seen_exp) | box:: l' -> box:: filter_duplicate l' seen_exp in (* this case cannot happen*) let rec subtract_allocated candidate_dangling = @@ -305,7 +305,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 = list_flatten (list_map get_rhs_predicate sigma_lambda) in + let candidate_dangling = IList.flatten (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 @@ -326,7 +326,7 @@ let rec dotty_mk_node pe sigma = [Dotpointsto((mk_coordinate n lambda), e, e_color_str); Dotstruct((mk_coordinate (n + 1) lambda), e, l, e_color_str);] | (Sil.Hpointsto (e, _, _), lambda) -> let e_color_str = color_to_str (exp_color e) in - if list_mem Sil.exp_equal e !struct_exp_nodes then [] else + if IList.mem Sil.exp_equal e !struct_exp_nodes then [] else [Dotpointsto((mk_coordinate n lambda), e, e_color_str)] | (Sil.Hlseg (k, hpara, e1, e2, elist), lambda) -> incr dotty_state_count; (* increment once more n+1 is the box for last element of the list *) @@ -349,10 +349,10 @@ let set_exps_neq_zero pi = | Sil.Aneq (e, Sil.Const (Sil.Cint i)) when Sil.Int.iszero i -> exps_neq_zero := e :: !exps_neq_zero | _ -> () in exps_neq_zero := []; - list_iter f pi + IList.iter f pi let box_dangling e = - let entry_e = list_filter (fun b -> match b with + let entry_e = IList.filter (fun b -> match b with | Dotdangling(_, e', _) -> Sil.exp_equal e e' | _ -> false ) !dangling_dotboxes in match entry_e with |[] -> None @@ -382,8 +382,8 @@ let compute_fields_struct sigma = let rec do_strexp se in_struct = match se with | Sil.Eexp (e, inst) -> if in_struct then fields_structs:= e ::!fields_structs else () - | Sil.Estruct (l, _) -> list_iter (fun e -> do_strexp e true) (snd (list_split l)) - | Sil.Earray (_, l, _) -> list_iter (fun e -> do_strexp e false) (snd (list_split l)) in + | Sil.Estruct (l, _) -> IList.iter (fun e -> do_strexp e true) (snd (IList.split l)) + | Sil.Earray (_, l, _) -> IList.iter (fun e -> do_strexp e false) (snd (IList.split l)) in let rec fs s = match s with | [] -> () @@ -424,7 +424,7 @@ let rec compute_target_struct_fields dotnodes list_fld p f lambda = ) | [node] | [Dotpointsto _ ; node] | [node; Dotpointsto _] -> let n = get_coordinate_id node in - if list_mem Sil.exp_equal e !struct_exp_nodes then begin + if IList.mem Sil.exp_equal e !struct_exp_nodes then begin let e_no_special_char = strip_special_chars (Sil.exp_to_string e) in [(LinkStructToStruct, Ident.fieldname_to_string fn, n, e_no_special_char)] end else @@ -460,7 +460,7 @@ let rec compute_target_array_elements dotnodes list_elements p f lambda = ) | [node] | [Dotpointsto _ ; node] | [node; Dotpointsto _] -> let n = get_coordinate_id node in - if list_mem Sil.exp_equal e !struct_exp_nodes then begin + if IList.mem Sil.exp_equal e !struct_exp_nodes then begin let e_no_special_char = strip_special_chars (Sil.exp_to_string e) in [(LinkArrayToStruct, Sil.exp_to_string idx, n, e_no_special_char)] end else @@ -483,15 +483,15 @@ let compute_target_from_eexp dotnodes e p f lambda = [(LinkExpToExp, n', "")] else let nodes_e = select_nodes_exp_lambda dotnodes e lambda in - let nodes_e_no_struct = list_filter is_not_struct nodes_e in - let trg = list_map get_coordinate_id nodes_e_no_struct in + let nodes_e_no_struct = IList.filter is_not_struct nodes_e in + let trg = IList.map get_coordinate_id nodes_e_no_struct in (match trg with | [] -> (match box_dangling e with | None -> [] | Some n -> [(LinkExpToExp, n, "")] ) - | _ -> list_map (fun n -> (LinkExpToExp, n, "")) trg + | _ -> IList.map (fun n -> (LinkExpToExp, n, "")) trg ) (* build the set of edges between nodes *) @@ -503,8 +503,8 @@ let rec dotty_mk_set_links dotnodes sigma p f = | n:: nl -> 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 = list_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 = list_flatten (list_map ff (n:: nl)) in + 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 trg_label = strip_special_chars (Sil.exp_to_string e) in let lnk = mk_link (LinkToArray) (mk_coordinate n lambda) "" (mk_coordinate (n + 1) lambda) trg_label in @@ -518,16 +518,16 @@ let rec dotty_mk_set_links dotnodes sigma p f = (match src with | [] -> assert false | nl -> - (* L.out "@\n@\n List of nl= "; list_iter (L.out " %i ") nl; L.out "@.@.@."; *) + (* L.out "@\n@\n List of nl= "; IList.iter (L.out " %i ") nl; L.out "@.@.@."; *) let target_list = compute_target_struct_fields dotnodes lfld p f lambda in - let ff n = list_map (fun (k, lab_src, m, lab_trg) -> mk_link k (mk_coordinate n lambda) lab_src (mk_coordinate m lambda) lab_trg) target_list in + let ff n = IList.map (fun (k, lab_src, m, lab_trg) -> mk_link k (mk_coordinate n lambda) lab_src (mk_coordinate m lambda) lab_trg) target_list in let nodes_e = select_nodes_exp_lambda dotnodes e lambda in let address_struct_id = - try get_coordinate_id (list_hd (list_filter (is_source_node_of_exp e) nodes_e)) + try get_coordinate_id (IList.hd (IList.filter (is_source_node_of_exp e) nodes_e)) with exn when exn_not_timeout exn -> (* L.out "@\n@\n PROBLEMS!!!!!!!!!!@.@.@."; *) assert false in (* we need to exclude the address node from the sorce of fields. no fields should start from there*) - let nl'= list_filter (fun id -> address_struct_id != id) nl in - let links_from_fields = list_flatten (list_map ff nl') in + let nl'= IList.filter (fun id -> address_struct_id != id) nl in + let links_from_fields = IList.flatten (IList.map ff nl') in let trg_label = strip_special_chars (Sil.exp_to_string e) in let lnk_from_address_struct = mk_link (LinkExpToStruct) (mk_coordinate address_struct_id lambda) "" (mk_coordinate (address_struct_id + 1) lambda) trg_label in @@ -540,8 +540,8 @@ let rec dotty_mk_set_links dotnodes sigma p f = | [] -> assert false | nl -> let target_list = compute_target_from_eexp dotnodes e' p f lambda in - let ff n = list_map (fun (k, m, lab_target) -> mk_link k (mk_coordinate n lambda) "" (mk_coordinate m lambda) (strip_special_chars lab_target)) target_list in - let ll = list_flatten (list_map ff nl) in + let ff n = IList.map (fun (k, m, lab_target) -> 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 ll @ dotty_mk_set_links dotnodes sigma' p f ) @@ -550,7 +550,7 @@ let rec dotty_mk_set_links dotnodes sigma p f = (match src with | [] -> assert false | n:: _ -> - let (_, m, lab) = list_hd (compute_target_from_eexp dotnodes e2 p f lambda) in + let (_, m, lab) = IList.hd (compute_target_from_eexp dotnodes e2 p f 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 ) @@ -625,9 +625,9 @@ let dotty_pp_link f link = 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 = list_filter (fun n' -> not (list_mem Pervasives.(=) n' ln)) !tmp_links in + let remove_links_from ln = IList.filter (fun n' -> not (IList.mem Pervasives.(=) n' ln)) !tmp_links in let remove_node n ns = - list_filter (fun n' -> match n' with + IList.filter (fun n' -> match n' with | Dotpointsto _ -> (get_coordinate_id n')!= (get_coordinate_id n) | _ -> true ) ns in @@ -660,14 +660,14 @@ let filter_useless_spec_dollar_box (nodes: dotty_node list) (links: link list) = (*L.out "@\n Found a spec expression = %s @.@." (Sil.exp_to_string e); *) let links_from_node = boxes_pointed_by node links in let links_to_node = boxes_pointing_at node links in - (* L.out "@\n Size of links_from=%i links_to=%i @.@." (list_length links_from_node) (list_length links_to_node); *) + (* L.out "@\n Size of links_from=%i links_to=%i @.@." (IList.length links_from_node) (IList.length links_to_node); *) if links_to_node =[] then begin tmp_links:= remove_links_from links_from_node ; tmp_nodes:= remove_node node !tmp_nodes; end end | _ -> () in - list_iter handle_one_node nodes; + IList.iter handle_one_node nodes; (!tmp_nodes,!tmp_links) (* print a struct node *) @@ -758,12 +758,12 @@ and build_visual_graph f pe p = compute_fields_struct sigma; compute_struct_exp_nodes sigma; (* L.out "@\n@\n Computed fields structs: "; - list_iter (fun e -> L.out " %a " (Sil.pp_exp pe) e) !fields_structs; + IList.iter (fun e -> L.out " %a " (Sil.pp_exp pe) e) !fields_structs; L.out "@\n@."; L.out "@\n@\n Computed exp structs nodes: "; - list_iter (fun e -> L.out " %a " (Sil.pp_exp pe) e) !struct_exp_nodes; + IList.iter (fun e -> L.out " %a " (Sil.pp_exp pe) e) !struct_exp_nodes; L.out "@\n@."; *) - let sigma_lambda = list_map (fun hp -> (hp,!lambda_counter)) sigma in + let sigma_lambda = IList.map (fun hp -> (hp,!lambda_counter)) sigma in let nodes = (dotty_mk_node pe) sigma_lambda in make_dangling_boxes pe nodes sigma_lambda; let links = dotty_mk_set_links nodes sigma_lambda p f in @@ -815,8 +815,8 @@ and pp_dotty f kind (_prop: Prop.normal Prop.t) = end; (* F.fprintf f "\n subgraph cluster_%i { color=black \n" !dotty_state_count; *) let (nodes, links) = build_visual_graph f pe prop in - list_iter (dotty_pp_state f pe) (nodes@ !dangling_dotboxes @ !nil_dotboxes); - list_iter (dotty_pp_link f) links; + IList.iter (dotty_pp_state f pe) (nodes@ !dangling_dotboxes @ !nil_dotboxes); + IList.iter (dotty_pp_link f) links; (* F.fprintf f "\n } \n"; *) F.fprintf f "\n } \n" @@ -832,7 +832,7 @@ let pp_dotty_one_spec f pre posts = invisible_arrows:= true; pp_dotty f (Spec_precondition) pre; invisible_arrows:= false; - list_iter (fun (po, path) -> incr post_counter ; pp_dotty f (Spec_postcondition pre) po; + IList.iter (fun (po, path) -> incr post_counter ; pp_dotty f (Spec_postcondition pre) po; for j = 1 to 4 do F.fprintf f " inv_%i%i%i%i -> state_pi_%i [style=invis]\n" !spec_counter j j j !target_invisible_arrow_pre; done @@ -847,7 +847,7 @@ let pp_dotty_prop_list_in_path f plist prev_n curr_n = F.fprintf f "\n subgraph cluster_%i { color=blue \n" !dotty_state_count; incr dotty_state_count; F.fprintf f "\n state%iN [label=\"NODE %i \", style=filled, color= lightblue]\n" curr_n curr_n; - list_iter (fun po -> incr proposition_counter ; pp_dotty f (Generic_proposition) po) plist; + IList.iter (fun po -> incr proposition_counter ; pp_dotty f (Generic_proposition) po) plist; if prev_n <> - 1 then F.fprintf f "\n state%iN ->state%iN\n" prev_n curr_n; F.fprintf f "\n } \n" with exn when exn_not_timeout exn -> @@ -875,7 +875,7 @@ let pp_proplist_parsed2dotty_file filename plist = F.fprintf f "\n\n\ndigraph main { \nnode [shape=box];\n"; F.fprintf f "\n compound = true; \n"; F.fprintf f "\n /* size=\"12,7\"; ratio=fill;*/ \n"; - ignore (list_map (pp_dotty f Generic_proposition) plist); + ignore (IList.map (pp_dotty f Generic_proposition) plist); F.fprintf f "\n}" in let outc = open_out filename in let fmt = F.formatter_of_out_channel outc in @@ -892,11 +892,11 @@ let pp_cfgnodename fmt (n : Cfg.Node.t) = F.fprintf fmt "%d" (Cfg.Node.get_id n) let pp_etlist fmt etl = - list_iter (fun (id, ty) -> + IList.iter (fun (id, ty) -> Format.fprintf fmt " %s:%a" id (Sil.pp_typ_full pe_text) ty) etl let pp_local_list fmt etl = - list_iter (fun (id, ty) -> + IList.iter (fun (id, ty) -> Format.fprintf fmt " %a:%a" Mangled.pp id (Sil.pp_typ_full pe_text) ty) etl let pp_cfgnodelabel fmt (n : Cfg.Node.t) = @@ -914,7 +914,7 @@ let pp_cfgnodelabel fmt (n : Cfg.Node.t) = gen pp_etlist (Cfg.Procdesc.get_formals pdesc) pp_local_list (Cfg.Procdesc.get_locals pdesc); - if list_length (Cfg.Procdesc.get_captured pdesc) <> 0 then + if IList.length (Cfg.Procdesc.get_captured pdesc) <> 0 then Format.fprintf fmt "\\nCaptured: %a" pp_local_list (Cfg.Procdesc.get_captured pdesc) | Cfg.Node.Exit_node (pdesc) -> @@ -929,7 +929,7 @@ let pp_cfgnodelabel fmt (n : Cfg.Node.t) = let str = pp_to_string pp () in Escape.escape_dotty str in let pp_instrs fmt instrs = - list_iter (fun i -> F.fprintf fmt " %s\\n " (instr_string i)) instrs in + IList.iter (fun i -> F.fprintf fmt " %s\\n " (instr_string i)) instrs in let instrs = Cfg.Node.get_instrs n in F.fprintf fmt "%d: %a \\n %a" (Cfg.Node.get_id n) pp_label n pp_instrs instrs @@ -957,8 +957,8 @@ let pp_cfgnode fmt (n: Cfg.Node.t) = () | _ -> F.fprintf fmt "\n\t %d -> %d %s;" (Cfg.Node.get_id n1) (Cfg.Node.get_id n2) color in - list_iter (fun n' -> print_edge n n' false) (Cfg.Node.get_succs n); - list_iter (fun n' -> print_edge n n' true) (Cfg.Node.get_exn n) + IList.iter (fun n' -> print_edge n n' false) (Cfg.Node.get_succs n); + IList.iter (fun n' -> print_edge n n' true) (Cfg.Node.get_exn n) (* * print control flow graph (in dot form) for fundec to channel let *) (* print_cfg_channel (chan : out_channel) (fd : fundec) = let pnode (s: *) @@ -975,14 +975,14 @@ let print_icfg fmt cfg = let loc = Cfg.Node.get_loc node in if (!Config.dotty_cfg_libs || DB.source_file_equal loc.Location.file !DB.current_source) then F.fprintf fmt "%a\n" pp_cfgnode node in - list_iter print_node (Cfg.Node.get_all_nodes cfg) + IList.iter print_node (Cfg.Node.get_all_nodes cfg) let print_edges fmt edges = let count = ref 0 in let print_edge (n1, n2) = incr count; F.fprintf fmt "%a -> %a [color=\"red\" label=\"%d\" fontcolor=\"green\"];" pp_cfgnodename n1 pp_cfgnodename n2 !count in - list_iter print_edge edges + IList.iter print_edge edges let print_icfg_dotty cfg (extra_edges : (Cfg.Node.t * Cfg.Node.t) list) = let chan = open_out (DB.filename_to_string (DB.Results_dir.path_to_filename DB.Results_dir.Abs_source_dir [!Config.dotty_output])) in @@ -1012,7 +1012,7 @@ let pp_speclist_dotty f (splist: Prop.normal Specs.spec list) = F.fprintf f "@\n@\n\ndigraph main { \nnode [shape=box]; @\n"; F.fprintf f "@\n compound = true; @\n"; (* F.fprintf f "\n size=\"12,7\"; ratio=fill; \n"; *) - list_iter (fun s -> pp_dotty_one_spec f (Specs.Jprop.to_prop s.Specs.pre) s.Specs.posts) splist; + IList.iter (fun s -> pp_dotty_one_spec f (Specs.Jprop.to_prop s.Specs.pre) s.Specs.posts) splist; F.fprintf f "@\n}"; Config.pp_simple := pp_simple_saved @@ -1079,7 +1079,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 = list_filter (fun b -> match b with + let entry_e = IList.filter (fun b -> match b with | VH_dangling(_, e') -> Sil.exp_equal e e' | _ -> false ) !set_dangling_nodes in match entry_e with |[] -> None @@ -1129,7 +1129,7 @@ let rec select_node_at_address nodes e = (* look-up the ids in the list of nodes corresponding to expression e*) (* let look_up_nodes_ids nodes e = - list_map get_node_id (select_nodes_exp nodes e) *) + IList.map get_node_id (select_nodes_exp nodes e) *) (* create a list of dangling nodes *) let make_set_dangling_nodes allocated_nodes (sigma: Sil.hpred list) = @@ -1150,7 +1150,7 @@ let make_set_dangling_nodes allocated_nodes (sigma: Sil.hpred list) = | _ -> [] (* arrays and struct do not give danglings. CHECK THIS!*) ) in let is_not_allocated e = - let allocated = list_exists (fun a -> match a with + let allocated = IList.exists (fun a -> match a with | VH_pointsto(_, e', _, _) | VH_lseg(_, e', _ , _) | VH_dllseg(_, e', _, _, _, _) -> Sil.exp_equal e e' @@ -1160,12 +1160,12 @@ let make_set_dangling_nodes allocated_nodes (sigma: Sil.hpred list) = match l with | [] -> [] | e:: l' -> - if (list_exists (Sil.exp_equal e) seen_exp) then filter_duplicate l' seen_exp + if (IList.exists (Sil.exp_equal e) seen_exp) then filter_duplicate l' seen_exp else e:: filter_duplicate l' (e:: seen_exp) in - let rhs_exp_list = list_flatten (list_map get_rhs_predicate sigma) in + let rhs_exp_list = IList.flatten (IList.map get_rhs_predicate sigma) in let candidate_dangling_exps = filter_duplicate rhs_exp_list [] in - let dangling_exps = list_filter is_not_allocated candidate_dangling_exps in (* get rid of allocated ones*) - list_map make_new_dangling dangling_exps + let dangling_exps = IList.filter is_not_allocated candidate_dangling_exps in (* get rid of allocated ones*) + IList.map make_new_dangling dangling_exps (* return a list of pairs (n,field_lab) where n is a target node*) (* corresponding to se and is going to be used a target for and edge*) @@ -1212,7 +1212,7 @@ let rec make_visual_heap_edges nodes sigma prop = | None -> assert false | Some n -> let target_nodes = compute_target_nodes_from_sexp nodes se prop "" in - let ll = list_map (combine_source_target_label n) target_nodes in + let ll = IList.map (combine_source_target_label n) target_nodes in ll @ make_visual_heap_edges nodes sigma' prop ) | Sil.Hlseg (_, pred, e1, e2, elist):: sigma' -> @@ -1221,7 +1221,7 @@ let rec make_visual_heap_edges nodes sigma prop = | None -> assert false | Some n -> let target_nodes = compute_target_nodes_from_sexp nodes (Sil.Eexp (e2, Sil.inst_none)) prop "" in - let ll = list_map (combine_source_target_label n) target_nodes in + let ll = IList.map (combine_source_target_label n) target_nodes in ll @ make_visual_heap_edges nodes sigma' prop ) @@ -1232,8 +1232,8 @@ let rec make_visual_heap_edges nodes sigma prop = | Some n -> let target_nodesF = compute_target_nodes_from_sexp nodes (Sil.Eexp (e3, Sil.inst_none)) prop "" in let target_nodesB = compute_target_nodes_from_sexp nodes (Sil.Eexp (e2, Sil.inst_none)) prop "" in - let llF = list_map (combine_source_target_label n) target_nodesF in - let llB = list_map (combine_source_target_label n) target_nodesB in + let llF = IList.map (combine_source_target_label n) target_nodesF in + let llB = IList.map (combine_source_target_label n) target_nodesB in llF @ llB @ make_visual_heap_edges nodes sigma' prop ) @@ -1244,8 +1244,8 @@ let prop_to_set_of_visual_heaps prop = incr global_node_counter; while (!working_list!=[]) do set_dangling_nodes:=[]; - let (n, h) = list_hd !working_list in - working_list:= list_tl !working_list; + let (n, h) = IList.hd !working_list in + working_list:= IList.tl !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 @@ -1259,10 +1259,10 @@ let rec pointsto_contents_to_xml (co: Sil.strexp) : Io_infer.Xml.node = Io_infer.Xml.create_tree "cell" [("content-value", exp_to_xml_string e)] [] | Sil.Estruct (fel, _) -> let f (fld, exp) = Io_infer.Xml.create_tree "struct-field" [("id", Ident.fieldname_to_string fld)] [(pointsto_contents_to_xml exp)] in - Io_infer.Xml.create_tree "struct" [] (list_map f fel) + Io_infer.Xml.create_tree "struct" [] (IList.map f fel) | Sil.Earray (size, nel, _) -> let f (e, se) = Io_infer.Xml.create_tree "array-element" [("index", exp_to_xml_string e)] [pointsto_contents_to_xml se] in - Io_infer.Xml.create_tree "array" [("size", exp_to_xml_string size)] (list_map f nel) + Io_infer.Xml.create_tree "array" [("size", exp_to_xml_string size)] (IList.map f nel) (* Convert an atom to xml in a light version. Namely, the expressions are not fully blown-up into *) (* xml tree but visualized as strings *) @@ -1278,7 +1278,7 @@ let atom_to_xml_light (a: Sil.atom) : Io_infer.Xml.node = let xml_pure_info prop = let pure = Prop.get_pure prop in - let xml_atom_list = list_map atom_to_xml_light pure in + let xml_atom_list = IList.map atom_to_xml_light pure in Io_infer.Xml.create_tree "stack" [] xml_atom_list (** Return a string describing the kind of a pointsto address *) @@ -1320,14 +1320,14 @@ let heap_edge_to_xml edge = let visual_heap_to_xml heap = let (n, nodes, edges) = heap in - let xml_heap_nodes = list_map heap_node_to_xml nodes in - let xml_heap_edges = list_map heap_edge_to_xml edges in + let xml_heap_nodes = IList.map heap_node_to_xml nodes in + let xml_heap_edges = IList.map heap_edge_to_xml edges in Io_infer.Xml.create_tree "heap" [("id", string_of_int n)] (xml_heap_nodes @ xml_heap_edges) (** convert a proposition to xml with the given tag and id *) let prop_to_xml prop tag_name id = let visual_heaps = prop_to_set_of_visual_heaps prop in - let xml_visual_heaps = list_map visual_heap_to_xml visual_heaps in + let xml_visual_heaps = IList.map visual_heap_to_xml visual_heaps in let xml_pure_part = xml_pure_info prop in let xml_graph = Io_infer.Xml.create_tree tag_name [("id", string_of_int id)] (xml_visual_heaps @ [xml_pure_part]) in xml_graph @@ -1345,11 +1345,11 @@ let print_specs_xml signature specs loc fmt = Prop.normalize _prop' in let jj = ref 0 in let xml_pre = prop_to_xml pre "precondition" !jj in - let xml_spec = xml_pre:: (list_map (fun (po, path) -> jj:=!jj + 1; prop_to_xml (add_stack_to_prop po) "postcondition" !jj) posts) in + let xml_spec = xml_pre:: (IList.map (fun (po, path) -> jj:=!jj + 1; prop_to_xml (add_stack_to_prop po) "postcondition" !jj) posts) in Io_infer.Xml.create_tree "specification" [("id", string_of_int n)] xml_spec in let j = ref 0 in let list_of_specs_xml = - list_map + IList.map (fun s -> j:=!j + 1; do_one_spec (Specs.Jprop.to_prop s.Specs.pre) s.Specs.posts !j) diff --git a/infer/src/backend/errdesc.ml b/infer/src/backend/errdesc.ml index 4c80becea..12c15a5d6 100644 --- a/infer/src/backend/errdesc.ml +++ b/infer/src/backend/errdesc.ml @@ -54,7 +54,7 @@ let find_variable_assigment node id : Sil.instr option = res := Some instr; true | _ -> false in - ignore (list_exists find_set node_instrs); + ignore (IList.exists find_set node_instrs); !res (** Check if a nullify instruction exists for the program variable after the given instruction *) @@ -66,7 +66,7 @@ let find_nullify_after_instr node instr pvar : bool = | _instr -> if instr = _instr then found_instr := true; false in - list_exists find_nullify node_instrs + IList.exists find_nullify node_instrs (** Find the other prune node of a conditional (e.g. the false branch given the true branch of a conditional) *) let find_other_prune_node node = @@ -104,10 +104,10 @@ let find_normal_variable_funcall let node_instrs = Cfg.Node.get_instrs node in let find_declaration = function | Sil.Call ([id0], fun_exp, args, loc, call_flags) when Ident.equal id id0 -> - res := Some (fun_exp, list_map fst args, loc, call_flags); + res := Some (fun_exp, IList.map fst args, loc, call_flags); true | _ -> false in - ignore (list_exists find_declaration node_instrs); + ignore (IList.exists find_declaration node_instrs); if !verbose && !res == None then (L.d_str ("find_normal_variable_funcall could not find " ^ Ident.to_string id ^ " in node " ^ string_of_int (Cfg.Node.get_id node)); L.d_ln ()); !res @@ -126,7 +126,7 @@ let find_program_variable_assignment node pvar : (Cfg.Node.t * Ident.t) option = res := Some (node, id); true | _ -> false in - if list_exists find_instr (Cfg.Node.get_instrs node) + if IList.exists find_instr (Cfg.Node.get_instrs node) then !res else match Cfg.Node.get_preds node with | [pred_node] -> @@ -153,7 +153,7 @@ let find_ident_assignment node id : (Cfg.Node.t * Sil.exp) option = res := Some (node, e); true | _ -> false in - if list_exists find_instr (Cfg.Node.get_instrs node) + if IList.exists find_instr (Cfg.Node.get_instrs node) then !res else match Cfg.Node.get_preds node with | [pred_node] -> @@ -174,7 +174,7 @@ let rec find_boolean_assignment node pvar true_branch : Cfg.Node.t option = | Sil.Set (Sil.Lvar _pvar, _, Sil.Const (Sil.Cint i), _) when Sil.pvar_equal pvar _pvar -> Sil.Int.iszero i <> true_branch | _ -> false in - list_exists filter (Cfg.Node.get_instrs n) in + IList.exists filter (Cfg.Node.get_instrs n) in match Cfg.Node.get_preds node with | [pred_node] -> find_boolean_assignment pred_node pvar true_branch | [n1; n2] -> @@ -236,17 +236,17 @@ let rec _find_normal_variable_letderef (seen : Sil.ExpSet.t) node id : Sil.dexp let fun_dexp = Sil.Dconst (Sil.Cfun pname) in let args_dexp = - let args_dexpo = list_map (fun (e, _) -> _exp_rv_dexp seen node e) args in - if list_exists (fun x -> x = None) args_dexpo + let args_dexpo = IList.map (fun (e, _) -> _exp_rv_dexp seen node e) args in + if IList.exists (fun x -> x = None) args_dexpo then [] else let unNone = function Some x -> x | None -> assert false in - list_map unNone args_dexpo in + IList.map unNone args_dexpo in res := Some (Sil.Dretcall (fun_dexp, args_dexp, loc, call_flags)); true | _ -> false in - ignore (list_exists find_declaration node_instrs); + ignore (IList.exists find_declaration node_instrs); if !verbose && !res == None then (L.d_str ("find_normal_variable_letderef could not find " ^ Ident.to_string id ^ " in node " ^ string_of_int (Cfg.Node.get_id node)); L.d_ln ()); !res @@ -286,11 +286,11 @@ and _exp_lv_dexp (_seen : Sil.ExpSet.t) node e : Sil.dexp option = match find_normal_variable_funcall node' id with | Some (fun_exp, eargs, loc, call_flags) -> let fun_dexpo = _exp_rv_dexp seen node' fun_exp in - let blame_args = list_map (_exp_rv_dexp seen node') eargs in - if list_exists (fun x -> x = None) (fun_dexpo:: blame_args) then None + let blame_args = IList.map (_exp_rv_dexp seen node') eargs in + if IList.exists (fun x -> x = None) (fun_dexpo:: blame_args) then None else let unNone = function Some x -> x | None -> assert false in - let args = list_map unNone blame_args in + let args = IList.map unNone blame_args in Some (Sil.Dfcall (unNone fun_dexpo, args, loc, call_flags)) | None -> _exp_rv_dexp seen node' (Sil.Var id) @@ -435,9 +435,9 @@ let leak_from_list_abstraction hpred prop = | Some texp' when Sil.exp_equal texp texp' -> found := true | _ -> () in let check_hpara texp n hpara = - list_iter (check_hpred texp) hpara.Sil.body in + IList.iter (check_hpred texp) hpara.Sil.body in let check_hpara_dll texp n hpara = - list_iter (check_hpred texp) hpara.Sil.body_dll in + IList.iter (check_hpred texp) hpara.Sil.body_dll in match hpred_type hpred with | Some texp -> let env = Prop.prop_pred_env prop in @@ -458,7 +458,7 @@ let find_pvar_typ_without_ptr tenv prop pvar = | Sil.Hpointsto (e, _, te) when Sil.exp_equal e (Sil.Lvar pvar) -> res := Some te | _ -> () in - list_iter do_hpred (Prop.get_sigma prop); + IList.iter do_hpred (Prop.get_sigma prop); !res (** Produce a description of a leak by looking at the current state. @@ -517,8 +517,8 @@ let explain_leak tenv hpred prop alloc_att_opt bucket = if !verbose then (L.d_str "explain_leak: found nullify before Abstract for pvar "; Sil.d_pvar pvar; L.d_ln ()); [pvar] | _ -> [] in - let nullify_pvars = list_flatten (list_map get_nullify node_instrs) in - let nullify_pvars_notmp = list_filter (fun pvar -> not (pvar_is_frontend_tmp pvar)) nullify_pvars in + let nullify_pvars = IList.flatten (IList.map get_nullify node_instrs) in + let nullify_pvars_notmp = IList.filter (fun pvar -> not (pvar_is_frontend_tmp pvar)) nullify_pvars in value_str_from_pvars_vpath nullify_pvars_notmp vpath | Some (Sil.Set (lexp, _, _, _)) when vpath = None -> if !verbose then (L.d_str "explain_leak: current instruction Set for "; Sil.d_exp lexp; L.d_ln ()); @@ -545,13 +545,13 @@ let vpath_find prop _exp : Sil.dexp option * Sil.typ option = let rec find sigma_acc sigma_todo exp = let do_fse res sigma_acc' sigma_todo' lexp texp (f, se) = match se with | Sil.Eexp (e, _) when Sil.exp_equal exp e -> - let sigma' = (list_rev_append sigma_acc' sigma_todo') in + let sigma' = (IList.rev_append sigma_acc' sigma_todo') in (match lexp with | Sil.Lvar pv -> let typo = match texp with | Sil.Sizeof (Sil.Tstruct (ftl, ftal, _, _, _, _, _), _) -> (try - let _, t, _ = list_find (fun (_f, _t, _) -> Ident.fieldname_equal _f f) ftl in + let _, t, _ = IList.find (fun (_f, _t, _) -> Ident.fieldname_equal _f f) ftl in Some t with Not_found -> None) | _ -> None in @@ -565,7 +565,7 @@ let vpath_find prop _exp : Sil.dexp option * Sil.typ option = | _ -> () in let do_sexp sigma_acc' sigma_todo' lexp sexp texp = match sexp with | Sil.Eexp (e, _) when Sil.exp_equal exp e -> - let sigma' = (list_rev_append sigma_acc' sigma_todo') in + let sigma' = (IList.rev_append sigma_acc' sigma_todo') in (match lexp with | Sil.Lvar pv when not (pvar_is_frontend_tmp pv) -> let typo = match texp with @@ -581,7 +581,7 @@ let vpath_find prop _exp : Sil.dexp option * Sil.typ option = None, None) | Sil.Estruct (fsel, _) -> let res = ref (None, None) in - list_iter (do_fse res sigma_acc' sigma_todo' lexp texp) fsel; + IList.iter (do_fse res sigma_acc' sigma_todo' lexp texp) fsel; !res | sexp -> None, None in @@ -590,7 +590,7 @@ let vpath_find prop _exp : Sil.dexp option * Sil.typ option = let filter = function | (ni, Sil.Var id') -> Ident.is_normal ni && Ident.equal id' id | _ -> false in - list_exists filter (Sil.sub_to_list (Prop.get_sub prop)) in + IList.exists filter (Sil.sub_to_list (Prop.get_sub prop)) in function | Sil.Hpointsto (Sil.Lvar pv, sexp, texp) when (Sil.pvar_is_local pv || Sil.pvar_is_global pv || Sil.pvar_is_seed pv) -> do_sexp sigma_acc' sigma_todo' (Sil.Lvar pv) sexp texp @@ -632,7 +632,7 @@ let explain_dexp_access prop dexp is_nullable = | Sil.Hpointsto (e', se, _) when Sil.exp_equal e e' -> res := Some se | _ -> () in - list_iter do_hpred sigma; + IList.iter do_hpred sigma; !res in let rec lookup_fld fsel f = match fsel with | [] -> @@ -875,7 +875,7 @@ let explain_nth_function_parameter use_buckets deref_str prop n pvar_off = match State.get_instr () with | Some Sil.Call (_, _, args, _, _) -> (try - let arg = fst (list_nth args (n - 1)) in + let arg = fst (IList.nth args (n - 1)) in let dexp_opt = exp_rv_dexp node arg in let dexp_opt' = match dexp_opt with | Some de -> @@ -891,12 +891,12 @@ let find_pvar_with_exp prop exp = let found_in_pvar pv = res := Some (pv, Fpvar) in let found_in_struct pv fld_lst = (* found_in_pvar has priority *) - if !res = None then res := Some (pv, Fstruct (list_rev fld_lst)) in + if !res = None then res := Some (pv, Fstruct (IList.rev fld_lst)) in let rec search_struct pv fld_lst = function | Sil.Eexp (e, _) -> if Sil.exp_equal e exp then found_in_struct pv fld_lst | Sil.Estruct (fsel, _) -> - list_iter (fun (f, se) -> search_struct pv (f:: fld_lst) se) fsel + IList.iter (fun (f, se) -> search_struct pv (f:: fld_lst) se) fsel | _ -> () in let do_hpred_pointed_by_pvar pv e = function | Sil.Hpointsto(e1, se, _) -> @@ -905,9 +905,9 @@ let find_pvar_with_exp prop exp = let do_hpred = function | Sil.Hpointsto(Sil.Lvar pv, Sil.Eexp (e, _), _) -> if Sil.exp_equal e exp then found_in_pvar pv - else list_iter (do_hpred_pointed_by_pvar pv e) (Prop.get_sigma prop) + else IList.iter (do_hpred_pointed_by_pvar pv e) (Prop.get_sigma prop) | _ -> () in - list_iter do_hpred (Prop.get_sigma prop); + IList.iter do_hpred (Prop.get_sigma prop); !res (** return a description explaining value [exp] in [prop] in terms of a source expression diff --git a/infer/src/backend/errlog.ml b/infer/src/backend/errlog.ml index 24131b822..ebe166ca0 100644 --- a/infer/src/backend/errlog.ml +++ b/infer/src/backend/errlog.ml @@ -245,7 +245,7 @@ module Err_table = struct ErrLogHash.iter f err_table; let pp ekind (nodeidkey, session, loc, mloco, ltr, pre_opt, eclass) fmt err_names = - list_iter (fun (err_name, desc) -> + IList.iter (fun (err_name, desc) -> Exceptions.pp_err nodeidkey loc ekind err_name desc mloco fmt ()) err_names in F.fprintf fmt "@.Detailed errors during footprint phase:@."; LocMap.iter (fun nslm err_names -> diff --git a/infer/src/backend/exe_env.ml b/infer/src/backend/exe_env.ml index 9c493112a..c333441c9 100644 --- a/infer/src/backend/exe_env.ml +++ b/infer/src/backend/exe_env.ml @@ -97,7 +97,7 @@ let add_cg_exclude_fun (exe_env: t) (source_dir : DB.source_dir) exclude_fun = Cg.extend exe_env.cg cg; let file_data = new_file_data source nLOC cg_fname in let defined_procs = Cg.get_defined_nodes cg in - list_iter (fun pname -> + IList.iter (fun pname -> let should_update = if Procname.Hash.mem exe_env.proc_map pname then let old_source = (Procname.Hash.find exe_env.proc_map pname).source in diff --git a/infer/src/backend/fork.ml b/infer/src/backend/fork.ml index af6a25c04..1fc083bad 100644 --- a/infer/src/backend/fork.ml +++ b/infer/src/backend/fork.ml @@ -30,7 +30,7 @@ let compute_weighed_pnameset gr = let pnameset = ref WeightedPnameSet.empty in let add_pname_calls (pn, calls) = pnameset := WeightedPnameSet.add (pn, calls) !pnameset in - list_iter add_pname_calls (Cg.get_nodes_and_calls gr); + IList.iter add_pname_calls (Cg.get_nodes_and_calls gr); !pnameset (* Return true if there are no children of [pname] whose specs @@ -71,7 +71,7 @@ let transition_footprint_re_exe proc_name joined_pres = Specs.dependency_map = Specs.re_initialize_dependency_map summary.Specs.dependency_map; Specs.payload = let specs = - list_map + IList.map (fun jp -> Specs.spec_normalize { Specs.pre = jp; @@ -95,7 +95,7 @@ let update_specs proc_name (new_specs : Specs.NormSpec.t list) : Specs.NormSpec. let changed = ref false in let current_specs = ref - (list_fold_left + (IList.fold_left (fun map spec -> SpecMap.add spec.Specs.pre @@ -103,7 +103,7 @@ let update_specs proc_name (new_specs : Specs.NormSpec.t list) : Specs.NormSpec. SpecMap.empty old_specs) in let re_exe_filter old_spec = (* filter out pres which failed re-exe *) if phase == Specs.RE_EXECUTION && - not (list_exists + not (IList.exists (fun new_spec -> Specs.Jprop.equal new_spec.Specs.pre old_spec.Specs.pre) new_specs) then begin @@ -143,8 +143,8 @@ let update_specs proc_name (new_specs : Specs.NormSpec.t list) : Specs.NormSpec. { Specs.pre = pre; Specs.posts = Paths.PathSet.elements post_set; Specs.visited = visited }:: !res in - list_iter re_exe_filter old_specs; (* filter out pre's which failed re-exe *) - list_iter add_spec new_specs; (* add new specs *) + IList.iter re_exe_filter old_specs; (* filter out pre's which failed re-exe *) + IList.iter add_spec new_specs; (* add new specs *) SpecMap.iter convert !current_specs; !res,!changed @@ -188,7 +188,7 @@ let post_process_procs exe_env procs_done = "No specs found for %a@." Procname.pp pn end in let cg = Exe_env.get_cg exe_env in - list_iter (fun pn -> + IList.iter (fun pn -> let elem = (pn, Cg.get_calls cg pn) in if WeightedPnameSet.mem elem !wpnames_todo then begin diff --git a/infer/src/backend/iList.ml b/infer/src/backend/iList.ml new file mode 100644 index 000000000..51d2205db --- /dev/null +++ b/infer/src/backend/iList.ml @@ -0,0 +1,182 @@ +(* + * Copyright (c) 2015 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +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 length = List.length +let nth = List.nth +let partition = List.partition +let rev = List.rev +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 + +(** tail-recursive variant of List.fold_right *) +let fold_right f l a = + let g x y = f y x in + fold_left g a (rev l) + +(** tail-recursive variant of List.combine *) +let combine = + let rec combine acc l1 l2 = match l1, l2 with + | [], [] -> acc + | x1:: l1, x2:: l2 -> combine ((x1, x2):: acc) l1 l2 + | [], _:: _ + | _:: _, [] -> raise (Invalid_argument "IList.combine") in + fun l1 l2 -> rev (combine [] l1 l2) + +(** tail-recursive variant of List.split *) +let split = + let rec split acc1 acc2 = function + | [] -> (acc1, acc2) + | (x, y):: l -> split (x:: acc1) (y:: acc2) l in + fun l -> + let acc1, acc2 = split [] [] l in + rev acc1, rev acc2 + +(** Like List.mem but without builtin equality *) +let mem equal x l = exists (equal x) l + +(** tail-recursive variant of List.flatten *) +let flatten = + let rec flatten acc l = match l with + | [] -> 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 + +let rec drop_first n = function + | xs when n == 0 -> xs + | x:: xs -> drop_first (n - 1) xs + | [] -> [] + +let drop_last n list = + rev (drop_first n (rev list)) + +(** Generic comparison of lists given a compare function for the elements of the list *) +let rec compare cmp l1 l2 = + match l1, l2 with + | [],[] -> 0 + | [], _ -> - 1 + | _, [] -> 1 + | x1:: l1', x2:: l2' -> + let n = cmp x1 x2 in + if n <> 0 then n else compare cmp l1' l2' + +(** Generic equality of lists given a compare function for the elements of the list *) +let equal cmp l1 l2 = + compare cmp l1 l2 = 0 + +(** Returns (reverse input_list) *) +let rec rev_with_acc acc = function + | [] -> acc + | x :: xs -> rev_with_acc (x:: acc) xs + +(** tail-recursive variant of List.append *) +let append l1 l2 = + rev_append (rev l1) l2 + +(** tail-recursive variant of List.map *) +let map f l = + rev (rev_map f l) + +(** Remove consecutive equal elements from a list (according to the given comparison functions) *) +let remove_duplicates compare l = + let rec remove compare acc = function + | [] -> rev acc + | [x] -> rev (x:: acc) + | x:: ((y:: l'') as l') -> + if compare x y = 0 then remove compare acc (x:: l'') + else remove compare (x:: acc) l' in + remove compare [] l + +(** Remove consecutive equal irrelevant elements from a list (according to the given comparison and relevance functions) *) +let remove_irrelevant_duplicates compare relevant l = + let rec remove compare acc = function + | [] -> rev acc + | [x] -> rev (x:: acc) + | x:: ((y:: l'') as l') -> + if compare x y = 0 then begin + match relevant x, relevant y with + | false, _ -> remove compare acc l' + | true, false -> remove compare acc (x:: l'') + | true, true -> remove compare (x:: acc) l' + end + else remove compare (x:: acc) l' in + remove compare [] l + +(** The function works on sorted lists without duplicates *) +let rec merge_sorted_nodup compare res xs1 xs2 = + match xs1, xs2 with + | [], _ -> + rev_with_acc xs2 res + | _, [] -> + rev_with_acc xs1 res + | x1 :: xs1', x2 :: xs2' -> + let n = compare x1 x2 in + if n = 0 then + merge_sorted_nodup compare (x1 :: res) xs1' xs2' + else if n < 0 then + merge_sorted_nodup compare (x1 :: res) xs1' xs2 + else + merge_sorted_nodup compare (x2 :: res) xs1 xs2' + +let intersect compare l1 l2 = + let l1_sorted = sort compare l1 in + let l2_sorted = sort compare l2 in + let rec f l1 l2 = match l1, l2 with + | ([], _) | (_,[]) -> false + | (x1:: l1', x2:: l2') -> + let x_comparison = compare x1 x2 in + if x_comparison = 0 then true + else if x_comparison < 0 then f l1' l2 + else f l1 l2' in + f l1_sorted l2_sorted + +exception Fail + +(** Apply [f] to pairs of elements; raise [Fail] if the two lists have different lenghts. *) +let map2 f l1 l2 = + let rec go l1 l2 acc = + match l1, l2 with + | [],[] -> rev acc + | x1 :: l1', x2 :: l2' -> + let x' = f x1 x2 in + go l1' l2' (x':: acc) + | _ -> raise Fail in + go l1 l2 [] + +let to_string f l = + let rec aux l = + match l with + | [] -> "" + | s:: [] -> (f s) + | s:: rest -> (f s)^", "^(aux rest) in + "["^(aux l)^"]" + +(** Like List.mem_assoc but without builtin equality *) +let mem_assoc equal a l = + exists (fun x -> equal a (fst x)) l + +(** Like List.assoc but without builtin equality *) +let assoc equal a l = + snd (find (fun x -> equal a (fst x)) l) diff --git a/infer/src/backend/iList.mli b/infer/src/backend/iList.mli new file mode 100644 index 000000000..ad8e8cc0a --- /dev/null +++ b/infer/src/backend/iList.mli @@ -0,0 +1,96 @@ +(* + * Copyright (c) 2015 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +(** Generic comparison of lists given a compare function for the elements of the list *) +val compare : ('a -> 'b -> int) -> 'a list -> 'b list -> int + +(** Generic equality of lists given a compare function for the elements of the list *) +val equal : ('a -> 'b -> int) -> 'a list -> 'b list -> bool + +(** tail-recursive variant of List.append *) +val append : 'a list -> 'a list -> 'a list + +(** tail-recursive variant of List.combine *) +val combine : 'a list -> 'b list -> ('a * 'b) list + +val exists : ('a -> bool) -> 'a list -> bool +val filter : ('a -> bool) -> 'a list -> 'a list + +(** tail-recursive variant of List.flatten *) +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 length : 'a list -> int + +(** tail-recursive variant of List.fold_right *) +val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b + +(** tail-recursive variant of List.map *) +val map : ('a -> 'b) -> 'a list -> 'b list + +(** Like List.mem but without builtin equality *) +val mem : ('a -> 'b -> bool) -> 'a -> 'b list -> bool + +val nth : 'a list -> int -> 'a +val partition : ('a -> bool) -> 'a list -> 'a list * 'a list +val rev : 'a list -> 'a list +val rev_append : 'a list -> 'a list -> 'a list +val rev_map : ('a -> 'b) -> 'a list -> 'b list +val sort : ('a -> 'a -> int) -> 'a list -> 'a list + +(** tail-recursive variant of List.split *) +val split : ('a * 'b) list -> 'a list * 'b list + +val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list +val tl : 'a list -> 'a list + +(* Drops the first n elements from a list. *) +val drop_first : int -> 'a list -> 'a list + +(* Drops the last n elements from a list. *) +val drop_last : int -> 'a list -> 'a list + +(** Returns (reverse input_list)[@]acc *) +val rev_with_acc : 'a list -> 'a list -> 'a list + +(** Remove consecutive equal elements from a list (according to the given comparison functions) *) +val remove_duplicates : ('a -> 'a -> int) -> 'a list -> 'a list + +(** Remove consecutive equal irrelevant elements from a list (according to the given comparison and relevance functions) *) +val remove_irrelevant_duplicates : ('a -> 'a -> int) -> ('a -> bool) -> 'a list -> 'a list + +(** The function works on sorted lists without duplicates *) +val merge_sorted_nodup : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list -> 'a list + +(** Returns whether there is an intersection in the elements of the two lists. + The compare function is required to sort the lists. *) +val intersect : ('a -> 'a -> int) -> 'a list -> 'a list -> bool + +(** Like List.mem_assoc but without builtin equality *) +val mem_assoc : ('a -> 'a -> bool) -> 'a -> ('a * 'b) list -> bool + +(** Like List.assoc but without builtin equality *) +val assoc : ('a -> 'a -> bool) -> 'a -> ('a * 'b) list -> 'b + +exception Fail + +(** Apply [f] to pairs of elements; raise [Fail] if the two lists have different lenghts. *) +val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + +val to_string : ('a -> string) -> 'a list -> string diff --git a/infer/src/backend/ident.ml b/infer/src/backend/ident.ml index c69eb7ab2..8c7a2bfba 100644 --- a/infer/src/backend/ident.ml +++ b/infer/src/backend/ident.ml @@ -96,7 +96,7 @@ module FieldMap = Map.Make(struct end) let idlist_to_idset ids = - list_fold_left (fun set id -> IdentSet.add id set) IdentSet.empty ids + IList.fold_left (fun set id -> IdentSet.add id set) IdentSet.empty ids (** {2 Conversion between Names and Strings} *) @@ -280,7 +280,7 @@ let reset_name_generator () = (** Update the name generator so that the given id's are not generated again *) let update_name_generator ids = let upd id = ignore (create_with_stamp id.kind id.name id.stamp) in - list_iter upd ids + IList.iter upd ids (** Create a fresh identifier with the given kind and name. *) let create_fresh_ident kind name = diff --git a/infer/src/backend/inferanalyze.ml b/infer/src/backend/inferanalyze.ml index b4070eb69..b3fbe1a2e 100644 --- a/infer/src/backend/inferanalyze.ml +++ b/infer/src/backend/inferanalyze.ml @@ -98,9 +98,9 @@ let compute_exclude_fun () : DB.source_file -> bool = let prepend_source_path s = if Filename.is_relative s then Filename.concat !source_path s else s in - let excluded_list = list_map (fun file_path -> prepend_source_path file_path) !excluded_files in + let excluded_list = IList.map (fun file_path -> prepend_source_path file_path) !excluded_files in let exclude_fun (source_file : DB.source_file) = - list_exists (fun excluded_path -> string_is_prefix excluded_path (DB.source_file_to_string source_file)) excluded_list in + IList.exists (fun excluded_path -> string_is_prefix excluded_path (DB.source_file_to_string source_file)) excluded_list in exclude_fun let version_string () = @@ -203,7 +203,7 @@ let () = (* parse command-line arguments *) module Simulator = struct (** Simulate the analysis only *) let reset_summaries cg = - list_iter + IList.iter (fun (pname, in_out_calls) -> Specs.reset_summary cg pname None) (Cg.get_nodes_and_calls cg) @@ -214,7 +214,7 @@ module Simulator = struct (** Simulate the analysis only *) let f proc_name = let joined_pres = [] in Fork.transition_footprint_re_exe proc_name joined_pres in - list_iter f proc_names + IList.iter f proc_names let process_result (exe_env: Exe_env.t) ((proc_name: Procname.t), (calls: Cg.in_out_calls)) (_summ: Specs.summary) : unit = L.err "in process_result %a@." Procname.pp proc_name; @@ -267,7 +267,7 @@ let analyze exe_env = (** add [x] to list [l] at position [nth] *) let list_add_nth x l nth = let rec add acc todo nth = - if nth = 0 then list_rev_append acc (x:: todo) + if nth = 0 then IList.rev_append acc (x:: todo) else match todo with | [] -> raise Not_found | y:: todo' -> add (y:: acc) todo' (nth - 1) in @@ -277,13 +277,13 @@ let list_add_nth x l nth = the number returned by [compare x y] indicates 'how strongly' x should come before y *) let weak_sort compare list = let weak_add l x = - let length = list_length l in + let length = IList.length l in let fitness = Array.make (length + 1) 0 in - list_iter (fun y -> fitness.(0) <- fitness.(0) + compare x y) l; + IList.iter (fun y -> fitness.(0) <- fitness.(0) + compare x y) l; let best_position = ref 0 in let best_value = ref (fitness.(0)) in let i = ref 0 in - list_iter (fun y -> + IList.iter (fun y -> incr i; let new_value = fitness.(!i - 1) - (compare x y) + (compare y x) in fitness.(!i) <- new_value; @@ -294,10 +294,10 @@ let weak_sort compare list = end) l; list_add_nth x l !best_position in - list_fold_left weak_add [] list + IList.fold_left weak_add [] list let pp_stringlist fmt slist = - list_iter (fun pname -> F.fprintf fmt "%s " pname) slist + IList.iter (fun pname -> F.fprintf fmt "%s " pname) slist let weak_sort_nodes cg = let nodes = Cg.get_defined_nodes cg in @@ -360,8 +360,8 @@ let create_minimal_clusters file_cg exe_env to_analyze_map : Cluster.t list = let proc_is_active pname = proc_is_selected pname && DB.source_file_equal (Exe_env.get_source exe_env pname) source_file in - let active_procs = list_filter proc_is_active (Procname.Set.elements changed_procs) in - let naprocs = list_length active_procs in + let active_procs = IList.filter proc_is_active (Procname.Set.elements changed_procs) in + let naprocs = IList.length active_procs in total_files := !total_files + 1; total_procs := !total_procs + naprocs; total_LOC := !total_LOC + (Cg.get_nLOC cg); @@ -369,11 +369,11 @@ let create_minimal_clusters file_cg exe_env to_analyze_map : Cluster.t list = let choose_next_file list = (* choose next file from the weakly ordered list *) let file_has_no_unseen_dependents fname = Procname.Set.subset (Cg.get_dependents file_cg fname) !seen in - match list_partition file_has_no_unseen_dependents list with + match IList.partition file_has_no_unseen_dependents list with | (fname :: no_deps), deps -> (* if all the dependents of fname have been seen, bypass the order in the list *) if !Cluster.trace_clusters then L.err " [choose_next_file] %s (NO dependents)@." (Procname.to_string fname); - Some (fname, list_rev_append no_deps deps) + Some (fname, IList.rev_append no_deps deps) | [], _ -> begin match list with @@ -391,10 +391,10 @@ let create_minimal_clusters file_cg exe_env to_analyze_map : Cluster.t list = if Procname.Set.mem fname !seen then build_clusters list' else let cluster_set = Procname.Set.add fname (Cg.get_recursive_dependents file_cg fname) in - let cluster, list'' = list_partition (fun node -> Procname.Set.mem node cluster_set) list in + let cluster, list'' = IList.partition (fun node -> Procname.Set.mem node cluster_set) list in seen := Procname.Set.union !seen cluster_set; let to_analyze = - list_fold_right + IList.fold_right (fun file_pname l -> try (file_pname, Procname.Map.find file_pname to_analyze_map) :: l with Not_found -> l) @@ -402,16 +402,16 @@ let create_minimal_clusters file_cg exe_env to_analyze_map : Cluster.t list = [] in if to_analyze <> [] then begin - let cluster = list_map create_cluster_elem to_analyze in + let cluster = IList.map create_cluster_elem to_analyze in clusters := cluster :: !clusters; end; build_clusters list'' in build_clusters sorted_files; output_json_file_stats !total_files !total_procs !total_LOC; - list_rev !clusters + IList.rev !clusters let proc_list_to_set proc_list = - list_fold_left (fun s p -> Procname.Set.add p s) Procname.Set.empty proc_list + IList.fold_left (fun s p -> Procname.Set.add p s) Procname.Set.empty proc_list (** compute the files to analyze map for incremental mode *) let compute_to_analyze_map_incremental files_changed_map global_cg exe_env = @@ -497,20 +497,20 @@ let compute_clusters exe_env files_changed : Cluster.t list = (ClusterMakefile.source_file_to_pname src2) end end in - list_iter do_node nodes; - if not !Config.intraprocedural then list_iter do_edge edges; + IList.iter do_node nodes; + if not !Config.intraprocedural then IList.iter do_edge edges; if !save_file_dependency then Cg.save_call_graph_dotty (Some (DB.filename_from_string "file_dependency.dot")) Specs.get_specs file_cg; let files = Cg.get_defined_nodes file_cg in - let num_files = list_length files in - L.err "@.Found %d defined procedures in %d files.@." (list_length defined_procs) num_files; + let num_files = IList.length files in + L.err "@.Found %d defined procedures in %d files.@." (IList.length defined_procs) num_files; let to_analyze_map = if !incremental_mode = ANALYZE_ALL then (* get all procedures defined in a file *) let get_defined_procs file_pname = match file_pname_to_cg file_pname with | None -> Procname.Set.empty | Some cg -> proc_list_to_set (Cg.get_defined_nodes cg) in - list_fold_left + IList.fold_left (fun m file_pname -> Procname.Map.add file_pname (get_defined_procs file_pname) m) Procname.Map.empty files @@ -553,8 +553,8 @@ let cg_get_changed_procs exe_env source_dir cg = let is_changed pname = not (spec_exists pname) || (cfg_modified_after_specs pname && pdesc_changed pname) in let defined_nodes = Cg.get_defined_nodes cg in - if !Config.incremental_procs then list_filter is_changed defined_nodes - else if list_exists is_changed defined_nodes then defined_nodes + if !Config.incremental_procs then IList.filter is_changed defined_nodes + else if IList.exists is_changed defined_nodes then defined_nodes else [] (** Load a .c or .cpp file into an execution environment *) @@ -567,9 +567,9 @@ let load_cg_file (_exe_env: Exe_env.initial) (source_dir : DB.source_dir) exclud (** Return a map of (changed file procname) -> (procs in that file that have changed) *) let compute_files_changed_map _exe_env (source_dirs : DB.source_dir list) exclude_fun = - let sorted_dirs = list_sort DB.source_dir_compare source_dirs in + let sorted_dirs = IList.sort DB.source_dir_compare source_dirs in let cg_list = - list_fold_left + IList.fold_left (fun cg_list source_dir -> match load_cg_file _exe_env source_dir exclude_fun with | None -> cg_list @@ -585,7 +585,7 @@ let compute_files_changed_map _exe_env (source_dirs : DB.source_dir list) exclud let file_pname = ClusterMakefile.source_file_to_pname (Cg.get_source cg) in Procname.Map.add file_pname (proc_list_to_set changed_procs) files_changed_map else files_changed_map in - list_fold_left cg_get_files_changed files_changed_map cg_list in + IList.fold_left cg_get_files_changed files_changed_map cg_list in let exe_env = Exe_env.freeze _exe_env in let files_changed = if !incremental_mode = ANALYZE_ALL then Procname.Map.empty @@ -606,9 +606,9 @@ let exe_env_from_cluster cluster = | None -> DB.source_dir_from_source_file ce.Cluster.ce_file in source_dir :: source_dirs in - list_fold_left fold_cluster_elem [] cluster in - let sorted_dirs = list_sort DB.source_dir_compare source_dirs in - list_iter (fun src_dir -> ignore (Exe_env.add_cg _exe_env src_dir)) sorted_dirs; + IList.fold_left fold_cluster_elem [] cluster in + let sorted_dirs = IList.sort DB.source_dir_compare source_dirs in + IList.iter (fun src_dir -> ignore (Exe_env.add_cg _exe_env src_dir)) sorted_dirs; let exe_env = Exe_env.freeze _exe_env in exe_env @@ -616,9 +616,9 @@ let exe_env_from_cluster cluster = let analyze_cluster cluster_num tot_clusters (cluster : Cluster.t) = incr cluster_num; let exe_env = exe_env_from_cluster cluster in - let num_files = list_length cluster in + let num_files = IList.length cluster in let defined_procs = Cg.get_defined_nodes (Exe_env.get_cg exe_env) in - let num_procs = list_length defined_procs in + let num_procs = IList.length defined_procs in L.err "@.Processing cluster #%d/%d with %d files and %d procedures@." !cluster_num tot_clusters num_files num_procs; Fork.this_cluster_files := num_files; analyze exe_env; @@ -633,8 +633,8 @@ let process_cluster_cmdline_exit () = L.err "Cannot find cluster file %s@." fname; exit 0 | Some (nr, tot_nr, cluster) -> - Fork.tot_files_done := (nr - 1) * list_length cluster; - Fork.tot_files := tot_nr * list_length cluster; + Fork.tot_files_done := (nr - 1) * IList.length cluster; + Fork.tot_files := tot_nr * IList.length cluster; analyze_cluster (ref (nr -1)) tot_nr cluster; exit 0) @@ -663,9 +663,9 @@ let compute_ondemand_clusters source_dirs = Cluster.create_ondemand source_dir in let clusters = let do_source_dir acc source_dir = mk_cluster source_dir @ acc in - list_fold_left do_source_dir [] source_dirs in + IList.fold_left do_source_dir [] source_dirs in Cluster.print_clusters_stats clusters; - let num_files = list_length clusters in + let num_files = IList.length clusters in let num_procs = 0 (* can't compute it at this stage *) in let num_lines = 0 in output_json_file_stats num_files num_procs num_lines; @@ -710,9 +710,9 @@ let () = else let filter source_dir = let source_dir_base = Filename.basename (DB.source_dir_to_string source_dir) in - list_exists (fun s -> Utils.string_is_prefix s source_dir_base) !only_files_cmdline in - list_filter filter (DB.find_source_dirs ()) in - L.err "Found %d source files in %s@." (list_length source_dirs) !Config.results_dir; + IList.exists (fun s -> Utils.string_is_prefix s source_dir_base) !only_files_cmdline in + IList.filter filter (DB.find_source_dirs ()) in + L.err "Found %d source files in %s@." (IList.length source_dirs) !Config.results_dir; let clusters = if !Config.ondemand_enabled @@ -729,9 +729,9 @@ let () = end in - let tot_clusters = list_length clusters in - Fork.tot_files := list_fold_left (fun n cluster -> n + list_length cluster) 0 clusters; - list_iter (analyze_cluster (ref 0) tot_clusters) clusters; + let tot_clusters = IList.length clusters in + Fork.tot_files := IList.fold_left (fun n cluster -> n + IList.length cluster) 0 clusters; + IList.iter (analyze_cluster (ref 0) tot_clusters) clusters; L.flush_streams (); close_output_file analyzer_out_of; close_output_file analyzer_err_of; diff --git a/infer/src/backend/inferconfig.ml b/infer/src/backend/inferconfig.ml index b579585e8..6700af39f 100644 --- a/infer/src/backend/inferconfig.ml +++ b/infer/src/backend/inferconfig.ml @@ -55,7 +55,7 @@ type filter_config = let is_matching patterns = fun source_file -> let path = DB.source_file_to_rel_path source_file in - Utils.list_exists + IList.exists (fun pattern -> try (Str.search_forward pattern path 0) = 0 @@ -168,8 +168,8 @@ struct let detect_pattern assoc = let language = detect_language assoc in - let is_method_pattern key = list_exists (string_equal key) ["class"; "method"] - and is_source_contains key = list_exists (string_equal key) ["source_contains"] in + let is_method_pattern key = IList.exists (string_equal key) ["class"; "method"] + and is_source_contains key = IList.exists (string_equal key) ["source_contains"] in let rec loop = function | [] -> failwith ("Unknown pattern for " ^ M.json_key ^ " in " ^ inferconfig_file) @@ -185,7 +185,7 @@ struct let collect accu = function | `String s -> s:: accu | _ -> failwith ("Unrecognised parameters in " ^ Yojson.Basic.to_string (`Assoc assoc)) in - list_rev (list_fold_left collect [] l) in + IList.rev (IList.fold_left collect [] l) in let create_method_pattern mp assoc = let loop mp = function | (key, `String s) when key = "class" -> @@ -196,13 +196,13 @@ struct { mp with parameters = Some (collect_params l) } | (key, _) when key = "language" -> mp | _ -> failwith ("Fails to parse " ^ Yojson.Basic.to_string (`Assoc assoc)) in - list_fold_left loop default_method_pattern assoc + IList.fold_left loop default_method_pattern assoc and create_string_contains sc assoc = let loop sc = function | (key, `String pattern) when key = "source_contains" -> pattern | (key, _) when key = "language" -> sc | _ -> failwith ("Fails to parse " ^ Yojson.Basic.to_string (`Assoc assoc)) in - list_fold_left loop default_source_contains assoc in + IList.fold_left loop default_source_contains assoc in match detect_pattern assoc with | Method_pattern (language, mp) -> Method_pattern (language, create_method_pattern mp assoc) @@ -212,7 +212,7 @@ struct let rec translate accu (json : Yojson.Basic.json) : pattern list = match json with | `Assoc l -> (create_pattern l):: accu - | `List l -> list_fold_left translate accu l + | `List l -> IList.fold_left translate accu l | _ -> assert false let create_method_matcher m_patterns = @@ -220,7 +220,7 @@ struct default_matcher else let pattern_map = - list_fold_left + IList.fold_left (fun map pattern -> let previous = try @@ -234,7 +234,7 @@ struct and method_name = Procname.java_get_method proc_name in try let class_patterns = StringMap.find class_name pattern_map in - list_exists + IList.exists (fun p -> match p.method_name with | None -> true @@ -247,7 +247,7 @@ struct let collect (s_patterns, m_patterns) = function | Source_contains (lang, s) -> (s:: s_patterns, m_patterns) | Method_pattern (lang, mp) -> (s_patterns, mp :: m_patterns) in - list_fold_left collect ([], []) patterns in + IList.fold_left collect ([], []) patterns in let s_matcher = let matcher = FileContainsStringMatcher.create_matcher s_patterns in fun source_file proc_name -> matcher source_file @@ -263,7 +263,7 @@ struct Yojson.Basic.Util.filter_member M.json_key [Yojson.Basic.from_file inferconfig] in - list_fold_left translate [] found in + IList.fold_left translate [] found in create_file_matcher patterns with Sys_error _ -> default_matcher @@ -315,9 +315,9 @@ let filters_from_inferconfig inferconfig : filters = let path_filter = let whitelist_filter : path_filter = if inferconfig.whitelist = [] then default_path_filter - else is_matching (list_map Str.regexp inferconfig.whitelist) in + else is_matching (IList.map Str.regexp inferconfig.whitelist) in let blacklist_filter : path_filter = - is_matching (list_map Str.regexp inferconfig.blacklist) in + is_matching (IList.map Str.regexp inferconfig.blacklist) in let blacklist_files_containing_filter : path_filter = FileContainsStringMatcher.create_matcher inferconfig.blacklist_files_containing in function source_file -> @@ -327,7 +327,7 @@ let filters_from_inferconfig inferconfig : filters = let error_filter = function error_name -> let error_str = Localise.to_string error_name in - not (list_exists (string_equal error_str) inferconfig.suppress_errors) in + not (IList.exists (string_equal error_str) inferconfig.suppress_errors) in { path_filter = path_filter; error_filter = error_filter; @@ -352,9 +352,9 @@ let create_filters analyzer = let test () = Config.project_root := Some (Sys.getcwd ()); let filters = - Utils.list_map (fun analyzer -> (analyzer, create_filters analyzer)) Utils.analyzers in + IList.map (fun analyzer -> (analyzer, create_filters analyzer)) Utils.analyzers in let matching_analyzers path = - Utils.list_fold_left + IList.fold_left (fun l (a, f) -> if f.path_filter path then a:: l else l) [] filters in Utils.directory_iter @@ -365,7 +365,7 @@ let test () = if matching <> [] then let matching_s = Utils.join_strings ", " - (Utils.list_map Utils.string_of_analyzer matching) in + (IList.map Utils.string_of_analyzer matching) in Logging.stderr "%s -> {%s}@." (DB.source_file_to_rel_path source_file) matching_s) diff --git a/infer/src/backend/inferprint.ml b/infer/src/backend/inferprint.ml index 8b1ba5066..c2230b84f 100644 --- a/infer/src/backend/inferprint.ml +++ b/infer/src/backend/inferprint.ml @@ -147,15 +147,15 @@ let load_specfiles () = let specs_files_in_dir dir = let is_specs_file fname = not (Sys.is_directory fname) && Filename.check_suffix fname ".specs" in let all_filenames = Array.to_list (Sys.readdir dir) in - let all_filepaths = list_map (fun fname -> Filename.concat dir fname) all_filenames in - list_filter is_specs_file all_filepaths in + let all_filepaths = IList.map (fun fname -> Filename.concat dir fname) all_filenames in + IList.filter is_specs_file all_filepaths in let specs_dirs = if !results_dir_cmdline then let result_specs_dir = DB.filename_to_string (DB.Results_dir.specs_dir ()) in result_specs_dir :: !Config.specs_library else !Config.specs_library in - list_flatten (list_map specs_files_in_dir specs_dirs) + IList.flatten (IList.map specs_files_in_dir specs_dirs) (** Create and initialize latex file *) let begin_latex_file fmt = @@ -190,7 +190,7 @@ let error_desc_to_xml_tags error_desc = let tags = Localise.error_desc_get_tags error_desc in let subtree label contents = Io_infer.Xml.create_tree label [] [(Io_infer.Xml.String contents)] in - list_map (fun (tag, value) -> subtree tag (Escape.escape_xml value)) tags + IList.map (fun (tag, value) -> subtree tag (Escape.escape_xml value)) tags let get_bug_hash (kind: string) (type_str: string) (procedure_id: string) (filename: string) (node_key: int) (error_desc: Localise.error_desc) = let qualifier_tag_call_procedure = Localise.error_desc_get_tag_call_procedure error_desc in @@ -203,7 +203,7 @@ let loc_trace_to_jsonbug_record trace_list ekind = | _ -> (* writes a trace as a record for atdgen conversion *) let node_tags_to_records tags_list = - list_map (fun tag -> { tag = fst tag; value = snd tag }) tags_list in + IList.map (fun tag -> { tag = fst tag; value = snd tag }) tags_list in let trace_item_to_record trace_item = { level = trace_item.Errlog.lt_level; filename = DB.source_file_to_string trace_item.Errlog.lt_loc.Location.file; @@ -211,14 +211,14 @@ let loc_trace_to_jsonbug_record trace_list ekind = description = trace_item.Errlog.lt_description; node_tags = node_tags_to_records trace_item.Errlog.lt_node_tags; } in - let record_list = list_rev (list_rev_map trace_item_to_record trace_list) in + let record_list = IList.rev (IList.rev_map trace_item_to_record trace_list) in record_list let error_desc_to_qualifier_tags_records error_desc = let tag_value_pairs = Localise.error_desc_to_tag_value_pairs error_desc in let tag_value_to_record (tag, value) = { tag = tag; value = value } in - list_map (fun tag_value -> tag_value_to_record tag_value) tag_value_pairs + IList.map (fun tag_value -> tag_value_to_record tag_value) tag_value_pairs type summary_val = { vname : string; @@ -250,15 +250,15 @@ let summary_values top_proc_set summary = let proc_name = Specs.get_proc_name summary in let is_top = Procname.Set.mem proc_name top_proc_set in let signature = Specs.get_signature summary in - let nodes_nr = list_length summary.Specs.nodes in + let nodes_nr = IList.length summary.Specs.nodes in let specs = Specs.get_specs_from_payload summary in let nr_nodes_visited, lines_visited = let visited = ref Specs.Visitedset.empty in let do_spec spec = visited := Specs.Visitedset.union spec.Specs.visited !visited in - list_iter do_spec specs; + IList.iter do_spec specs; let visited_lines = ref IntSet.empty in Specs.Visitedset.iter (fun (n, ls) -> - list_iter (fun l -> visited_lines := IntSet.add l !visited_lines) ls) + IList.iter (fun l -> visited_lines := IntSet.add l !visited_lines) ls) !visited; Specs.Visitedset.cardinal !visited, IntSet.elements !visited_lines in let proof_trace = @@ -279,7 +279,7 @@ let summary_values top_proc_set summary = let cyclomatic = stats.Specs.cyclomatic in { vname = Procname.to_string proc_name; vname_id = Procname.to_filename proc_name; - vspecs = list_length specs; + vspecs = IList.length specs; vtime = Printf.sprintf "%.0f" stats.Specs.stats_time; vto = if stats.Specs.stats_timeout then "TO" else " "; vsymop = stats.Specs.symops; @@ -504,7 +504,7 @@ module BugsXml = struct let code_to_xml code = subtree Io_infer.Xml.tag_code code in let description_to_xml descr = subtree Io_infer.Xml.tag_description (Escape.escape_xml descr) in let node_tags_to_xml node_tags = - let escaped_tags = list_map (fun (tag, value) -> (tag, Escape.escape_xml value)) node_tags in + let escaped_tags = IList.map (fun (tag, value) -> (tag, Escape.escape_xml value)) node_tags in Io_infer.Xml.create_tree Io_infer.Xml.tag_node escaped_tags [] in let num = ref 0 in let loc_to_xml lt = @@ -520,7 +520,7 @@ module BugsXml = struct (code_to_xml code); (description_to_xml lt.Errlog.lt_description); (node_tags_to_xml lt.Errlog.lt_node_tags)] in - list_rev (list_rev_map loc_to_xml ltr) + IList.rev (IList.rev_map loc_to_xml ltr) (** print bugs from summary in xml *) let pp_bugs error_filter linereader fmt summary = @@ -616,8 +616,8 @@ module UnitTest = struct Autounit.genunit c_file proc_name !cnt (Specs.get_formals summary) spec in F.fprintf fmt "%a@." Autounit.pp_code code in let specs = Specs.get_specs_from_payload summary in - list_iter do_spec specs; - procs_done := (proc_name, list_length specs) :: !procs_done + IList.iter do_spec specs; + procs_done := (proc_name, IList.length specs) :: !procs_done (** Print main function which calls all the unit test functions generated *) let print_unit_test_main () = @@ -648,7 +648,7 @@ end = struct Procname.Set.diff x.possible x.impossible let process_summary x (_, summary) = let proc_name = Specs.get_proc_name summary in - let nspecs = list_length (Specs.get_specs_from_payload summary) in + let nspecs = IList.length (Specs.get_specs_from_payload summary) in if nspecs > 0 then begin mark_possible x proc_name; @@ -712,8 +712,8 @@ module Stats = struct F.fprintf fmt "%s%04d: %s" (indent_string (level + indent_num)) loc.Location.line code in pp_to_string pp () in res := line :: "" :: !res in - list_iter loc_to_string ltr; - list_rev !res + IList.iter loc_to_string ltr; + IList.rev !res let process_err_log error_filter linereader err_log stats = let found_errors = ref false in @@ -731,7 +731,7 @@ module Stats = struct let pp3 fmt () = F.fprintf fmt " (%a)" Localise.pp_error_desc error_desc in [pp_to_string pp1 (); pp_to_string pp2 (); pp_to_string pp3 ()] in let trace = loc_trace_to_string_list linereader 1 ltr in - stats.saved_errors <- list_rev_append (error_strs @ trace @ [""]) stats.saved_errors + stats.saved_errors <- IList.rev_append (error_strs @ trace @ [""]) stats.saved_errors | Exceptions.Kwarning -> stats.nwarnings <- stats.nwarnings + 1 | Exceptions.Kinfo -> stats.ninfos <- stats.ninfos + 1 in Errlog.iter process_row err_log; @@ -745,7 +745,7 @@ module Stats = struct let is_verified = specs <> [] && not is_defective in let is_checked = not (is_defective || is_verified) in stats.nprocs <- stats.nprocs + 1; - stats.nspecs <- stats.nspecs + (list_length specs); + stats.nspecs <- stats.nspecs + (IList.length specs); if is_verified then stats.nverified <- stats.nverified + 1; if is_checked then stats.nchecked <- stats.nchecked + 1; if is_defective then stats.ndefective <- stats.ndefective + 1; @@ -767,7 +767,7 @@ module Stats = struct F.fprintf fmt "Infos: %d@\n" stats.ninfos; F.fprintf fmt "@\n -------------------@\n"; F.fprintf fmt "@\nDetailed Errors@\n@\n"; - list_iter (fun s -> F.fprintf fmt "%s@\n" s) (list_rev stats.saved_errors); + IList.iter (fun s -> F.fprintf fmt "%s@\n" s) (IList.rev stats.saved_errors); end module Report = struct @@ -788,7 +788,7 @@ module PreconditionStats = struct let do_summary proc_name summary = let specs = Specs.get_specs_from_payload summary in - let preconditions = list_map (fun spec -> Specs.Jprop.to_prop spec.Specs.pre) specs in + let preconditions = IList.map (fun spec -> Specs.Jprop.to_prop spec.Specs.pre) specs in match Prop.CategorizePreconditions.categorize preconditions with | Prop.CategorizePreconditions.Empty -> incr nr_empty; @@ -882,10 +882,10 @@ module AnalysisResults = struct Inferconfig.test (); exit(0) end; - list_append (if !args = ["."] then begin + IList.append (if !args = ["."] then begin let arr = Sys.readdir "." in let all_files = Array.to_list arr in - list_filter (fun fname -> (Filename.check_suffix fname ".specs")) all_files + IList.filter (fun fname -> (Filename.check_suffix fname ".specs")) all_files end else !args) (load_specfiles ()) @@ -908,7 +908,7 @@ module AnalysisResults = struct exit 0 | Some summary -> summaries := (fname, summary) :: !summaries in - apply_without_gc (list_iter load_file) spec_files_from_cmdline; + apply_without_gc (IList.iter load_file) spec_files_from_cmdline; let summ_cmp (fname1, summ1) (fname2, summ2) = let n = DB.source_file_compare @@ -918,11 +918,11 @@ module AnalysisResults = struct else int_compare summ1.Specs.attributes.ProcAttributes.loc.Location.line summ2.Specs.attributes.ProcAttributes.loc.Location.line in - list_sort summ_cmp !summaries + IList.sort summ_cmp !summaries (** Create an iterator which loads spec files one at a time *) let iterator_of_spec_files () = - let sorted_spec_files = list_sort string_compare spec_files_from_cmdline in + let sorted_spec_files = IList.sort string_compare spec_files_from_cmdline in let do_spec f fname = match Specs.load_summary (DB.filename_from_string fname) with | None -> @@ -931,7 +931,7 @@ module AnalysisResults = struct | Some summary -> f (fname, summary) in let iterate f = - list_iter (do_spec f) sorted_spec_files in + IList.iter (do_spec f) sorted_spec_files in iterate (** Serializer for analysis results *) @@ -949,7 +949,7 @@ module AnalysisResults = struct If options - load_results or - save_results are used, all the summaries are loaded in memory *) let get_summary_iterator () = let iterator_of_summary_list r = - fun f -> list_iter f r in + fun f -> IList.iter f r in match !load_analysis_results with | None -> begin diff --git a/infer/src/backend/interproc.ml b/infer/src/backend/interproc.ml index a1ea724ff..f5b2bc598 100644 --- a/infer/src/backend/interproc.ml +++ b/infer/src/backend/interproc.ml @@ -219,7 +219,7 @@ let collect_preconditions pname tenv proc_name : Prop.normal Specs.Jprop.t list Config.footprint := true; prop' end else Abs.abstract_no_symop tenv prop in - let pres = list_map (fun spec -> Specs.Jprop.to_prop spec.Specs.pre) (Specs.get_specs proc_name) in + let pres = IList.map (fun spec -> Specs.Jprop.to_prop spec.Specs.pre) (Specs.get_specs proc_name) in let pset = Propset.from_proplist pres in let pset' = let f p = Prop.prop_normal_vars_to_primed_vars p in @@ -238,12 +238,12 @@ let collect_preconditions pname tenv proc_name : Prop.normal Specs.Jprop.t list L.d_decrease_indent 2; L.d_ln (); L.d_strln ("#### Footprint of " ^ Procname.to_string proc_name ^ " after Join ####"); L.d_increase_indent 1; Specs.Jprop.d_list false jplist; L.d_decrease_indent 1; L.d_ln (); - let jplist' = list_map (Specs.Jprop.map Prop.prop_rename_primed_footprint_vars) jplist in + let jplist' = IList.map (Specs.Jprop.map Prop.prop_rename_primed_footprint_vars) jplist in L.d_strln ("#### Renamed footprint of " ^ Procname.to_string proc_name ^ ": ####"); L.d_increase_indent 1; Specs.Jprop.d_list false jplist'; L.d_decrease_indent 1; L.d_ln (); let jplist'' = let f p = Prop.prop_primed_vars_to_normal_vars (collect_do_abstract_one pname tenv p) in - list_map (Specs.Jprop.map f) jplist' in + IList.map (Specs.Jprop.map f) jplist' in L.d_strln ("#### Abstracted footprint of " ^ Procname.to_string proc_name ^ ": ####"); L.d_increase_indent 1; Specs.Jprop.d_list false jplist''; L.d_decrease_indent 1; L.d_ln(); jplist'' @@ -271,7 +271,7 @@ let propagate_nodes_divergence let pset_exn, pset_ok = Paths.PathSet.partition (Tabulation.prop_is_exn pname) pset in let succ_nodes = match State.get_goto_node () with (* handle Sil.Goto_node target, if any *) | Some node_id -> - list_filter (fun n -> Cfg.Node.get_id n = node_id) _succ_nodes + IList.filter (fun n -> Cfg.Node.get_id n = node_id) _succ_nodes | None -> _succ_nodes in if !Config.footprint && not (Paths.PathSet.is_empty (State.get_diverging_states_node ())) then begin @@ -288,8 +288,8 @@ let propagate_nodes_divergence Propgraph.d_proplist Prop.prop_emp (Paths.PathSet.to_proplist prop_incons); L.d_ln (); propagate pname false prop_incons exit_node end; - list_iter (propagate pname false pset_ok) succ_nodes; - list_iter (propagate pname true pset_exn) exn_nodes + IList.iter (propagate pname false pset_ok) succ_nodes; + IList.iter (propagate pname true pset_exn) exn_nodes (* ===================== END of symbolic execution ===================== *) @@ -305,7 +305,7 @@ let do_symexec_join pname tenv curr_node (edgeset_todo : Paths.PathSet.t) = let old_dset = Join_table.find curr_id in let old_dset', new_dset' = Dom.pathset_join curr_pname tenv old_dset new_dset in Join_table.put curr_id (Paths.PathSet.union old_dset' new_dset'); - list_iter (fun node -> + IList.iter (fun node -> Paths.PathSet.iter (fun prop path -> State.set_path path None; propagate pname false (Paths.PathSet.from_renamed_list [(prop, path)]) node) @@ -350,7 +350,7 @@ let d_path (path, pos_opt) = L.d_str "Path: "; Paths.Path.d_stats path; L.d_ln (); Paths.Path.d path; L.d_ln (); (* pp_complete_path_dotty_file path; *) - (* if !Config.write_dotty then Dotty.print_icfg_dotty (list_rev (get_edges path)) *) + (* if !Config.write_dotty then Dotty.print_icfg_dotty (IList.rev (get_edges path)) *) Paths.Path.iter_longest_sequence f pos_opt path exception RE_EXE_ERROR @@ -372,8 +372,8 @@ let instrs_get_normal_vars instrs = let do_instr instr = let do_e e = Sil.exp_fav_add fav e in let exps = Sil.instr_get_exps instr in - list_iter do_e exps in - list_iter do_instr instrs; + IList.iter do_e exps in + IList.iter do_instr instrs; Sil.fav_filter_ident fav Ident.is_normal; Sil.fav_to_list fav @@ -392,7 +392,7 @@ let check_assignement_guard node = let is_call = function | Sil.Call _ -> true | _ -> false in - list_exists is_call instrs in + IList.exists is_call instrs in let is_set_instr i = match i with | Sil.Set _ -> true @@ -422,19 +422,19 @@ let check_assignement_guard node = let is_prune_exp e = let prune_var n = let ins = Cfg.Node.get_instrs n in - let pi = list_filter is_prune_instr ins in - let leti = list_filter is_letderef_instr ins in + let pi = IList.filter is_prune_instr ins in + let leti = IList.filter is_letderef_instr ins in match pi, leti with | [Sil.Prune (Sil.Var(e1), _, _, _)], [Sil.Letderef(e2, e', _, _)] | [Sil.Prune (Sil.UnOp(Sil.LNot, Sil.Var(e1), _), _, _, _)], [Sil.Letderef(e2, e', _, _)] when (Ident.equal e1 e2) -> if verbose then L.d_strln ("Found "^(Sil.exp_to_string e')^" as prune var"); [e'] | _ -> [] in - let prune_vars = list_flatten(list_map (fun n -> prune_var n) succs) in - list_for_all (fun e' -> Sil.exp_equal e' e) prune_vars in - let succs_loc = list_map (fun n -> Cfg.Node.get_loc n) succs in + let prune_vars = IList.flatten(IList.map (fun n -> prune_var n) succs) in + IList.for_all (fun e' -> Sil.exp_equal e' e) prune_vars in + let succs_loc = IList.map (fun n -> Cfg.Node.get_loc n) succs in let succs_are_all_prune_nodes () = - list_for_all (fun n -> match Cfg.Node.get_kind n with + IList.for_all (fun n -> match Cfg.Node.get_kind n with | Cfg.Node.Prune_node(_) -> true | _ -> false) succs in let succs_same_loc_as_node () = @@ -442,7 +442,7 @@ let check_assignement_guard node = (L.d_str ("LOCATION NODE: line: " ^ (string_of_int l_node.Location.line) ^ " nLOC: " ^ (string_of_int l_node.Location.nLOC)); L.d_strln " "); - list_for_all (fun l -> + IList.for_all (fun l -> if verbose then (L.d_str ("LOCATION l: line: " ^ (string_of_int l.Location.line) ^ " nLOC: " ^ (string_of_int l.Location.nLOC)); @@ -455,8 +455,8 @@ let check_assignement_guard node = | Sil.Prune _ -> false | _ -> true in let check_guard n = - list_for_all check_instr (Cfg.Node.get_instrs n) in - list_for_all check_guard succs in + IList.for_all check_instr (Cfg.Node.get_instrs n) in + IList.for_all check_guard succs in if !Config.curr_language = Config.C_CPP && succs_are_all_prune_nodes () && succs_same_loc_as_node () && @@ -465,7 +465,7 @@ let check_assignement_guard node = match succs_loc with | loc_succ:: _ -> (* at this point all successors are at the same location, so we can take the first*) let set_instr_at_succs_loc = - list_filter + IList.filter (fun i -> (Location.equal (Sil.instr_get_loc i) loc_succ) && is_set_instr i) instr in (match set_instr_at_succs_loc with @@ -610,7 +610,7 @@ let report_activity_leaks pname sigma tenv = let fld_exps = Prop.strexp_get_exps fld_strexp in Prop.compute_reachable_hpreds sigma fld_exps in (* raise an error if any Activity expression is in [reachable_exps] *) - list_iter + IList.iter (fun (activity_exp, typ) -> if Sil.ExpSet.mem activity_exp reachable_exps then let err_desc = Errdesc.explain_activity_leak pname typ fld_name in @@ -620,7 +620,7 @@ let report_activity_leaks pname sigma tenv = activity_exps in (* get the set of pointed-to expressions of type T <: Activity *) let activity_exps = - list_fold_left + IList.fold_left (fun exps hpred -> match hpred with | Sil.Hpointsto (_, Sil.Eexp (exp, _), Sil.Sizeof (Sil.Tptr (typ, _), _)) when AndroidFramework.is_activity typ tenv -> @@ -628,10 +628,10 @@ let report_activity_leaks pname sigma tenv = | _ -> exps) [] sigma in - list_iter + IList.iter (function | Sil.Hpointsto (Sil.Lvar pv, Sil.Estruct (static_flds, _), _) when Sil.pvar_is_global pv -> - list_iter + IList.iter (fun (f_name, f_strexp) -> if not (Harness.is_generated_field f_name) then check_reachable_activity_from_fld (f_name, f_strexp) activity_exps) static_flds @@ -648,7 +648,7 @@ let remove_locals_formals_and_check pdesc p = let desc = Errdesc.explain_stack_variable_address_escape loc pvar dexp_opt in let exn = Exceptions.Stack_variable_address_escape (desc, try assert false with Assert_failure x -> x) in Reporting.log_warning pname exn in - list_iter check_pvar pvars; + IList.iter check_pvar pvars; p' (* Collect the analysis results for the exit node *) @@ -670,9 +670,9 @@ let compute_visited vset = let res = ref Specs.Visitedset.empty in let node_get_all_lines n = let node_loc = Cfg.Node.get_loc n in - let instrs_loc = list_map Sil.instr_get_loc (Cfg.Node.get_instrs n) in - let lines = list_map (fun loc -> loc.Location.line) (node_loc :: instrs_loc) in - list_remove_duplicates int_compare (list_sort int_compare lines) in + let instrs_loc = IList.map Sil.instr_get_loc (Cfg.Node.get_instrs n) in + let lines = IList.map (fun loc -> loc.Location.line) (node_loc :: instrs_loc) in + IList.remove_duplicates int_compare (IList.sort int_compare lines) in let do_node n = res := Specs.Visitedset.add (Cfg.Node.get_id n, node_get_all_lines n) !res in Cfg.NodeSet.iter do_node vset; !res @@ -683,7 +683,7 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list = let sub = let fav = Sil.fav_new () in Paths.PathSet.iter (fun prop path -> Prop.prop_fav_add fav prop) pathset; - let sub_list = list_map (fun id -> (id, Sil.Var (Ident.create_fresh (Ident.knormal)))) (Sil.fav_to_list fav) in + let sub_list = IList.map (fun id -> (id, Sil.Var (Ident.create_fresh (Ident.knormal)))) (Sil.fav_to_list fav) in Sil.sub_of_list sub_list in let pre_post_visited_list = let pplist = Paths.PathSet.elements pathset in @@ -704,7 +704,7 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list = vset_ref_add_path vset_ref path; compute_visited !vset_ref in (pre', post', visited) in - list_map f pplist in + IList.map f pplist in let pre_post_map = let add map (pre, post, visited) = let current_posts, current_visited = try Pmap.find pre map with Not_found -> (Paths.PathSet.empty, Specs.Visitedset.empty) in @@ -713,11 +713,11 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list = | Some (post, path) -> Paths.PathSet.add_renamed_prop post path current_posts in let new_visited = Specs.Visitedset.union visited current_visited in Pmap.add pre (new_posts, new_visited) map in - list_fold_left add Pmap.empty pre_post_visited_list in + IList.fold_left add Pmap.empty pre_post_visited_list in let specs = ref [] in let add_spec pre ((posts : Paths.PathSet.t), visited) = let posts' = - list_map + IList.map (fun (p, path) -> (Cfg.remove_seed_vars p, path)) (Paths.PathSet.elements (do_join_post pname tenv posts)) in let spec = @@ -756,7 +756,7 @@ let create_seed_vars sigma = | Sil.Hpointsto (Sil.Lvar pv, se, typ) when not (Sil.pvar_is_abducted pv) -> Sil.Hpointsto(Sil.Lvar (Sil.pvar_to_seed pv), se, typ) :: sigma | _ -> sigma in - list_fold_left hpred_add_seed [] sigma + IList.fold_left hpred_add_seed [] sigma (** Initialize proposition for execution given formal and global parameters. The footprint is initialized according to the @@ -769,7 +769,7 @@ let prop_init_formals_seed tenv new_formals (prop : 'a Prop.t) : Prop.exposed Pr | Config.C_CPP -> Sil.Sizeof (typ, Sil.Subtype.exact) | Config.Java -> Sil.Sizeof (typ, Sil.Subtype.subtypes) in Prop.mk_ptsto_lvar (Some tenv) Prop.Fld_init Sil.inst_formal (pv, texp, None) in - list_map do_formal new_formals in + IList.map do_formal new_formals in let sigma_seed = create_seed_vars (Prop.get_sigma prop @ sigma_new_formals) (* formals already there plus new ones *) in let sigma = sigma_seed @ sigma_new_formals in @@ -779,7 +779,7 @@ let prop_init_formals_seed tenv new_formals (prop : 'a Prop.t) : Prop.exposed Pr (* inactive until it becomes necessary, as it pollutes props let fav_ids = Sil.fav_to_list (Prop.sigma_fav sigma_locals) in let mk_undef_atom id = Prop.mk_neq (Sil.Var id) (Sil.Const (Sil.Cattribute (Sil.Aundef "UNINITIALIZED"))) in - let pi_undef = list_map mk_undef_atom fav_ids in + let pi_undef = IList.map mk_undef_atom fav_ids in pi_undef @ pi *) in let prop' = Prop.replace_pi new_pi (Prop.prop_sigma_star prop sigma) in @@ -792,7 +792,7 @@ let initial_prop tenv (curr_f: Cfg.Procdesc.t) (prop : 'a Prop.t) add_formals : (Sil.mk_pvar (Mangled.from_string x) (Cfg.Procdesc.get_proc_name curr_f), typ) in let new_formals = if add_formals - then list_map construct_decl (Cfg.Procdesc.get_formals curr_f) + then IList.map construct_decl (Cfg.Procdesc.get_formals curr_f) else [] in (** no new formals added *) let prop1 = Prop.prop_reset_inst (fun inst_old -> Sil.update_inst inst_old Sil.inst_formal) prop in let prop2 = prop_init_formals_seed tenv new_formals prop1 in @@ -806,7 +806,7 @@ let initial_prop_from_emp tenv curr_f = let initial_prop_from_pre tenv curr_f pre = if !Config.footprint then let vars = Sil.fav_to_list (Prop.prop_fav pre) in - let sub_list = list_map (fun id -> (id, Sil.Var (Ident.create_fresh (Ident.kfootprint)))) vars in + let sub_list = IList.map (fun id -> (id, Sil.Var (Ident.create_fresh (Ident.kfootprint)))) vars in let sub = Sil.sub_of_list sub_list in let pre2 = Prop.prop_sub sub pre in let pre3 = Prop.replace_sigma_footprint (Prop.get_sigma pre2) (Prop.replace_pi_footprint (Prop.get_pure pre2) pre2) in @@ -838,7 +838,7 @@ let execute_filter_prop cfg tenv pdesc init_node (precondition : Prop.normal Spe L.d_ln (); let posts, visited = let pset, visited = collect_postconditions tenv pdesc in - let plist = list_map (fun (p, path) -> (Cfg.remove_seed_vars p, path)) (Paths.PathSet.elements pset) in + let plist = IList.map (fun (p, path) -> (Cfg.remove_seed_vars p, path)) (Paths.PathSet.elements pset) in plist, visited in let pre = let p = Cfg.remove_locals_ret pdesc (Specs.Jprop.to_prop precondition) in @@ -863,13 +863,13 @@ let execute_filter_prop cfg tenv pdesc init_node (precondition : Prop.normal Spe (** get all the nodes in the current call graph with their defined children *) let get_procs_and_defined_children call_graph = - list_map (fun (n, ns) -> (n, Procname.Set.elements ns)) (Cg.get_nodes_and_defined_children call_graph) + IList.map (fun (n, ns) -> (n, Procname.Set.elements ns)) (Cg.get_nodes_and_defined_children call_graph) let pp_intra_stats cfg proc_desc fmt proc_name = let nstates = ref 0 in let nodes = Cfg.Procdesc.get_nodes proc_desc in - list_iter (fun node -> nstates := !nstates + Paths.PathSet.size (path_set_get_visited (Cfg.Node.get_id node))) nodes; - F.fprintf fmt "(%d nodes containing %d states)" (list_length nodes) !nstates + IList.iter (fun node -> nstates := !nstates + Paths.PathSet.size (path_set_get_visited (Cfg.Node.get_id node))) nodes; + F.fprintf fmt "(%d nodes containing %d states)" (IList.length nodes) !nstates (** Return functions to perform one phase of the analysis for a procedure. Given [proc_name], return [do, get_results] where [go ()] performs the analysis phase @@ -896,7 +896,7 @@ let perform_analysis_phase cfg tenv (pname : Procname.t) (pdesc : Cfg.Procdesc.t let specs = Specs.get_specs pname in let mk_init precondition = (* rename spec vars to footrpint vars, and copy current to footprint *) initial_prop_from_pre tenv pdesc (Specs.Jprop.to_prop precondition) in - list_map (fun spec -> mk_init spec.Specs.pre) specs in + IList.map (fun spec -> mk_init spec.Specs.pre) specs in let init_props = Propset.from_proplist (init_prop :: init_props_from_pres) in let init_edgeset = let add pset prop = @@ -936,7 +936,7 @@ let perform_analysis_phase cfg tenv (pname : Procname.t) (pdesc : Cfg.Procdesc.t go, get_results in let re_execution proc_name : (unit -> unit) * (unit -> Prop.normal Specs.spec list) = - let candidate_preconditions = list_map (fun spec -> spec.Specs.pre) (Specs.get_specs proc_name) in + let candidate_preconditions = IList.map (fun spec -> spec.Specs.pre) (Specs.get_specs proc_name) in let valid_specs = ref [] in let go () = L.out "@.#### Start: Re-Execution for %a ####@." Procname.pp proc_name; @@ -957,12 +957,12 @@ let perform_analysis_phase cfg tenv (pname : Procname.t) (pdesc : Cfg.Procdesc.t if !Config.undo_join then ignore (Specs.Jprop.filter filter candidate_preconditions) else - ignore (list_map filter candidate_preconditions) in + ignore (IList.map filter candidate_preconditions) in let get_results () = let specs = !valid_specs in L.out "#### [FUNCTION %a] ... OK #####@\n" Procname.pp proc_name; L.out "#### Finished: Re-Execution for %a ####@." Procname.pp proc_name; - let valid_preconditions = list_map (fun spec -> spec.Specs.pre) specs in + let valid_preconditions = IList.map (fun spec -> spec.Specs.pre) specs in let filename = DB.Results_dir.path_to_filename DB.Results_dir.Abs_source_dir [(Procname.to_filename proc_name)] in if !Config.write_dotty then Dotty.pp_speclist_dotty_file filename specs; @@ -1011,10 +1011,10 @@ let exception_preconditions tenv pname summary = let collect_spec errors spec = match !Config.curr_language with | Config.Java -> - list_fold_left (collect_exceptions spec.Specs.pre) errors spec.Specs.posts + IList.fold_left (collect_exceptions spec.Specs.pre) errors spec.Specs.posts | Config.C_CPP -> - list_fold_left (collect_errors spec.Specs.pre) errors spec.Specs.posts in - list_fold_left collect_spec [] (Specs.get_specs_from_payload summary) + IList.fold_left (collect_errors spec.Specs.pre) errors spec.Specs.posts in + IList.fold_left collect_spec [] (Specs.get_specs_from_payload summary) (* Remove the constrain of the form this != null which is true for all Java virtual calls *) @@ -1027,11 +1027,11 @@ let remove_this_not_null prop = | Sil.Aneq (Sil.Var v, e) when Ident.equal v var && Sil.exp_equal e Sil.exp_null -> atoms | a -> a:: atoms in - match list_fold_left collect_hpred (None, []) (Prop.get_sigma prop) with + match IList.fold_left collect_hpred (None, []) (Prop.get_sigma prop) with | None, _ -> prop | Some var, filtered_hpreds -> let filtered_atoms = - list_fold_left (collect_atom var) [] (Prop.get_pi prop) in + IList.fold_left (collect_atom var) [] (Prop.get_pi prop) in let prop' = Prop.replace_pi filtered_atoms Prop.prop_emp in let prop'' = Prop.replace_sigma filtered_hpreds prop' in Prop.normalize prop'' @@ -1069,12 +1069,12 @@ let report_runtime_exceptions tenv cfg pdesc summary = let exn_desc = Localise.java_unchecked_exn_desc pname runtime_exception pre_str in let exn = Exceptions.Java_runtime_exception (runtime_exception, pre_str, exn_desc) in Reporting.log_error pname ~pre: (Some (Specs.Jprop.to_prop pre)) exn in - list_iter report (exception_preconditions tenv pname summary) + IList.iter report (exception_preconditions tenv pname summary) (** update a summary after analysing a procedure *) let update_summary prev_summary specs proc_name elapsed res = - let normal_specs = list_map Specs.spec_normalize specs in + let normal_specs = IList.map Specs.spec_normalize specs in let new_specs, changed = Fork.update_specs proc_name normal_specs in let timestamp = max 1 (prev_summary.Specs.timestamp + if changed then 1 else 0) in let stats_time = prev_summary.Specs.stats.Specs.stats_time +. elapsed in @@ -1147,7 +1147,7 @@ let perform_transition exe_env cg proc_name = L.err "Error: %s %a@." err_str pp_ml_location_opt mloco; [] in Fork.transition_footprint_re_exe pname joined_pres in - list_iter transition proc_names + IList.iter transition proc_names (** Process the result of the analysis of [proc_name]: update the returned summary and add it to the spec table. Executed in the @@ -1190,10 +1190,10 @@ let check_skipped_procs procs_and_defined_children = | Specs.CallStats.CR_skip, _ -> skipped_procs := Procname.Set.add pn !skipped_procs | _ -> () in - let do_call (pn, _) (tr: Specs.CallStats.trace) = list_iter (do_tr_elem pn) tr in + let do_call (pn, _) (tr: Specs.CallStats.trace) = IList.iter (do_tr_elem pn) tr in Specs.CallStats.iter do_call call_stats in if Specs.summary_exists pname then process_skip () in - list_iter proc_check_skips procs_and_defined_children; + IList.iter proc_check_skips procs_and_defined_children; let skipped_procs_with_summary = Procname.Set.filter Specs.summary_exists !skipped_procs in skipped_procs_with_summary @@ -1224,13 +1224,13 @@ let do_analysis exe_env = let calls = ref [] in let f (callee_pname, loc) = calls := (callee_pname, loc) :: !calls in Cfg.Procdesc.iter_calls f caller_pdesc; - list_rev !calls in + IList.rev !calls in let init_proc (pname, dep) = let cfg = Exe_env.get_cfg exe_env pname in let pdesc = match Cfg.Procdesc.find_from_name cfg pname with | Some pdesc -> pdesc | None -> assert false in - let nodes = list_map (fun n -> Cfg.Node.get_id n) (Cfg.Procdesc.get_nodes pdesc) in + let nodes = IList.map (fun n -> Cfg.Node.get_id n) (Cfg.Procdesc.get_nodes pdesc) in let proc_flags = Cfg.Procdesc.get_flags pdesc in let static_err_log = Cfg.Procdesc.get_err_log pdesc in (** err log from translation *) let calls = get_calls pdesc in @@ -1247,7 +1247,7 @@ let do_analysis exe_env = if !Config.only_skips then (filter_skipped_procs cg procs_and_defined_children) else if !Config.only_nospecs then filter_nospecs else (fun _ -> true) in - list_iter + IList.iter (fun ((pn, _) as x) -> let should_init () = not !Config.ondemand_enabled || @@ -1282,7 +1282,7 @@ let do_analysis exe_env = let visited_and_total_nodes cfg = let all_nodes = let add s n = Cfg.NodeSet.add n s in - list_fold_left add Cfg.NodeSet.empty (Cfg.Node.get_all_nodes cfg) in + IList.fold_left add Cfg.NodeSet.empty (Cfg.Node.get_all_nodes cfg) in let filter_node n = Cfg.Procdesc.is_defined (Cfg.Node.get_proc_desc n) && match Cfg.Node.get_kind n with @@ -1297,13 +1297,13 @@ let visited_and_total_nodes cfg = was defined in another module, and was the one which was analyzed *) let print_stats_cfg proc_shadowed proc_is_active cfg = let err_table = Errlog.create_err_table () in - let active_procs = list_filter proc_is_active (Cfg.get_defined_procs cfg) in + let active_procs = IList.filter proc_is_active (Cfg.get_defined_procs cfg) in let nvisited, ntotal = visited_and_total_nodes cfg in let node_filter n = let node_procname = Cfg.Procdesc.get_proc_name (Cfg.Node.get_proc_desc n) in Specs.summary_exists node_procname && Specs.get_specs node_procname != [] in - let nodes_visited = list_filter node_filter nvisited in - let nodes_total = list_filter node_filter ntotal in + let nodes_visited = IList.filter node_filter nvisited in + let nodes_total = IList.filter node_filter ntotal in let num_proc = ref 0 in let num_nospec_noerror_proc = ref 0 in let num_spec_noerror_proc = ref 0 in @@ -1323,7 +1323,7 @@ let print_stats_cfg proc_shadowed proc_is_active cfg = let err_log = summary.Specs.attributes.ProcAttributes.err_log in incr num_proc; let specs = Specs.get_specs_from_payload summary in - tot_specs := (list_length specs) + !tot_specs; + tot_specs := (IList.length specs) + !tot_specs; let () = match specs, Errlog.size @@ -1344,7 +1344,7 @@ let print_stats_cfg proc_shadowed proc_is_active cfg = (* F.fprintf fmt "VISITED: %a@\n" (pp_seq pp_node) nodes_visited; F.fprintf fmt "TOTAL: %a@\n" (pp_seq pp_node) nodes_total; *) F.fprintf fmt "@\n++++++++++++++++++++++++++++++++++++++++++++++++++@\n"; - F.fprintf fmt "+ FILE: %s LOC: %n VISITED: %d/%d SYMOPS: %d@\n" (DB.source_file_to_string !DB.current_source) !Config.nLOC (list_length nodes_visited) (list_length nodes_total) !tot_symops; + F.fprintf fmt "+ FILE: %s LOC: %n VISITED: %d/%d SYMOPS: %d@\n" (DB.source_file_to_string !DB.current_source) !Config.nLOC (IList.length nodes_visited) (IList.length nodes_total) !tot_symops; F.fprintf fmt "+ num_procs: %d (%d ok, %d timeouts, %d errors, %d warnings, %d infos)@\n" !num_proc num_ok_proc !num_timeout num_errors num_warnings num_infos; F.fprintf fmt "+ detail procs:@\n"; F.fprintf fmt "+ - No Errors and No Specs: %d@\n" !num_nospec_noerror_proc; @@ -1366,7 +1366,7 @@ let print_stats_cfg proc_shadowed proc_is_active cfg = print_file_stats fmt (); close_out outc with Sys_error _ -> () in - list_iter compute_stats_proc active_procs; + IList.iter compute_stats_proc active_procs; L.out "%a" print_file_stats (); save_file_stats () diff --git a/infer/src/backend/io_infer.ml b/infer/src/backend/io_infer.ml index b83de078d..747b80907 100644 --- a/infer/src/backend/io_infer.ml +++ b/infer/src/backend/io_infer.ml @@ -35,10 +35,10 @@ module Html : sig val pp_start_color : Format.formatter -> color -> unit (** Print start color *) end = struct let create pk path = - let fname, dir_path = match list_rev path with + let fname, dir_path = match IList.rev path with | fname:: dir_path -> fname, dir_path | [] -> raise (Failure "Html.create") in - let fd = DB.Results_dir.create_file pk (list_rev ((fname ^ ".html") :: dir_path)) in + let fd = DB.Results_dir.create_file pk (IList.rev ((fname ^ ".html") :: dir_path)) in let outc = Unix.out_channel_of_descr fd in let fmt = F.formatter_of_out_channel outc in let (++) x y = x ^ "\n" ^ y in @@ -103,10 +103,10 @@ end = struct (** get the full html filename from a path *) let get_full_fname path = - let fname, dir_path = match list_rev path with + let fname, dir_path = match IList.rev path with | fname:: dir_path -> fname, dir_path | [] -> raise (Failure "Html.open_out") in - DB.Results_dir.path_to_filename DB.Results_dir.Abs_source_dir (list_rev ((fname ^ ".html") :: dir_path)) + DB.Results_dir.path_to_filename DB.Results_dir.Abs_source_dir (IList.rev ((fname ^ ".html") :: dir_path)) let open_out path = let full_fname = get_full_fname path in @@ -261,7 +261,7 @@ module Xml = struct | String s -> F.fprintf fmt "%s%s%s" indent s newline and pp_forest newline indent fmt forest = - list_iter (pp_node newline indent fmt) forest + IList.iter (pp_node newline indent fmt) forest let pp_prelude fmt = pp fmt "%s" "\n" diff --git a/infer/src/backend/localise.ml b/infer/src/backend/localise.ml index 536085528..d102f71ae 100644 --- a/infer/src/backend/localise.ml +++ b/infer/src/backend/localise.ml @@ -126,11 +126,11 @@ module Tags = struct let create () = ref [] let add tags tag value = tags := (tag, value) :: !tags let update tags tag value = - let tags' = list_filter (fun (t, v) -> t <> tag) tags in + let tags' = IList.filter (fun (t, v) -> t <> tag) tags in (tag, value) :: tags' let get tags tag = try - let (_, v) = list_find (fun (t, _) -> t = tag) tags in + let (_, v) = IList.find (fun (t, _) -> t = tag) tags in Some v with Not_found -> None end @@ -151,7 +151,7 @@ let error_desc_extract_tag_value (_, _, tags) tag_to_extract = | (t, _) when t = tag -> true | _ -> false in try - let _, s = list_find (find_value tag_to_extract) tags in + let _, s = IList.find (find_value tag_to_extract) tags in s with Not_found -> "" @@ -178,8 +178,8 @@ let error_desc_set_bucket (l, advice, tags) bucket show_in_message = (** get the value tag, if any *) let get_value_line_tag tags = try - let value = snd (list_find (fun (_tag, value) -> _tag = Tags.value) tags) in - let line = snd (list_find (fun (_tag, value) -> _tag = Tags.line) tags) in + let value = snd (IList.find (fun (_tag, value) -> _tag = Tags.value) tags) in + let line = snd (IList.find (fun (_tag, value) -> _tag = Tags.line) tags) in Some [value; line] with Not_found -> None @@ -461,7 +461,7 @@ let parameter_field_not_null_checked_desc desc exp = let has_tag desc tag = match desc with | descriptions, advice, tags -> - list_exists (fun (tag', value) -> tag = tag') tags + IList.exists (fun (tag', value) -> tag = tag') tags let is_parameter_not_null_checked_desc desc = has_tag desc Tags.parameter_not_null_checked @@ -658,7 +658,7 @@ let desc_retain_cycle prop cycle loc = str_cycle:=!str_cycle^" ("^(string_of_int !ct)^") an object of "^(Sil.typ_to_string typ)^" retaining another object via instance variable "^(Ident.fieldname_to_string f)^", "; ct:=!ct +1 | _ -> () in - list_iter do_edge cycle; + IList.iter do_edge cycle; let desc = Format.sprintf "Retain cycle involving the following objects: %s %s" !str_cycle (at_line tags loc) in [desc], None, !tags diff --git a/infer/src/backend/match.ml b/infer/src/backend/match.ml index 03e8165c4..b760cceb3 100644 --- a/infer/src/backend/match.ml +++ b/infer/src/backend/match.ml @@ -15,7 +15,7 @@ module F = Format open Utils let mem_idlist i l = - list_exists (Ident.equal i) l + IList.exists (Ident.equal i) l (** Type for a hpred pattern. flag=false means that the implication between hpreds is not considered, and flag = true means that it is @@ -40,7 +40,7 @@ let rec exp_match e1 sub vars e2 : (Sil.subst * Ident.t list) option = in if (Sil.exp_equal e1 e2_inst) then Some(sub, vars) else None in match e1, e2 with | _, Sil.Var id2 when (Ident.is_primed id2 && mem_idlist id2 vars) -> - let vars_new = list_filter (fun id -> not (Ident.equal id id2)) vars in + let vars_new = IList.filter (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 @@ -82,8 +82,8 @@ let exp_list_match es1 sub vars es2 = let f res_acc (e1, e2) = match res_acc with | None -> None | Some (sub_acc, vars_leftover) -> exp_match e1 sub_acc vars_leftover e2 in - let es_combined = try list_combine es1 es2 with Invalid_argument _ -> assert false in - let es_match_res = list_fold_left f (Some (sub, vars)) es_combined + let es_combined = try IList.combine es1 es2 with Invalid_argument _ -> assert false in + let es_match_res = IList.fold_left f (Some (sub, vars)) es_combined in es_match_res (** Checks sexp1 = sexp2[sub ++ sub'] for some sub' with @@ -135,7 +135,7 @@ and isel_match isel1 sub vars isel2 = | [], _ | _, [] -> None | (idx1, se1') :: isel1', (idx2, se2') :: isel2' -> let idx2 = Sil.exp_sub sub idx2 in - let sanity_check = not (list_exists (fun id -> Sil.ident_in_exp id idx2) vars) in + let sanity_check = not (IList.exists (fun id -> Sil.ident_in_exp id idx2) vars) in if (not sanity_check) then begin let pe = pe_text in L.out "@[.... Sanity Check Failure while Matching Index-Strexps ....@."; @@ -156,12 +156,12 @@ let sub_extend_with_ren (sub: Sil.subst) vars = (* let check_precondition () = let dom = Sil.sub_domain sub in - let overlap = list_exists (fun id -> list_exists (Ident.equal id) dom) vars in + let overlap = IList.exists (fun id -> IList.exists (Ident.equal id) dom) vars in if overlap then assert false in check_precondition (); *) let f id = (id, Sil.Var (Ident.create_fresh Ident.kprimed)) in - let renaming_for_vars = Sil.sub_of_list (list_map f vars) in + let renaming_for_vars = Sil.sub_of_list (IList.map f vars) in Sil.sub_join sub renaming_for_vars type sidecondition = Prop.normal Prop.t -> Sil.subst -> bool @@ -182,7 +182,7 @@ let rec instantiate_to_emp p condition sub vars = function else match hpat.hpred with | Sil.Hpointsto _ | Sil.Hlseg (Sil.Lseg_NE, _, _, _, _) | Sil.Hdllseg (Sil.Lseg_NE, _, _, _, _, _, _) -> None | Sil.Hlseg (k, _, e1, e2, _) -> - let fully_instantiated = not (list_exists (fun id -> Sil.ident_in_exp id e1) vars) + let fully_instantiated = not (IList.exists (fun id -> Sil.ident_in_exp id e1) vars) in if (not fully_instantiated) then None else let e1' = Sil.exp_sub sub e1 in begin @@ -193,7 +193,7 @@ let rec instantiate_to_emp p condition sub vars = function end | Sil.Hdllseg (k, _, iF, oB, oF, iB, _) -> let fully_instantiated = - not (list_exists (fun id -> Sil.ident_in_exp id iF || Sil.ident_in_exp id oB) vars) + not (IList.exists (fun id -> Sil.ident_in_exp id iF || Sil.ident_in_exp id oB) vars) in if (not fully_instantiated) then None else let iF' = Sil.exp_sub sub iF in let oB' = Sil.exp_sub sub oB @@ -289,7 +289,7 @@ let rec iter_match_with_impl iter condition sub vars hpat hpats = | Sil.Hlseg (k2, para2, e_start2, e_end2, es_shared2) -> let filter = gen_filter_lseg k2 para2 e_start2 e_end2 es_shared2 in let do_emp_lseg _ = - let fully_instantiated_start2 = not (list_exists (fun id -> Sil.ident_in_exp id e_start2) vars) in + let fully_instantiated_start2 = not (IList.exists (fun id -> Sil.ident_in_exp id e_start2) vars) in if (not fully_instantiated_start2) then None else let e_start2' = Sil.exp_sub sub e_start2 in @@ -313,7 +313,7 @@ let rec iter_match_with_impl iter condition sub vars hpat hpats = let (para2_exist_vars, para2_inst) = Sil.hpara_instantiate para2 e_start2 e_end2 es_shared2 in (* let allow_impl hpred = {hpred=hpred; flag=hpat.flag} in *) let allow_impl hpred = { hpred = hpred; flag = true } in - let (para2_hpat, para2_hpats) = match list_map allow_impl para2_inst with + let (para2_hpat, para2_hpats) = match IList.map allow_impl para2_inst with | [] -> assert false (* the body of a parameter should contain at least one * conjunct *) | para2_pat :: para2_pats -> (para2_pat, para2_pats) in let new_vars = para2_exist_vars @ vars in @@ -322,7 +322,7 @@ let rec iter_match_with_impl iter condition sub vars hpat hpats = | None -> None | Some (sub_res, p_leftover) when condition p_leftover sub_res -> let not_in_para2_exist_vars id = - not (list_exists (fun id' -> Ident.equal id id') para2_exist_vars) in + not (IList.exists (fun id' -> Ident.equal id id') para2_exist_vars) in let sub_res' = Sil.sub_filter not_in_para2_exist_vars sub_res in Some (sub_res', p_leftover) | Some _ -> None @@ -347,7 +347,7 @@ let rec iter_match_with_impl iter condition sub vars hpat hpats = let filter = gen_filter_dllseg k2 para2 iF2 oB2 oF2 iB2 es_shared2 in let do_emp_dllseg _ = let fully_instantiated_iFoB2 = - not (list_exists (fun id -> Sil.ident_in_exp id iF2 || Sil.ident_in_exp id oB2) vars) + not (IList.exists (fun id -> Sil.ident_in_exp id iF2 || Sil.ident_in_exp id oB2) vars) in if (not fully_instantiated_iFoB2) then None else let iF2' = Sil.exp_sub sub iF2 in let oB2' = Sil.exp_sub sub oB2 @@ -361,7 +361,7 @@ let rec iter_match_with_impl iter condition sub vars hpat hpats = let p = Prop.prop_iter_to_prop iter in prop_match_with_impl_sub p condition sub_new vars_leftover hpat_next hpats_rest in let do_para_dllseg _ = - let fully_instantiated_iF2 = not (list_exists (fun id -> Sil.ident_in_exp id iF2) vars) + let fully_instantiated_iF2 = not (IList.exists (fun id -> Sil.ident_in_exp id iF2) vars) in if (not fully_instantiated_iF2) then None else let iF2' = Sil.exp_sub sub iF2 in match exp_match iF2' sub vars iB2 with @@ -370,7 +370,7 @@ let rec iter_match_with_impl iter condition sub vars hpat hpats = let (para2_exist_vars, para2_inst) = Sil.hpara_dll_instantiate para2 iF2 oB2 oF2 es_shared2 in (* let allow_impl hpred = {hpred=hpred; flag=hpat.flag} in *) let allow_impl hpred = { hpred = hpred; flag = true } in - let (para2_hpat, para2_hpats) = match list_map allow_impl para2_inst with + let (para2_hpat, para2_hpats) = match IList.map allow_impl para2_inst with | [] -> assert false (* the body of a parameter should contain at least one * conjunct *) | para2_pat :: para2_pats -> (para2_pat, para2_pats) in let new_vars = para2_exist_vars @ vars_leftover in @@ -379,7 +379,7 @@ let rec iter_match_with_impl iter condition sub vars hpat hpats = | None -> None | Some (sub_res, p_leftover) when condition p_leftover sub_res -> let not_in_para2_exist_vars id = - not (list_exists (fun id' -> Ident.equal id id') para2_exist_vars) in + not (IList.exists (fun id' -> Ident.equal id id') para2_exist_vars) in let sub_res' = Sil.sub_filter not_in_para2_exist_vars sub_res in Some (sub_res', p_leftover) | Some _ -> None @@ -408,14 +408,14 @@ and prop_match_with_impl_sub p condition sub vars hpat hpats = and hpara_common_match_with_impl impl_ok ids1 sigma1 eids2 ids2 sigma2 = try let sub_ids = - let ren_ids = list_combine ids2 ids1 in + let ren_ids = IList.combine ids2 ids1 in let f (id2, id1) = (id2, Sil.Var id1) in - list_map f ren_ids in + IList.map f ren_ids in let (sub_eids, eids_fresh) = let f id = (id, Ident.create_fresh Ident.kprimed) in - let ren_eids = list_map f eids2 in - let eids_fresh = list_map snd ren_eids in - let sub_eids = list_map (fun (id2, id1) -> (id2, Sil.Var id1)) ren_eids in + let ren_eids = IList.map f eids2 in + let eids_fresh = IList.map snd ren_eids in + let sub_eids = IList.map (fun (id2, id1) -> (id2, Sil.Var id1)) ren_eids in (sub_eids, eids_fresh) in let sub = Sil.sub_of_list (sub_ids @ sub_eids) in match sigma2 with @@ -424,7 +424,7 @@ and hpara_common_match_with_impl impl_ok ids1 sigma1 eids2 ids2 sigma2 = let (hpat2, hpats2) = let (hpred2_ren, sigma2_ren) = (Sil.hpred_sub sub hpred2, Prop.sigma_sub sub sigma2) in let allow_impl hpred = { hpred = hpred; flag = impl_ok } in - (allow_impl hpred2_ren, list_map allow_impl sigma2_ren) in + (allow_impl hpred2_ren, IList.map allow_impl sigma2_ren) in let condition _ _ = true in let p1 = Prop.normalize (Prop.from_sigma sigma1) in begin @@ -472,7 +472,7 @@ let sigma_remove_hpred eq sigma e = | Sil.Hpointsto (root, _, _) | Sil.Hlseg (_, _, root, _, _) | Sil.Hdllseg (_, _, root, _, _, _, _) -> eq root e in - let sigma_e, sigma_no_e = list_partition filter sigma in + let sigma_e, sigma_no_e = IList.partition filter sigma in match sigma_e with | [] -> (None, sigma) | [hpred_e] -> (Some hpred_e, sigma_no_e) @@ -491,13 +491,13 @@ let rec generate_todos_from_strexp mode todos sexp1 sexp2 = | Sil.Eexp _, _ -> None | Sil.Estruct (fel1, _), Sil.Estruct (fel2, _) -> (* assume sorted w.r.t. fields *) - if (list_length fel1 <> list_length fel2) && mode == Exact + if (IList.length fel1 <> IList.length fel2) && mode == Exact then None else generate_todos_from_fel mode todos fel1 fel2 | Sil.Estruct _, _ -> None | Sil.Earray (size1, iel1, _), Sil.Earray (size2, iel2, _) -> - if (not (Sil.exp_equal size1 size2) || list_length iel1 <> list_length iel2) + if (not (Sil.exp_equal size1 size2) || IList.length iel1 <> IList.length iel2) then None else generate_todos_from_iel mode todos iel1 iel2 | Sil.Earray _, _ -> @@ -545,19 +545,19 @@ and generate_todos_from_iel mode todos iel1 iel2 = let corres_extend_front e1 e2 corres = let filter (e1', e2') = (Sil.exp_equal e1 e1') || (Sil.exp_equal e2 e2') in let checker e1' e2' = (Sil.exp_equal e1 e1') && (Sil.exp_equal e2 e2') - in match (list_filter filter corres) with + in match (IList.filter filter corres) with | [] -> Some ((e1, e2) :: corres) | [(e1', e2')] when checker e1' e2' -> Some corres | _ -> None let corres_extensible corres e1 e2 = let predicate (e1', e2') = (Sil.exp_equal e1 e1') || (Sil.exp_equal e2 e2') - in not (list_exists predicate corres) && not (Sil.exp_equal e1 e2) + in not (IList.exists predicate corres) && not (Sil.exp_equal e1 e2) let corres_related corres e1 e2 = let filter (e1', e2') = (Sil.exp_equal e1 e1') || (Sil.exp_equal e2 e2') in let checker e1' e2' = (Sil.exp_equal e1 e1') && (Sil.exp_equal e2 e2') in - match (list_filter filter corres) with + match (IList.filter filter corres) with | [] -> Sil.exp_equal e1 e2 | [(e1', e2')] when checker e1' e2' -> true | _ -> false @@ -579,7 +579,7 @@ let rec generic_find_partial_iso mode update corres sigma_corres todos sigma_tod match todos with | [] -> let sigma1, sigma2 = sigma_corres in - Some (list_rev corres, list_rev sigma1, list_rev sigma2, sigma_todo) + Some (IList.rev corres, IList.rev sigma1, IList.rev sigma2, sigma_todo) | (e1, e2) :: todos' when corres_related corres e1 e2 -> begin match corres_extend_front e1 e2 corres with @@ -633,7 +633,7 @@ let rec generic_find_partial_iso mode update corres sigma_corres todos sigma_tod let new_sigma2 = hpred2 :: sigma2 in (new_sigma1, new_sigma2) in let new_todos = - let shared12 = list_combine shared1 shared2 in + let shared12 = IList.combine shared1 shared2 in (root1, root2) :: (next1, next2) :: shared12 @ todos' in generic_find_partial_iso mode update new_corres new_sigma_corres new_todos new_sigma_todo with Invalid_argument _ -> None) @@ -651,7 +651,7 @@ let rec generic_find_partial_iso mode update corres sigma_corres todos sigma_tod let new_sigma2 = hpred2 :: sigma2 in (new_sigma1, new_sigma2) in let new_todos = - let shared12 = list_combine shared1 shared2 in + let shared12 = IList.combine shared1 shared2 in (iF1, iF2):: (oB1, oB2):: (oF1, oF2):: (iB1, iB2):: shared12@todos' in generic_find_partial_iso mode update new_corres new_sigma_corres new_todos new_sigma_todo with Invalid_argument _ -> None) @@ -700,7 +700,7 @@ let hpred_lift_to_pe hpred = (** Lift the kind of list segment predicates to PE in a given sigma *) let sigma_lift_to_pe sigma = - list_map hpred_lift_to_pe sigma + IList.map hpred_lift_to_pe sigma (** [generic_para_create] takes a correspondence, and a sigma and a list of expressions for the first part of this @@ -714,20 +714,20 @@ let generic_para_create corres sigma1 elist1 = let not_same_consts = function | Sil.Const c1, Sil.Const c2 -> not (Sil.const_equal c1 c2) | _ -> true in - let new_corres' = list_filter not_same_consts corres in + let new_corres' = IList.filter not_same_consts corres in let add_fresh_id pair = (pair, Ident.create_fresh Ident.kprimed) in - list_map add_fresh_id new_corres' in + IList.map add_fresh_id new_corres' in let (es_shared, ids_shared, ids_exists) = - let not_in_elist1 ((e1, _), _) = not (list_exists (Sil.exp_equal e1) elist1) in - let corres_ids_no_elist1 = list_filter not_in_elist1 corres_ids in + let not_in_elist1 ((e1, _), _) = not (IList.exists (Sil.exp_equal e1) elist1) in + let corres_ids_no_elist1 = IList.filter not_in_elist1 corres_ids in let should_be_shared ((e1, e2), _) = Sil.exp_equal e1 e2 in - let shared, exists = list_partition should_be_shared corres_ids_no_elist1 in - let es_shared = list_map (fun ((e1, _), _) -> e1) shared in - (es_shared, list_map snd shared, list_map snd exists) in - let renaming = list_map (fun ((e1, _), id) -> (e1, id)) corres_ids in + let shared, exists = IList.partition should_be_shared corres_ids_no_elist1 in + let es_shared = IList.map (fun ((e1, _), _) -> e1) shared in + (es_shared, IList.map snd shared, IList.map snd exists) in + let renaming = IList.map (fun ((e1, _), id) -> (e1, id)) corres_ids in let body = let sigma1' = sigma_lift_to_pe sigma1 in - let renaming_exp = list_map (fun (e1, id) -> (e1, Sil.Var id)) renaming in + let renaming_exp = IList.map (fun (e1, id) -> (e1, Sil.Var id)) renaming in Prop.sigma_replace_exp renaming_exp sigma1' in (renaming, body, ids_exists, ids_shared, es_shared) @@ -741,7 +741,7 @@ let hpara_create corres sigma1 root1 next1 = let get_id1 e1 = try let is_equal_to_e1 (e1', _) = Sil.exp_equal e1 e1' in - let _, id = list_find is_equal_to_e1 renaming in + let _, id = IList.find is_equal_to_e1 renaming in id with Not_found -> assert false in let id_root = get_id1 root1 in @@ -764,7 +764,7 @@ let hpara_dll_create corres sigma1 root1 blink1 flink1 = let get_id1 e1 = try let is_equal_to_e1 (e1', _) = Sil.exp_equal e1 e1' in - let _, id = list_find is_equal_to_e1 renaming in + let _, id = IList.find is_equal_to_e1 renaming in id with Not_found -> assert false in let id_root = get_id1 root1 in diff --git a/infer/src/backend/mleak_buckets.ml b/infer/src/backend/mleak_buckets.ml index 7915c277d..5baa48100 100644 --- a/infer/src/backend/mleak_buckets.ml +++ b/infer/src/backend/mleak_buckets.ml @@ -68,20 +68,20 @@ let init_buckets ml_buckets_arg = let buckets = match buckets with | ["all"] -> [] - | _ -> list_map bucket_from_string buckets in + | _ -> IList.map bucket_from_string buckets in ml_buckets := buckets let contains_cf ml_buckets = - list_mem mleak_bucket_eq MLeak_cf ml_buckets + IList.mem mleak_bucket_eq MLeak_cf ml_buckets let contains_arc ml_buckets = - list_mem mleak_bucket_eq MLeak_arc ml_buckets + IList.mem mleak_bucket_eq MLeak_arc ml_buckets let contains_narc ml_buckets = - list_mem mleak_bucket_eq MLeak_no_arc ml_buckets + IList.mem mleak_bucket_eq MLeak_no_arc ml_buckets let contains_cpp ml_buckets = - list_mem mleak_bucket_eq MLeak_cpp ml_buckets + IList.mem mleak_bucket_eq MLeak_cpp ml_buckets let should_raise_leak_cf typ = if contains_cf !ml_buckets then @@ -110,7 +110,7 @@ let should_raise_cpp_leak () = (* If arc is passed, check leaks from code that compiles with arc*) (* If no arc is passed check the leaks from code that compiles without arc *) let should_raise_objc_leak typ = - if list_length !ml_buckets = 0 then Some "" + if IList.length !ml_buckets = 0 then Some "" else if should_raise_leak_cf typ then Some (bucket_to_message MLeak_cf) else if should_raise_leak_arc () then Some (bucket_to_message MLeak_arc) diff --git a/infer/src/backend/objc_models.ml b/infer/src/backend/objc_models.ml index d658bacf5..f54a8dc4b 100644 --- a/infer/src/backend/objc_models.ml +++ b/infer/src/backend/objc_models.ml @@ -201,8 +201,8 @@ struct | Core_graphics -> core_graphics_types let is_objc_memory_model_controlled o = - list_mem (string_equal) o core_foundation_types || - list_mem (string_equal) o core_graphics_types + IList.mem (string_equal) o core_foundation_types || + IList.mem (string_equal) o core_graphics_types let rec is_core_lib lib typ = match typ with @@ -211,7 +211,7 @@ struct | Sil.Tvar (Sil.TN_csu (_, name) ) | Sil.Tstruct(_, _, _, (Some name), _, _, _) -> let core_lib_types = core_lib_to_type_list lib in - list_mem (=) (Mangled.to_string name) core_lib_types + IList.mem (=) (Mangled.to_string name) core_lib_types | _ -> false let is_core_foundation_type typ = @@ -244,7 +244,7 @@ struct let is_core_graphics_release typ funct = try - let cg_typ = list_find + let cg_typ = IList.find (fun lib -> (funct = (lib^upper_release))) core_graphics_types in (string_contains (cg_typ^ref) typ) with Not_found -> false diff --git a/infer/src/backend/objc_preanal.ml b/infer/src/backend/objc_preanal.ml index e6f8ce6cc..884fbe8de 100644 --- a/infer/src/backend/objc_preanal.ml +++ b/infer/src/backend/objc_preanal.ml @@ -28,7 +28,7 @@ let process_all_cfgs process_function default_value = match cfg_opt with | None -> value | Some cfg -> process_function cfg source_dir in - list_fold_right process_dir source_dirs default_value + IList.fold_right process_dir source_dirs default_value let process_procedures process_function default_value procedure_type = let process_cfg_procedures cfg source_dir = @@ -37,7 +37,7 @@ let process_procedures process_function default_value procedure_type = | DEFINED -> Cfg.get_defined_procs cfg | ALL -> Cfg.get_all_procs cfg | OBJC_GENERATED -> Cfg.get_objc_generated_procs cfg in - list_fold_right (process_function cfg source_dir) procdescs default_value in + IList.fold_right (process_function cfg source_dir) procdescs default_value in process_all_cfgs process_cfg_procedures default_value let process_all_procedures process_function default_value = @@ -89,7 +89,7 @@ let update_cfgs generated_proc_map = Cg.node_set_defined cg pname false; true) else need_updating in - let need_updating = list_fold_right update_cfg_procdesc generated_procs false in + let need_updating = IList.fold_right update_cfg_procdesc generated_procs false in if need_updating then (Cfg.store_cfg_to_file cfg_name false cfg; Cg.store_to_file cg_name cg) in diff --git a/infer/src/backend/paths.ml b/infer/src/backend/paths.ml index ffcd2bf0d..872a0b49d 100644 --- a/infer/src/backend/paths.ml +++ b/infer/src/backend/paths.ml @@ -321,12 +321,12 @@ end = struct if !position_seen then let rec remove_until_seen = function | ((level, p, session, exn_opt) as x):: l -> - if path_pos_at_path p then list_rev (x :: l) + if path_pos_at_path p then IList.rev (x :: l) else remove_until_seen l | [] -> [] in remove_until_seen inverse_sequence - else list_rev inverse_sequence in - list_iter (fun (level, p, session, exn_opt) -> f level p session exn_opt) sequence_up_to_last_seen + else IList.rev inverse_sequence in + IList.iter (fun (level, p, session, exn_opt) -> f level p session exn_opt) sequence_up_to_last_seen module NodeMap = Map.Make (Cfg.Node) @@ -473,8 +473,8 @@ end = struct let n = int_compare lt1.Errlog.lt_level lt2.Errlog.lt_level in if n <> 0 then n else Location.compare lt1.Errlog.lt_loc lt2.Errlog.lt_loc in let relevant lt = lt.Errlog.lt_node_tags <> [] in - list_remove_irrelevant_duplicates compare relevant (list_rev !trace) - (* list_remove_duplicates compare (list_sort compare !trace) *) + IList.remove_irrelevant_duplicates compare relevant (IList.rev !trace) + (* IList.remove_duplicates compare (IList.sort compare !trace) *) end (* =============== END of the Path module ===============*) @@ -561,7 +561,7 @@ end = struct !plist let to_proplist ps = - list_map fst (elements ps) + IList.map fst (elements ps) let to_propset ps = Propset.from_proplist (to_proplist ps) @@ -569,16 +569,16 @@ end = struct let filter f ps = let elements = ref [] in PropMap.iter (fun p _ -> elements := p :: !elements) ps; - elements := list_filter (fun p -> not (f p)) !elements; + elements := IList.filter (fun p -> not (f p)) !elements; let filtered_map = ref ps in - list_iter (fun p -> filtered_map := PropMap.remove p !filtered_map) !elements; + IList.iter (fun p -> filtered_map := PropMap.remove p !filtered_map) !elements; !filtered_map let partition f ps = let elements = ref [] in PropMap.iter (fun p _ -> elements := p :: !elements) ps; let el1, el2 = ref ps, ref ps in - list_iter (fun p -> if f p then el2 := PropMap.remove p !el2 else el1 := PropMap.remove p !el1) !elements; + IList.iter (fun p -> if f p then el2 := PropMap.remove p !el2 else el1 := PropMap.remove p !el1) !elements; !el1, !el2 (** It's the caller's resposibility to ensure that Prop.prop_rename_primed_footprint_vars was called on the prop *) @@ -658,7 +658,7 @@ end = struct (** It's the caller's resposibility to ensure that Prop.prop_rename_primed_footprint_vars was called on the list *) let from_renamed_list (pl : ('a Prop.t * Path.t) list) : t = - list_fold_left (fun ps (p, pa) -> add_renamed_prop p pa ps) empty pl + IList.fold_left (fun ps (p, pa) -> add_renamed_prop p pa ps) empty pl end (* =============== END of the PathSet module ===============*) diff --git a/infer/src/backend/preanal.ml b/infer/src/backend/preanal.ml index 6cfa983fa..0251336a8 100644 --- a/infer/src/backend/preanal.ml +++ b/infer/src/backend/preanal.ml @@ -32,10 +32,10 @@ module AllPreds = struct with Not_found -> NodeHash.add preds_table nto (Cfg.NodeSet.singleton nfrom) in let do_node n = - list_iter (add_edge false n) (Cfg.Node.get_succs n); - list_iter (add_edge true n) (Cfg.Node.get_exn n) in + IList.iter (add_edge false n) (Cfg.Node.get_succs n); + IList.iter (add_edge true n) (Cfg.Node.get_exn n) in let proc_nodes = Cfg.Procdesc.get_nodes pdesc in - list_iter do_node proc_nodes in + IList.iter do_node proc_nodes in clear_table (); Cfg.iter_proc_desc cfg do_pdesc @@ -62,7 +62,7 @@ let is_not_function cfg x = let is_captured_pvar pdesc x = let captured = Cfg.Procdesc.get_captured pdesc in - list_exists (fun (m, _) -> (Sil.pvar_to_string x) = (Mangled.to_string m)) captured + IList.exists (fun (m, _) -> (Sil.pvar_to_string x) = (Mangled.to_string m)) captured (** variables read in the expression *) let rec use_exp cfg pdesc (exp: Sil.exp) acc = @@ -76,7 +76,7 @@ let rec use_exp cfg pdesc (exp: Sil.exp) acc = let defining_proc = Cfg.Procdesc.get_proc_name pdesc in (match !found_pd with | Some pd -> - list_iter (fun (x, _) -> + IList.iter (fun (x, _) -> captured_var:= Vset.add (Sil.mk_pvar x defining_proc) !captured_var ) (Cfg.Procdesc.get_captured pd) | _ -> ()); @@ -89,10 +89,10 @@ let rec use_exp cfg pdesc (exp: Sil.exp) acc = | Sil.BinOp (_, e1, e2) | Sil.Lindex (e1, e2) -> use_exp cfg pdesc e1 (use_exp cfg pdesc e2 acc) and use_etl cfg pdesc (etl: (Sil.exp * Sil.typ) list) acc = - list_fold_left (fun acc (e, _) -> use_exp cfg pdesc e acc) acc etl + IList.fold_left (fun acc (e, _) -> use_exp cfg pdesc e acc) acc etl and use_instrl cfg tenv (pdesc: Cfg.Procdesc.t) (il : Sil.instr list) acc = - list_fold_left (fun acc instr -> use_instr cfg tenv pdesc instr acc) acc il + IList.fold_left (fun acc instr -> use_instr cfg tenv pdesc instr acc) acc il and use_instr cfg tenv (pdesc: Cfg.Procdesc.t) (instr: Sil.instr) acc = match instr with @@ -121,7 +121,7 @@ let rec def_instr cfg (instr: Sil.instr) acc = | Sil.Goto_node _ -> acc and def_instrl cfg instrs acc = - list_fold_left (fun acc' i -> def_instr cfg i acc') acc instrs + IList.fold_left (fun acc' i -> def_instr cfg i acc') acc instrs (* computes the addresses that are assigned to something or passed as parameters to*) (* a functions. These will be considered becoming possibly aliased *) @@ -129,19 +129,19 @@ let rec aliasing_instr cfg pdesc (instr: Sil.instr) acc = match instr with | Sil.Set (_, _, e, _) -> use_exp cfg pdesc e acc | Sil.Call (_, _, argl, _, _) -> - let argl'= fst (list_split argl) in - list_fold_left (fun acc' e' -> use_exp cfg pdesc e' acc') acc argl' + let argl'= fst (IList.split argl) in + IList.fold_left (fun acc' e' -> use_exp cfg pdesc e' acc') acc argl' | Sil.Letderef _ | Sil.Prune _ -> acc | Sil.Nullify _ -> acc | Sil.Abstract _ | Sil.Remove_temps _ | Sil.Stackop _ | Sil.Declare_locals _ -> acc | Sil.Goto_node _ -> acc and aliasing_instrl cfg pdesc (il : Sil.instr list) acc = - list_fold_left (fun acc instr -> aliasing_instr cfg pdesc instr acc) acc il + IList.fold_left (fun acc instr -> aliasing_instr cfg pdesc instr acc) acc il (* computes possible alisased var *) let def_aliased_var cfg pdesc instrs acc = - list_fold_left (fun acc' i -> aliasing_instr cfg pdesc i acc') acc instrs + IList.fold_left (fun acc' i -> aliasing_instr cfg pdesc i acc') acc instrs (** variables written by instructions in the node *) let def_node cfg node acc = @@ -155,7 +155,7 @@ let compute_live_instr cfg tenv pdesc s instr = use_instr cfg tenv pdesc instr (Vset.diff s (def_instr cfg instr Vset.empty)) let compute_live_instrl cfg tenv pdesc instrs livel = - list_fold_left (compute_live_instr cfg tenv pdesc) livel (list_rev instrs) + IList.fold_left (compute_live_instr cfg tenv pdesc) livel (IList.rev instrs) module Worklist = struct module S = Cfg.NodeSet @@ -164,7 +164,7 @@ module Worklist = struct let reset _ = worklist := S.empty let add node = worklist := S.add node !worklist - let add_list = list_iter add + let add_list = IList.iter add let pick () = let min = S.min_elt !worklist in worklist := S.remove min !worklist; @@ -194,13 +194,13 @@ end = struct if not (Vset.equal oldset newset) then Worklist.add node with Not_found -> replace node set; Worklist.add node in - list_iter do_node preds + IList.iter do_node preds let iter init f = let get_live_preds init node = (** nodes live at predecessors *) match AllPreds.get_preds node with | [] -> init - | preds -> list_fold_left Vset.union Vset.empty (list_map get_live preds) in + | preds -> IList.fold_left Vset.union Vset.empty (IList.map get_live preds) in H.iter (fun node live -> f node (get_live_preds init node) live) table end @@ -226,11 +226,11 @@ let compute_candidates procdesc : Vset.t * (Vset.t -> Vset.elt list) = candidates := Vset.add pv !candidates; if typ_is_struct_array typ then struct_array_cand := Vset.add pv !struct_array_cand ) in - list_iter add_vi (list_map (fun (var, typ) -> Mangled.from_string var, typ) (Cfg.Procdesc.get_formals procdesc)); - list_iter add_vi (Cfg.Procdesc.get_locals procdesc); + IList.iter add_vi (IList.map (fun (var, typ) -> Mangled.from_string var, typ) (Cfg.Procdesc.get_formals procdesc)); + IList.iter add_vi (Cfg.Procdesc.get_locals procdesc); let get_sorted_candidates vs = - let priority, no_pri = list_partition (fun pv -> Vset.mem pv !struct_array_cand) (Vset.elements vs) in - list_rev_append (list_rev priority) no_pri in + let priority, no_pri = IList.partition (fun pv -> Vset.mem pv !struct_array_cand) (Vset.elements vs) in + IList.rev_append (IList.rev priority) no_pri in !candidates, get_sorted_candidates (** Construct a table wich associates to each node a set of live variables *) @@ -264,7 +264,7 @@ let print_aliased_var s al_var = (* Printing function useful for debugging *) let print_aliased_var_l s al_var = L.out s; - list_iter (fun v -> L.out " %a, " (Sil.pp_pvar pe_text) v) al_var; + IList.iter (fun v -> L.out " %a, " (Sil.pp_pvar pe_text) v) al_var; L.out "@." (* Instruction i is nullifying a block variable *) @@ -277,16 +277,16 @@ let is_block_nullify i = let node_add_nullify_instrs n dead_vars_after dead_vars_before = let loc = Cfg.Node.get_last_loc n in let move_tmp_pvars_first pvars = - let pvars_tmp, pvars_notmp = list_partition Errdesc.pvar_is_frontend_tmp pvars in + let pvars_tmp, pvars_notmp = IList.partition Errdesc.pvar_is_frontend_tmp pvars in pvars_tmp @ pvars_notmp in let instrs_after = - list_map (fun pvar -> Sil.Nullify (pvar, loc, false)) (move_tmp_pvars_first dead_vars_after) in + IList.map (fun pvar -> Sil.Nullify (pvar, loc, false)) (move_tmp_pvars_first dead_vars_after) in let instrs_before = - list_map (fun pvar -> Sil.Nullify (pvar, loc, false)) (move_tmp_pvars_first dead_vars_before) in + IList.map (fun pvar -> Sil.Nullify (pvar, loc, false)) (move_tmp_pvars_first dead_vars_before) in (* Nullify(bloc_var,_,true) can be placed in the middle of the block because when we add this instruction*) (* we don't have already all the instructions of the node. Here we reorder the instructions to move *) (* nullification of blocks at the end of existing instructions. *) - let block_nullify, no_block_nullify = list_partition is_block_nullify (Cfg.Node.get_instrs n) in + let block_nullify, no_block_nullify = IList.partition is_block_nullify (Cfg.Node.get_instrs n) in Cfg.Node.replace_instrs n (no_block_nullify @ block_nullify); Cfg.Node.append_instrs_temps n instrs_after []; Cfg.Node.prepend_instrs_temps n instrs_before [] @@ -318,12 +318,12 @@ let add_dead_pvars_after_conditionals_join cfg n dead_pvars = | Cfg.Node.Prune_node _ | Cfg.Node.Join_node when node_assigns_no_variables cfg node && not (next_is_exit node) -> (* cannot push nullify instructions after an assignment, as they could nullify the same variable *) let succs = Cfg.Node.get_succs node in - list_iter (add_after_prune_join false) succs + IList.iter (add_after_prune_join false) succs | _ -> let new_dead_pvs = let old_pvs = Cfg.Node.get_dead_pvars node is_after in - let pv_is_new pv = not (list_exists (Sil.pvar_equal pv) old_pvs) in - (list_filter pv_is_new dead_pvars) @ old_pvs in + let pv_is_new pv = not (IList.exists (Sil.pvar_equal pv) old_pvs) in + (IList.filter pv_is_new dead_pvars) @ old_pvs in Cfg.Node.set_dead_pvars node is_after new_dead_pvs end in add_after_prune_join true n @@ -345,7 +345,7 @@ let analyze_and_annotate_proc cfg tenv pname pdesc = let dead_pvars_added = ref 0 in let dead_pvars_limit = 100000 in let incr_dead_pvars_added pvars = - let num = list_length pvars in + let num = IList.length pvars in dead_pvars_added := num + !dead_pvars_added; if !dead_pvars_added > dead_pvars_limit && !dead_pvars_added - num <= dead_pvars_limit then L.err "WARNING: liveness: more than %d dead pvars added in procedure %a, stopping@." dead_pvars_limit Procname.pp pname in @@ -366,7 +366,7 @@ let analyze_and_annotate_proc cfg tenv pname pdesc = else dead_pvars_no_alias in incr_dead_pvars_added dead_pvars_to_add; if !dead_pvars_added < dead_pvars_limit then add_dead_pvars_after_conditionals_join cfg n dead_pvars_to_add); - list_iter (fun n -> (* generate nullify instructions *) + IList.iter (fun n -> (* generate nullify instructions *) let dead_pvs_after = Cfg.Node.get_dead_pvars n true in let dead_pvs_before = Cfg.Node.get_dead_pvars n false in node_add_nullify_instrs n dead_pvs_after dead_pvs_before) diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index 690060266..3fa168478 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -65,23 +65,23 @@ end = struct (Escape.escape_xml (Procname.to_string proc_name)) (Io_infer.Html.pp_line_link [".."]) loc.Location.line; F.fprintf fmt "
PREDS:@\n"; - list_iter (fun node -> + IList.iter (fun node -> Io_infer.Html.pp_node_link [".."] "" - (list_map Cfg.Node.get_id (Cfg.Node.get_preds node)) - (list_map Cfg.Node.get_id (Cfg.Node.get_succs node)) - (list_map Cfg.Node.get_id (Cfg.Node.get_exn node)) + (IList.map Cfg.Node.get_id (Cfg.Node.get_preds node)) + (IList.map Cfg.Node.get_id (Cfg.Node.get_succs node)) + (IList.map Cfg.Node.get_id (Cfg.Node.get_exn node)) (is_visited node) false fmt (Cfg.Node.get_id node)) preds; F.fprintf fmt "
SUCCS: @\n"; - list_iter (fun node -> Io_infer.Html.pp_node_link [".."] "" - (list_map Cfg.Node.get_id (Cfg.Node.get_preds node)) - (list_map Cfg.Node.get_id (Cfg.Node.get_succs node)) - (list_map Cfg.Node.get_id (Cfg.Node.get_exn node)) + IList.iter (fun node -> Io_infer.Html.pp_node_link [".."] "" + (IList.map Cfg.Node.get_id (Cfg.Node.get_preds node)) + (IList.map Cfg.Node.get_id (Cfg.Node.get_succs node)) + (IList.map Cfg.Node.get_id (Cfg.Node.get_exn node)) (is_visited node) false fmt (Cfg.Node.get_id node)) succs; F.fprintf fmt "
EXN: @\n"; - list_iter (fun node -> Io_infer.Html.pp_node_link [".."] "" - (list_map Cfg.Node.get_id (Cfg.Node.get_preds node)) - (list_map Cfg.Node.get_id (Cfg.Node.get_succs node)) - (list_map Cfg.Node.get_id (Cfg.Node.get_exn node)) + IList.iter (fun node -> Io_infer.Html.pp_node_link [".."] "" + (IList.map Cfg.Node.get_id (Cfg.Node.get_preds node)) + (IList.map Cfg.Node.get_id (Cfg.Node.get_succs node)) + (IList.map Cfg.Node.get_id (Cfg.Node.get_exn node)) (is_visited node) false fmt (Cfg.Node.get_id node)) exn; F.fprintf fmt "
@\n"; F.pp_print_flush fmt (); @@ -230,7 +230,7 @@ let () = L.printer_hook := force_delayed_print let force_delayed_prints () = Config.forcing_delayed_prints := true; F.fprintf !html_formatter "@?"; (* flush html stream *) - list_iter (force_delayed_print !html_formatter) (list_rev (L.get_delayed_prints ())); + IList.iter (force_delayed_print !html_formatter) (IList.rev (L.get_delayed_prints ())); F.fprintf !html_formatter "@?"; L.reset_delayed_prints (); Config.forcing_delayed_prints := false @@ -262,19 +262,19 @@ let finish_session node = let _proc_write_log whole_seconds cfg pname = match Cfg.Procdesc.find_from_name cfg pname with | Some pdesc -> - let nodes = list_sort Cfg.Node.compare (Cfg.Procdesc.get_nodes pdesc) in - let linenum = (Cfg.Node.get_loc (list_hd nodes)).Location.line in + let nodes = IList.sort Cfg.Node.compare (Cfg.Procdesc.get_nodes pdesc) in + let linenum = (Cfg.Node.get_loc (IList.hd nodes)).Location.line in let fd, fmt = Io_infer.Html.create DB.Results_dir.Abs_source_dir [Procname.to_filename pname] in F.fprintf fmt "

Procedure %a

@\n" (Io_infer.Html.pp_line_link ~text: (Some (Escape.escape_xml (Procname.to_string pname))) []) linenum; - list_iter + IList.iter (fun n -> Io_infer.Html.pp_node_link [] (Cfg.Node.get_description (pe_html Black) n) - (list_map Cfg.Node.get_id (Cfg.Node.get_preds n)) - (list_map Cfg.Node.get_id (Cfg.Node.get_succs n)) - (list_map Cfg.Node.get_id (Cfg.Node.get_exn n)) + (IList.map Cfg.Node.get_id (Cfg.Node.get_preds n)) + (IList.map Cfg.Node.get_id (Cfg.Node.get_succs n)) + (IList.map Cfg.Node.get_id (Cfg.Node.get_exn n)) (is_visited n) false fmt (Cfg.Node.get_id n)) nodes; (match Specs.get_summary pname with @@ -345,7 +345,7 @@ end = struct assert false (* execution never reaches here *) with End_of_file -> (close_in cin; - Array.of_list (list_rev !lines)) + Array.of_list (IList.rev !lines)) let file_data (hash: t) fname = try @@ -393,11 +393,11 @@ let c_file_write_html proc_is_active linereader fname tenv cfg = Cfg.Procdesc.is_defined proc_desc && (DB.source_file_equal proc_loc.Location.file !DB.current_source) then begin - list_iter process_node (Cfg.Procdesc.get_nodes proc_desc); + IList.iter process_node (Cfg.Procdesc.get_nodes proc_desc); match Specs.get_summary proc_name with | None -> () | Some summary -> - list_iter + IList.iter (fun sp -> proof_cover := Specs.Visitedset.union sp.Specs.visited !proof_cover) (Specs.get_specs_from_payload summary); Errlog.update global_err_log summary.Specs.attributes.ProcAttributes.err_log @@ -427,17 +427,17 @@ let c_file_write_html proc_is_active linereader fname tenv cfg = let str = "" ^ linenum_str ^ "" ^ line_html in F.fprintf fmt "%s" str; - list_iter (fun n -> + IList.iter (fun n -> let isproof = Specs.Visitedset.mem (Cfg.Node.get_id n, []) !proof_cover in - Io_infer.Html.pp_node_link [fname_encoding] (Cfg.Node.get_description (pe_html Black) n) (list_map Cfg.Node.get_id (Cfg.Node.get_preds n)) (list_map Cfg.Node.get_id (Cfg.Node.get_succs n)) (list_map Cfg.Node.get_id (Cfg.Node.get_exn n)) (is_visited n) isproof fmt (Cfg.Node.get_id n)) nodes_at_linenum; - list_iter (fun n -> match Cfg.Node.get_kind n with + Io_infer.Html.pp_node_link [fname_encoding] (Cfg.Node.get_description (pe_html Black) n) (IList.map Cfg.Node.get_id (Cfg.Node.get_preds n)) (IList.map Cfg.Node.get_id (Cfg.Node.get_succs n)) (IList.map Cfg.Node.get_id (Cfg.Node.get_exn n)) (is_visited n) isproof fmt (Cfg.Node.get_id n)) nodes_at_linenum; + IList.iter (fun n -> match Cfg.Node.get_kind n with | Cfg.Node.Start_node proc_desc -> let proc_name = Cfg.Procdesc.get_proc_name proc_desc in - let num_specs = list_length (Specs.get_specs proc_name) in + let num_specs = IList.length (Specs.get_specs proc_name) in let label = (Escape.escape_xml (Procname.to_string proc_name)) ^ ": " ^ (string_of_int num_specs) ^ " specs" in Io_infer.Html.pp_proc_link [fname_encoding] proc_name fmt label | _ -> ()) nodes_at_linenum; - list_iter (fun err_string -> F.fprintf fmt "%s" (create_err_message err_string)) errors_at_linenum; + IList.iter (fun err_string -> F.fprintf fmt "%s" (create_err_message err_string)) errors_at_linenum; F.fprintf fmt "%s" "\n" done with End_of_file -> diff --git a/infer/src/backend/procname.ml b/infer/src/backend/procname.ml index 8f7717bf4..f7102a853 100644 --- a/infer/src/backend/procname.ml +++ b/infer/src/backend/procname.ml @@ -217,7 +217,7 @@ let java_get_class_components proc_name = (** Return the class name of a java procedure name. *) let java_get_simple_class proc_name = - list_hd (list_rev (java_get_class_components proc_name)) + IList.hd (IList.rev (java_get_class_components proc_name)) (** Return the method of a java procname. *) let java_get_method = function @@ -248,7 +248,7 @@ let java_get_return_type = function (** Return the parameters of a java procname. *) let java_get_parameters = function - | JAVA j -> list_map (fun param -> java_type_to_string param VERBOSE) j.parameters + | JAVA j -> IList.map (fun param -> java_type_to_string param VERBOSE) j.parameters | _ -> assert false (** Return true if the java procedure is static *) @@ -305,10 +305,10 @@ let java_is_anonymous_inner_class = function with an extra parameter and calls the normal constructor. *) let java_remove_hidden_inner_class_parameter = function | JAVA js -> - (match list_rev js.parameters with + (match IList.rev js.parameters with | (so, s) :: par' -> if is_anonymous_inner_class_name s - then Some (JAVA { js with parameters = list_rev par'}) + then Some (JAVA { js with parameters = IList.rev par'}) else None | [] -> None) | _ -> None @@ -337,7 +337,7 @@ let java_is_access_method = function let java_is_vararg = function | JAVA js -> begin - match (list_rev js.parameters) with + match (IList.rev js.parameters) with | (_,"java.lang.Object[]") :: _ -> true | _ -> false end diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index 32e984cdb..6e4ce293a 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -137,7 +137,7 @@ let pp_hpred_stackvar pe0 env f hpred = (** Pretty print a substitution. *) let pp_sub pe f sub = - let pi_sub = list_map (fun (id, e) -> Sil.Aeq(Sil.Var id, e)) (Sil.sub_to_list sub) in + let pi_sub = IList.map (fun (id, e) -> Sil.Aeq(Sil.Var id, e)) (Sil.sub_to_list sub) in (pp_semicolon_seq_oneline pe (Sil.pp_atom pe)) f pi_sub (** Dump a substitution. *) @@ -178,13 +178,13 @@ let sigma_get_stack_nonstack only_local_vars sigma = let hpred_is_stack_var = function | Sil.Hpointsto (Sil.Lvar pvar, _, _) -> not only_local_vars || Sil.pvar_is_local pvar | _ -> false in - list_partition hpred_is_stack_var sigma + IList.partition hpred_is_stack_var sigma (** Pretty print a sigma in simple mode. *) let pp_sigma_simple pe env fmt sigma = let sigma_stack, sigma_nonstack = sigma_get_stack_nonstack false sigma in let pp_stack fmt _sg = - let sg = list_sort Sil.hpred_compare _sg in + let sg = IList.sort Sil.hpred_compare _sg in if sg != [] then Format.fprintf fmt "%a" (pp_semicolon_seq pe (pp_hpred_stackvar pe env)) sg in let pp_nl fmt doit = if doit then (match pe.pe_kind with @@ -210,7 +210,7 @@ let get_pi (p: 'a t) : Sil.atom list = p.pi (** Return the pure part of [prop]. *) let get_pure (p: 'a t) : Sil.atom list = - list_map (fun (id1, e2) -> Sil.Aeq (Sil.Var id1, e2)) (Sil.sub_to_list p.sub) @ p.pi + IList.map (fun (id1, e2) -> Sil.Aeq (Sil.Var id1, e2)) (Sil.sub_to_list p.sub) @ p.pi (** Print existential quantification *) let pp_evars pe f evars = @@ -246,10 +246,10 @@ let create_pvar_env (sigma: Sil.hpred list) : (Sil.exp -> Sil.exp) = | Sil.Hpointsto (Sil.Lvar pvar, Sil.Eexp (Sil.Var v, inst), _) -> if not (Sil.pvar_is_global pvar) then env := (Sil.Var v, Sil.Lvar pvar) :: !env | _ -> () in - list_iter filter sigma; + IList.iter filter sigma; let find e = try - snd (list_find (fun (e1, e2) -> Sil.exp_equal e1 e) !env) + snd (IList.find (fun (e1, e2) -> Sil.exp_equal e1 e) !env) with Not_found -> e in find @@ -273,8 +273,8 @@ let pp_footprint_simple _pe env f fp = (** Create a predicate environment for a prop *) let prop_pred_env prop = let env = Sil.Predicates.empty_env () in - list_iter (Sil.Predicates.process_hpred env) prop.sigma; - list_iter (Sil.Predicates.process_hpred env) prop.foot_sigma; + IList.iter (Sil.Predicates.process_hpred env) prop.sigma; + IList.iter (Sil.Predicates.process_hpred env) prop.foot_sigma; env (** Pretty print a proposition. *) @@ -339,13 +339,13 @@ let d_proplist_with_typ (pl: 'a t list) = (** {1 Functions for computing free non-program variables} *) let pi_fav_add fav pi = - list_iter (Sil.atom_fav_add fav) pi + IList.iter (Sil.atom_fav_add fav) pi let pi_fav = Sil.fav_imperative_to_functional pi_fav_add let sigma_fav_add fav sigma = - list_iter (Sil.hpred_fav_add fav) sigma + IList.iter (Sil.hpred_fav_add fav) sigma let sigma_fav = Sil.fav_imperative_to_functional sigma_fav_add @@ -382,13 +382,13 @@ let hpred_fav_in_pvars_add fav = function | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> () let sigma_fav_in_pvars_add fav sigma = - list_iter (hpred_fav_in_pvars_add fav) sigma + IList.iter (hpred_fav_in_pvars_add fav) sigma let sigma_fpv sigma = - list_flatten (list_map Sil.hpred_fpv sigma) + IList.flatten (IList.map Sil.hpred_fpv sigma) let pi_fpv pi = - list_flatten (list_map Sil.atom_fpv pi) + IList.flatten (IList.map Sil.atom_fpv pi) let prop_fpv prop = (Sil.sub_fpv prop.sub) @ @@ -400,10 +400,10 @@ let prop_fpv prop = (** {1 Functions for computing free or bound non-program variables} *) let pi_av_add fav pi = - list_iter (Sil.atom_av_add fav) pi + IList.iter (Sil.atom_av_add fav) pi let sigma_av_add fav sigma = - list_iter (Sil.hpred_av_add fav) sigma + IList.iter (Sil.hpred_av_add fav) sigma let prop_av_add fav prop = Sil.sub_av_add fav prop.sub; @@ -419,11 +419,11 @@ let prop_av = let pi_sub (subst: Sil.subst) pi = let f = Sil.atom_sub subst in - list_map f pi + IList.map f pi let sigma_sub subst sigma = let f = Sil.hpred_sub subst in - list_map f sigma + IList.map f sigma (** {2 Functions for normalization} *) @@ -458,7 +458,7 @@ let sym_eval abs e = | Sil.Var _ -> e | Sil.Const (Sil.Ctuple el) -> - Sil.Const (Sil.Ctuple (list_map eval el)) + Sil.Const (Sil.Ctuple (IList.map eval el)) | Sil.Const _ -> e | Sil.Sizeof (Sil.Tarray (Sil.Tint ik, e), _) @@ -599,11 +599,11 @@ let sym_eval abs e = turn it into struct s { ... t arr[n + k] ... } *) let e1' = eval e1 in let e2' = eval e2 in - (match list_rev ftal, e2' with + (match IList.rev ftal, e2' with (fname, Sil.Tarray(typ, size), _):: ltfa, Sil.BinOp(Sil.Mult, num_elem, Sil.Sizeof (texp, st)) when ftal != [] && Sil.typ_equal typ texp -> let size' = Sil.BinOp(Sil.PlusA, size, num_elem) in let ltfa' = (fname, Sil.Tarray(typ, size'), Sil.item_annotation_empty) :: ltfa in - Sil.Sizeof(Sil.Tstruct (list_rev ltfa', sftal, csu, name_opt, supers, def_mthds, iann), st) + Sil.Sizeof(Sil.Tstruct (IList.rev ltfa', sftal, csu, name_opt, supers, def_mthds, iann), st) | _ -> Sil.BinOp(Sil.PlusA, e1', e2')) | Sil.BinOp (Sil.PlusA as oplus, e1, e2) | Sil.BinOp (Sil.PlusPI as oplus, e1, e2) -> @@ -845,7 +845,7 @@ and typ_normalize sub typ = match typ with | Sil.Tptr (t', pk) -> Sil.Tptr (typ_normalize sub t', pk) | Sil.Tstruct (ftal, sftal, csu, nameo, supers, def_mthds, iann) -> - let fld_norm = list_map (fun (f, t, a) -> (f, typ_normalize sub t, a)) in + let fld_norm = IList.map (fun (f, t, a) -> (f, typ_normalize sub t, a)) in Sil.Tstruct (fld_norm ftal, fld_norm sftal, csu, nameo, supers, def_mthds, iann) | Sil.Tarray (t, e) -> Sil.Tarray (typ_normalize sub t, exp_normalize sub e) @@ -958,15 +958,15 @@ let inequality_normalize a = | _ -> [e],[], Sil.Int.zero in (** sort and filter out expressions appearing in both the positive and negative part *) let normalize_posnegoff (pos, neg, off) = - let pos' = list_sort Sil.exp_compare pos in - let neg' = list_sort Sil.exp_compare neg in + let pos' = IList.sort Sil.exp_compare pos in + let neg' = IList.sort Sil.exp_compare neg in let rec combine pacc nacc = function | x:: ps, y:: ng -> (match Sil.exp_compare x y with | n when n < 0 -> combine (x:: pacc) nacc (ps, y :: ng) | 0 -> combine pacc nacc (ps, ng) | _ -> combine pacc (y:: nacc) (x :: ps, ng)) - | ps, ng -> (list_rev pacc) @ ps, (list_rev nacc) @ ng in + | ps, ng -> (IList.rev pacc) @ ps, (IList.rev nacc) @ ng in let pos'', neg'' = combine [] [] (pos', neg') in (pos'', neg'', off) in (** turn a non-empty list of expressions into a sum expression *) @@ -1072,9 +1072,9 @@ let rec strexp_normalize sub se = | [] -> se | _ -> let fld_cnts' = - list_map (fun (fld, cnt) -> + IList.map (fun (fld, cnt) -> fld, strexp_normalize sub cnt) fld_cnts in - let fld_cnts'' = list_sort Sil.fld_strexp_compare fld_cnts' in + let fld_cnts'' = IList.sort Sil.fld_strexp_compare fld_cnts' in Sil.Estruct (fld_cnts'', inst) end | Sil.Earray (size, idx_cnts, inst) -> @@ -1085,11 +1085,11 @@ let rec strexp_normalize sub se = if Sil.exp_equal size size' then se else Sil.Earray (size', idx_cnts, inst) | _ -> let idx_cnts' = - list_map (fun (idx, cnt) -> + IList.map (fun (idx, cnt) -> let idx' = exp_normalize sub idx in idx', strexp_normalize sub cnt) idx_cnts in let idx_cnts'' = - list_sort Sil.exp_strexp_compare idx_cnts' in + IList.sort Sil.exp_strexp_compare idx_cnts' in Sil.Earray (size', idx_cnts'', inst) end @@ -1120,7 +1120,7 @@ let rec create_strexp_of_type tenvo struct_init_mode typ inst = (fld, Sil.Eexp (Sil.exp_one, inst)) else (fld, create_strexp_of_type tenvo struct_init_mode t inst) in - Sil.Estruct (list_map f ftal, inst) + Sil.Estruct (IList.map f ftal, inst) end | Sil.Tarray (_, size) -> Sil.Earray (size, [], inst) @@ -1191,7 +1191,7 @@ let rec hpred_normalize sub hpred = | Sil.Hlseg (k, para, e1, e2, elist) -> let normalized_e1 = exp_normalize sub e1 in let normalized_e2 = exp_normalize sub e2 in - let normalized_elist = list_map (exp_normalize sub) elist in + let normalized_elist = IList.map (exp_normalize sub) elist in let normalized_para = hpara_normalize sub para in Sil.Hlseg (k, normalized_para, normalized_e1, normalized_e2, normalized_elist) | Sil.Hdllseg (k, para, e1, e2, e3, e4, elist) -> @@ -1199,40 +1199,40 @@ let rec hpred_normalize sub hpred = let norm_e2 = exp_normalize sub e2 in let norm_e3 = exp_normalize sub e3 in let norm_e4 = exp_normalize sub e4 in - let norm_elist = list_map (exp_normalize sub) elist in + let norm_elist = IList.map (exp_normalize sub) elist in let norm_para = hpara_dll_normalize sub para in Sil.Hdllseg (k, norm_para, norm_e1, norm_e2, norm_e3, norm_e4, norm_elist) and hpara_normalize sub para = - let normalized_body = list_map (hpred_normalize Sil.sub_empty) (para.Sil.body) in - let sorted_body = list_sort Sil.hpred_compare normalized_body in + let normalized_body = IList.map (hpred_normalize Sil.sub_empty) (para.Sil.body) in + let sorted_body = IList.sort Sil.hpred_compare normalized_body in { para with Sil.body = sorted_body } and hpara_dll_normalize sub para = - let normalized_body = list_map (hpred_normalize Sil.sub_empty) (para.Sil.body_dll) in - let sorted_body = list_sort Sil.hpred_compare normalized_body in + let normalized_body = IList.map (hpred_normalize Sil.sub_empty) (para.Sil.body_dll) in + let sorted_body = IList.sort Sil.hpred_compare normalized_body in { para with Sil.body_dll = sorted_body } let pi_tighten_ineq pi = - let ineq_list, nonineq_list = list_partition atom_is_inequality pi in + let ineq_list, nonineq_list = IList.partition atom_is_inequality pi in let diseq_list = let get_disequality_info acc = function | Sil.Aneq(Sil.Const (Sil.Cint n), e) | Sil.Aneq(e, Sil.Const (Sil.Cint n)) -> (e, n):: acc | _ -> acc in - list_fold_left get_disequality_info [] nonineq_list in + IList.fold_left get_disequality_info [] nonineq_list in let is_neq e n = - list_exists (fun (e', n') -> Sil.exp_equal e e' && Sil.Int.eq n n') diseq_list in + IList.exists (fun (e', n') -> Sil.exp_equal e e' && Sil.Int.eq n n') diseq_list in let le_list_tightened = let get_le_inequality_info acc a = match atom_exp_le_const a with | Some (e, n) -> (e, n):: acc | _ -> acc in let rec le_tighten le_list_done = function - | [] -> list_rev le_list_done + | [] -> IList.rev le_list_done | (e, n):: le_list_todo -> (* e <= n *) if is_neq e n then le_tighten le_list_done ((e, n -- Sil.Int.one):: le_list_todo) else le_tighten ((e, n):: le_list_done) (le_list_todo) in - let le_list = list_rev (list_fold_left get_le_inequality_info [] ineq_list) in + let le_list = IList.rev (IList.fold_left get_le_inequality_info [] ineq_list) in le_tighten [] le_list in let lt_list_tightened = let get_lt_inequality_info acc a = @@ -1240,29 +1240,29 @@ let pi_tighten_ineq pi = | Some (n, e) -> (n, e):: acc | _ -> acc in let rec lt_tighten lt_list_done = function - | [] -> list_rev lt_list_done + | [] -> IList.rev lt_list_done | (n, e):: lt_list_todo -> (* n < e *) let n_plus_one = n ++ Sil.Int.one in if is_neq e n_plus_one then lt_tighten lt_list_done ((n ++ Sil.Int.one, e):: lt_list_todo) else lt_tighten ((n, e):: lt_list_done) (lt_list_todo) in - let lt_list = list_rev (list_fold_left get_lt_inequality_info [] ineq_list) in + let lt_list = IList.rev (IList.fold_left get_lt_inequality_info [] ineq_list) in lt_tighten [] lt_list in let ineq_list' = let le_ineq_list = - list_map + IList.map (fun (e, n) -> mk_inequality (Sil.BinOp(Sil.Le, e, Sil.exp_int n))) le_list_tightened in let lt_ineq_list = - list_map + IList.map (fun (n, e) -> mk_inequality (Sil.BinOp(Sil.Lt, Sil.exp_int n, e))) lt_list_tightened in le_ineq_list @ lt_ineq_list in let nonineq_list' = - list_filter + IList.filter (function | Sil.Aneq(Sil.Const (Sil.Cint n), e) | Sil.Aneq(e, Sil.Const (Sil.Cint n)) -> - (not (list_exists (fun (e', n') -> Sil.exp_equal e e' && Sil.Int.lt n' n) le_list_tightened)) && - (not (list_exists (fun (n', e') -> Sil.exp_equal e e' && Sil.Int.leq n n') lt_list_tightened)) + (not (IList.exists (fun (e', n') -> Sil.exp_equal e e' && Sil.Int.lt n' n) le_list_tightened)) && + (not (IList.exists (fun (n', e') -> Sil.exp_equal e e' && Sil.Int.leq n n') lt_list_tightened)) | _ -> true) nonineq_list in (ineq_list', nonineq_list') @@ -1290,13 +1290,13 @@ let sigma_get_unsigned_exps sigma = | Sil.Hpointsto(_, Sil.Eexp(e, _), Sil.Sizeof (Sil.Tint ik, _)) when Sil.ikind_is_unsigned ik -> uexps := e :: !uexps | _ -> () in - list_iter do_hpred sigma; + IList.iter do_hpred sigma; !uexps (** Normalization of pi. The normalization filters out obviously - true disequalities, such as e <> e + 1. *) let pi_normalize sub sigma pi0 = - let pi = list_map (atom_normalize sub) pi0 in + let pi = IList.map (atom_normalize sub) pi0 in let ineq_list, nonineq_list = pi_tighten_ineq pi in let syntactically_different = function | Sil.BinOp(op1, e1, Sil.Const(c1)), Sil.BinOp(op2, e2, Sil.Const(c2)) @@ -1313,19 +1313,19 @@ let pi_normalize sub sigma pi0 = let unsigned_exps = lazy (sigma_get_unsigned_exps sigma) in function | Sil.Aneq ((Sil.Var _) as e, Sil.Const (Sil.Cint n)) when Sil.Int.isnegative n -> - not (list_exists (Sil.exp_equal e) (Lazy.force unsigned_exps)) + not (IList.exists (Sil.exp_equal e) (Lazy.force unsigned_exps)) | Sil.Aneq(e1, e2) -> not (syntactically_different (e1, e2)) | Sil.Aeq(Sil.Const c1, Sil.Const c2) -> not (Sil.const_equal c1 c2) | a -> true in - let pi' = list_stable_sort Sil.atom_compare ((list_filter filter_useful_atom nonineq_list) @ ineq_list) in + let pi' = IList.stable_sort Sil.atom_compare ((IList.filter filter_useful_atom nonineq_list) @ ineq_list) in let pi'' = pi_sorted_remove_redundant pi' in if pi_equal pi0 pi'' then pi0 else pi'' let sigma_normalize sub sigma = let sigma' = - list_stable_sort Sil.hpred_compare (list_map (hpred_normalize sub) sigma) in + IList.stable_sort Sil.hpred_compare (IList.map (hpred_normalize sub) sigma) in if sigma_equal sigma sigma' then sigma else sigma' (** normalize the footprint part, and rename any primed vars in the footprint with fresh footprint vars *) @@ -1350,8 +1350,8 @@ let footprint_normalize prop = else (* replace primed vars by fresh footprint vars *) let ids_primed = Sil.fav_to_list fp_vars in let ids_footprint = - list_map (fun id -> (id, Ident.create_fresh Ident.kfootprint)) ids_primed in - let ren_sub = Sil.sub_of_list (list_map (fun (id1, id2) -> (id1, Sil.Var id2)) ids_footprint) in + IList.map (fun id -> (id, Ident.create_fresh Ident.kfootprint)) ids_primed in + let ren_sub = Sil.sub_of_list (IList.map (fun (id1, id2) -> (id1, Sil.Var id2)) ids_footprint) in let nsigma' = sigma_normalize Sil.sub_empty (sigma_sub ren_sub nsigma) in let npi' = pi_normalize Sil.sub_empty nsigma' (pi_sub ren_sub npi) in (npi', nsigma') in @@ -1366,7 +1366,7 @@ let lexp_normalize_prop p lexp = let offsets = Sil.exp_get_offsets lexp in let nroot = exp_normalize_prop p root in let noffsets = - list_map (fun n -> match n with + IList.map (fun n -> match n with | Sil.Off_fld _ -> n | Sil.Off_index e -> Sil.Off_index (exp_normalize_prop p e) ) offsets in @@ -1416,7 +1416,7 @@ let pi_normalize_prop prop pi = (** {2 Compaction} *) (** Return a compact representation of the prop *) let prop_compact sh prop = - let sigma' = list_map (Sil.hpred_compact sh) prop.sigma in + let sigma' = IList.map (Sil.hpred_compact sh) prop.sigma in { prop with sigma = sigma'} (** {2 Function for replacing occurrences of expressions.} *) @@ -1440,11 +1440,11 @@ let replace_pi_footprint pi (prop : 'a t) : exposed t = { prop with foot_pi = pi } let sigma_replace_exp epairs sigma = - let sigma' = list_map (Sil.hpred_replace_exp epairs) sigma in + let sigma' = IList.map (Sil.hpred_replace_exp epairs) sigma in sigma_normalize Sil.sub_empty sigma' let sigma_map prop f = - let sigma' = list_map f prop.sigma in + let sigma' = IList.map f prop.sigma in { prop with sigma = sigma' } (** {2 Query about Proposition} *) @@ -1524,19 +1524,19 @@ let strexp_get_exps strexp = | Sil.Eexp (Sil.Const (Sil.Cexn e), _) -> Sil.ExpSet.add e exps | Sil.Eexp (e, _) -> Sil.ExpSet.add e exps | Sil.Estruct (flds, _) -> - list_fold_left (fun exps (_, strexp) -> strexp_get_exps_rec exps strexp) exps flds + IList.fold_left (fun exps (_, strexp) -> strexp_get_exps_rec exps strexp) exps flds | Sil.Earray (_, elems, _) -> - list_fold_left (fun exps (_, strexp) -> strexp_get_exps_rec exps strexp) exps elems in + IList.fold_left (fun exps (_, strexp) -> strexp_get_exps_rec exps strexp) exps elems in strexp_get_exps_rec Sil.ExpSet.empty strexp (** get the set of expressions on the righthand side of [hpred] *) let hpred_get_targets = function | Sil.Hpointsto (_, rhs, _) -> strexp_get_exps rhs | Sil.Hlseg (_, _, _, e, el) -> - list_fold_left (fun exps e -> Sil.ExpSet.add e exps) Sil.ExpSet.empty (e :: el) + IList.fold_left (fun exps e -> Sil.ExpSet.add e exps) Sil.ExpSet.empty (e :: el) | Sil.Hdllseg (_, _, _, oB, oF, iB, el) -> (* only one direction supported for now *) - list_fold_left (fun exps e -> Sil.ExpSet.add e exps) Sil.ExpSet.empty (oB :: oF :: iB :: el) + IList.fold_left (fun exps e -> Sil.ExpSet.add e exps) Sil.ExpSet.empty (oB :: oF :: iB :: el) (** return the set of hpred's and exp's in [sigma] that are reachable from an expression in [exps] *) @@ -1548,7 +1548,7 @@ let compute_reachable_hpreds sigma exps = let reach_exps = hpred_get_targets hpred in (reach', Sil.ExpSet.union exps reach_exps) | _ -> reach, exps in - let reach', exps' = list_fold_left add_hpred_if_reachable (reach, exps) sigma in + let reach', exps' = IList.fold_left add_hpred_if_reachable (reach, exps) sigma in if (Sil.HpredSet.cardinal reach) = (Sil.HpredSet.cardinal reach') then (reach, exps) else compute_reachable_hpreds_rec sigma (reach', exps') in compute_reachable_hpreds_rec sigma (Sil.HpredSet.empty, exps) @@ -1560,7 +1560,7 @@ let compute_reachable_atoms pi exps = | Sil.UnOp (_, e, _) | Sil.Cast (_, e) | Sil.Lfield (e, _, _) -> exp_contains e | Sil.BinOp (_, e0, e1) | Sil.Lindex (e0, e1) -> exp_contains e0 || exp_contains e1 | _ -> false in - list_filter + IList.filter (function | Sil.Aeq (lhs, rhs) | Sil.Aneq (lhs, rhs) -> exp_contains lhs || exp_contains rhs) pi @@ -1587,7 +1587,7 @@ let sigma_remove_emptylseg sigma = in let rec f eqs_zero sigma_passed = function | [] -> - (list_rev eqs_zero, list_rev sigma_passed) + (IList.rev eqs_zero, IList.rev sigma_passed) | Sil.Hpointsto _ as hpred :: sigma' -> f eqs_zero (hpred :: sigma_passed) sigma' | Sil.Hlseg (Sil.Lseg_PE, _, e1, e2, _) :: sigma' @@ -1607,7 +1607,7 @@ let sigma_remove_emptylseg sigma = let sigma_intro_nonemptylseg e1 e2 sigma = let rec f sigma_passed = function | [] -> - list_rev sigma_passed + IList.rev sigma_passed | Sil.Hpointsto _ as hpred :: sigma' -> f (hpred :: sigma_passed) sigma' | Sil.Hlseg (Sil.Lseg_PE, para, f1, f2, shared) :: sigma' @@ -1633,12 +1633,12 @@ let normalize_and_strengthen_atom (p : normal t) (a : Sil.atom) : Sil.atom = | Sil.Aeq (Sil.BinOp (Sil.Le, Sil.Var id, Sil.Const (Sil.Cint n)), Sil.Const (Sil.Cint i)) when Sil.Int.isone i -> let lower = Sil.exp_int (n -- Sil.Int.one) in let a_lower = Sil.Aeq (Sil.BinOp (Sil.Lt, lower, Sil.Var id), Sil.exp_one) in - if not (list_mem Sil.atom_equal a_lower p.pi) then a' + if not (IList.mem Sil.atom_equal a_lower p.pi) then a' else Sil.Aeq (Sil.Var id, Sil.exp_int n) | Sil.Aeq (Sil.BinOp (Sil.Lt, Sil.Const (Sil.Cint n), Sil.Var id), Sil.Const (Sil.Cint i)) when Sil.Int.isone i -> let upper = Sil.exp_int (n ++ Sil.Int.one) in let a_upper = Sil.Aeq (Sil.BinOp (Sil.Le, Sil.Var id, upper), Sil.exp_one) in - if not (list_mem Sil.atom_equal a_upper p.pi) then a' + if not (IList.mem Sil.atom_equal a_upper p.pi) then a' else Sil.Aeq (Sil.Var id, upper) | Sil.Aeq (Sil.BinOp (Sil.Ne, e1, e2), Sil.Const (Sil.Cint i)) when Sil.Int.isone i -> Sil.Aneq (e1, e2) @@ -1647,7 +1647,7 @@ let normalize_and_strengthen_atom (p : normal t) (a : Sil.atom) : Sil.atom = (** Conjoin a pure atomic predicate by normal conjunction. *) let rec prop_atom_and ?(footprint = false) (p : normal t) (a : Sil.atom) : normal t = let a' = normalize_and_strengthen_atom p a in - if list_mem Sil.atom_equal a' p.pi then p + if IList.mem Sil.atom_equal a' p.pi then p else begin let p' = match a' with @@ -1662,7 +1662,7 @@ let rec prop_atom_and ?(footprint = false) (p : normal t) (a : Sil.atom) : norma (sub_normalize sub', pi_normalize sub' nsigma' p.pi, nsigma') in let (eqs_zero, nsigma'') = sigma_remove_emptylseg nsigma' in let p' = { p with sub = nsub'; pi = npi'; sigma = nsigma''} in - list_fold_left (prop_atom_and ~footprint) p' eqs_zero + IList.fold_left (prop_atom_and ~footprint) p' eqs_zero | Sil.Aeq (e1, e2) when (Sil.exp_compare e1 e2 = 0) -> p | Sil.Aneq (e1, e2) -> @@ -1722,8 +1722,8 @@ let from_pi_sigma pi sigma = (** Reset every inst in the prop using the given map *) let prop_reset_inst inst_map prop = - let sigma' = list_map (Sil.hpred_instmap inst_map) (get_sigma prop) in - let sigma_fp' = list_map (Sil.hpred_instmap inst_map) (get_sigma_footprint prop) in + let sigma' = IList.map (Sil.hpred_instmap inst_map) (get_sigma prop) in + let sigma_fp' = IList.map (Sil.hpred_instmap inst_map) (get_sigma_footprint prop) in replace_sigma_footprint sigma_fp' (replace_sigma sigma' prop) (** {2 Attributes} *) @@ -1746,7 +1746,7 @@ let get_exp_attributes prop exp = | Sil.Aneq (e, Sil.Const (Sil.Cattribute att)) | Sil.Aneq (Sil.Const (Sil.Cattribute att), e) when Sil.exp_equal e nexp -> att:: attributes | _ -> attributes in - list_fold_left atom_get_attr [] prop.pi + IList.fold_left atom_get_attr [] prop.pi let attributes_in_same_category attr1 attr2 = let cat1 = Sil.attribute_to_category attr1 in @@ -1755,7 +1755,7 @@ let attributes_in_same_category attr1 attr2 = let get_attribute prop exp category = let atts = get_exp_attributes prop exp in - try Some (list_find + try Some (IList.find (fun att -> Sil.attribute_category_equal (Sil.attribute_to_category att) category) @@ -1782,7 +1782,7 @@ let get_div0_attribute prop exp = let has_dangling_uninit_attribute prop exp = let la = get_exp_attributes prop exp in - list_exists (fun a -> Sil.attribute_equal a (Sil.Adangling (Sil.DAuninit))) la + IList.exists (fun a -> Sil.attribute_equal a (Sil.Adangling (Sil.DAuninit))) la (** Get all the attributes of the prop *) let get_all_attributes prop = @@ -1790,8 +1790,8 @@ let get_all_attributes prop = let do_atom a = match atom_get_exp_attribute a with | Some (e, att) -> res := (e, att) :: !res | None -> () in - list_iter do_atom prop.pi; - list_rev !res + IList.iter do_atom prop.pi; + IList.rev !res (** Set an attribute associated to the expression *) let set_exp_attribute prop exp att = @@ -1815,7 +1815,7 @@ let add_or_replace_exp_attribute check_attribute_change prop exp att = end else a | _ -> a in - let pi' = list_map atom_map (get_pi prop) in + let pi' = IList.map atom_map (get_pi prop) in if !found then replace_pi pi' prop else set_exp_attribute prop nexp att @@ -1827,7 +1827,7 @@ let mark_vars_as_undefined prop vars_to_mark callee_pname loc path_pos = match exp with | Sil.Var _ | Sil.Lvar _ -> add_or_replace_exp_attribute do_nothing prop exp att_undef | _ -> prop in - list_fold_left (fun prop id -> mark_var_as_undefined id prop) prop vars_to_mark + IList.fold_left (fun prop id -> mark_var_as_undefined id prop) prop vars_to_mark (** Remove an attribute from all the atoms in the heap *) let remove_attribute att prop = @@ -1838,7 +1838,7 @@ let remove_attribute att prop = pi else atom:: pi | _ -> atom:: pi in - let pi' = list_fold_right atom_remove (get_pi prop) [] in + let pi' = IList.fold_right atom_remove (get_pi prop) [] in replace_pi pi' prop let remove_attribute_from_exp att prop exp = @@ -1850,7 +1850,7 @@ let remove_attribute_from_exp att prop exp = pi else atom:: pi | _ -> atom:: pi in - let pi' = list_fold_right atom_remove (get_pi prop) [] in + let pi' = IList.fold_right atom_remove (get_pi prop) [] in replace_pi pi' prop (* Replace an attribute OBJC_NULL($n1) with OBJC_NULL(var) when var = $n1, and also sets $n1 = 0 *) @@ -1871,7 +1871,7 @@ let get_atoms_with_attribute att prop = e:: autoreleased_atoms else autoreleased_atoms | _ -> autoreleased_atoms in - list_fold_right atom_remove (get_pi prop) [] + IList.fold_right atom_remove (get_pi prop) [] (** Apply f to every resource attribute in the prop *) let attribute_map_resource prop f = @@ -1887,7 +1887,7 @@ let attribute_map_resource prop f = let e1, e2 = exp_reorder e (Sil.Const (Sil.Cattribute att')) in Sil.Aneq (e1, e2) | _ -> a in - let pi' = list_map atom_map pi in + let pi' = IList.map atom_map pi in replace_pi pi' prop (** if [atom] represents an attribute [att], add the attribure to [prop] *) @@ -1928,7 +1928,7 @@ let find_arithmetic_problem proc_node_session prop exp = | Sil.Lindex (e1, e2) -> walk e1; walk e2 | Sil.Sizeof _ -> () in walk exp; - try Some (Div0 (list_find check_zero !exps_divided)), !res + try Some (Div0 (IList.find check_zero !exps_divided)), !res with Not_found -> (match !uminus_unsigned with | (e, t):: _ -> Some (UminusUnsigned (e, t)), !res @@ -1939,19 +1939,19 @@ let find_arithmetic_problem proc_node_session prop exp = let deallocate_stack_vars p pvars = let filter = function | Sil.Hpointsto (Sil.Lvar v, _, _) -> - list_exists (Sil.pvar_equal v) pvars + IList.exists (Sil.pvar_equal v) pvars | _ -> false in - let sigma_stack, sigma_other = list_partition filter p.sigma in + let sigma_stack, sigma_other = IList.partition filter p.sigma in let fresh_address_vars = ref [] in (* fresh vars substituted for the address of stack vars *) let stack_vars_address_in_post = ref [] in (* stack vars whose address is still present *) - let exp_replace = list_map (function + let exp_replace = IList.map (function | Sil.Hpointsto (Sil.Lvar v, _, _) -> let freshv = Ident.create_fresh Ident.kprimed in fresh_address_vars := (v, freshv) :: !fresh_address_vars; (Sil.Lvar v, Sil.Var freshv) | _ -> assert false) sigma_stack in - let pi1 = list_map (fun (id, e) -> Sil.Aeq (Sil.Var id, e)) (Sil.sub_to_list p.sub) in - let pi = list_map (Sil.atom_replace_exp exp_replace) (p.pi @ pi1) in + let pi1 = IList.map (fun (id, e) -> Sil.Aeq (Sil.Var id, e)) (Sil.sub_to_list p.sub) in + let pi = IList.map (Sil.atom_replace_exp exp_replace) (p.pi @ pi1) in let p' = { p with sub = Sil.sub_empty; pi = []; sigma = sigma_replace_exp exp_replace sigma_other } in let p'' = let res = ref p' in @@ -1963,9 +1963,9 @@ let deallocate_stack_vars p pvars = let check_attribute_change att_old att_new = () in res := add_or_replace_exp_attribute check_attribute_change !res (Sil.Var freshv) (Sil.Adangling Sil.DAaddr_stack_var) end in - list_iter do_var !fresh_address_vars; + IList.iter do_var !fresh_address_vars; !res in - !stack_vars_address_in_post, list_fold_left prop_atom_and p'' pi + !stack_vars_address_in_post, IList.fold_left prop_atom_and p'' pi (** {1 Functions for transforming footprints into propositions.} *) @@ -1986,7 +1986,7 @@ let extract_spec p = (** [prop_set_fooprint p p_foot] sets proposition [p_foot] as footprint of [p]. *) let prop_set_footprint p p_foot = - let pi = (list_map (fun (i, e) -> Sil.Aeq(Sil.Var i, e)) (Sil.sub_to_list p_foot.sub)) @ p_foot.pi in + let pi = (IList.map (fun (i, e) -> Sil.Aeq(Sil.Var i, e)) (Sil.sub_to_list p_foot.sub)) @ p_foot.pi in { p with foot_pi = pi; foot_sigma = p_foot.sigma } (** {2 Functions for renaming primed variables by "canonical names"} *) @@ -2001,7 +2001,7 @@ end = struct let stack = Stack.create () let init es = Stack.clear stack; - list_iter (fun e -> Stack.push e stack) (list_rev es) + IList.iter (fun e -> Stack.push e stack) (IList.rev es) let final () = Stack.clear stack let is_empty () = Stack.is_empty stack let push e = Stack.push e stack @@ -2012,7 +2012,7 @@ let sigma_get_start_lexps_sort sigma = let exp_compare_neg e1 e2 = - (Sil.exp_compare e1 e2) in let filter e = Sil.fav_for_all (Sil.exp_fav e) Ident.is_normal in let lexps = Sil.hpred_list_get_lexps filter sigma in - list_sort exp_compare_neg lexps + IList.sort exp_compare_neg lexps let sigma_dfs_sort sigma = @@ -2025,35 +2025,35 @@ let sigma_dfs_sort sigma = let rec handle_strexp = function | Sil.Eexp (e, inst) -> ExpStack.push e | Sil.Estruct (fld_se_list, inst) -> - list_iter (fun (_, se) -> handle_strexp se) fld_se_list + IList.iter (fun (_, se) -> handle_strexp se) fld_se_list | Sil.Earray (_, idx_se_list, inst) -> - list_iter (fun (_, se) -> handle_strexp se) idx_se_list in + IList.iter (fun (_, se) -> handle_strexp se) idx_se_list in let rec handle_e visited seen e = function - | [] -> (visited, list_rev seen) + | [] -> (visited, IList.rev seen) | hpred :: cur -> begin match hpred with | Sil.Hpointsto (e', se, _) when Sil.exp_equal e e' -> handle_strexp se; - (hpred:: visited, list_rev_append cur seen) + (hpred:: visited, IList.rev_append cur seen) | Sil.Hlseg (_, _, root, next, shared) when Sil.exp_equal e root -> - list_iter ExpStack.push (next:: shared); - (hpred:: visited, list_rev_append cur seen) + IList.iter ExpStack.push (next:: shared); + (hpred:: visited, IList.rev_append cur seen) | Sil.Hdllseg (_, _, iF, oB, oF, iB, shared) when Sil.exp_equal e iF || Sil.exp_equal e iB -> - list_iter ExpStack.push (oB:: oF:: shared); - (hpred:: visited, list_rev_append cur seen) + IList.iter ExpStack.push (oB:: oF:: shared); + (hpred:: visited, IList.rev_append cur seen) | _ -> handle_e visited (hpred:: seen) e cur end in let rec handle_sigma visited = function - | [] -> list_rev visited + | [] -> IList.rev visited | cur -> if ExpStack.is_empty () then let cur' = sigma_normalize Sil.sub_empty cur in - list_rev_append cur' visited + IList.rev_append cur' visited else let e = ExpStack.pop () in let (visited', cur') = handle_e visited [] e cur in @@ -2079,20 +2079,20 @@ let prop_fav_add_dfs fav prop = let rec strexp_get_array_indices acc = function | Sil.Eexp _ -> acc | Sil.Estruct (fsel, inst) -> - let se_list = list_map snd fsel in - list_fold_left strexp_get_array_indices acc se_list + let se_list = IList.map snd fsel in + IList.fold_left strexp_get_array_indices acc se_list | Sil.Earray (size, isel, _) -> - let acc_new = list_fold_left (fun acc' (idx, _) -> idx:: acc') acc isel in - let se_list = list_map snd isel in - list_fold_left strexp_get_array_indices acc_new se_list + let acc_new = IList.fold_left (fun acc' (idx, _) -> idx:: acc') acc isel in + let se_list = IList.map snd isel in + IList.fold_left strexp_get_array_indices acc_new se_list let hpred_get_array_indices acc = function | Sil.Hpointsto (_, se, _) -> strexp_get_array_indices acc se | Sil.Hlseg _ | Sil.Hdllseg _ -> acc let sigma_get_array_indices sigma = - let indices = list_fold_left hpred_get_array_indices [] sigma in - list_rev indices + let indices = IList.fold_left hpred_get_array_indices [] sigma in + IList.rev indices let compute_reindexing fav_add get_id_offset list = let rec select list_passed list_seen = function @@ -2103,8 +2103,8 @@ let compute_reindexing fav_add get_id_offset list = | None -> list_passed | Some (id, _) -> let fav = Sil.fav_new () in - list_iter (fav_add fav) list_seen; - list_iter (fav_add fav) list_passed; + IList.iter (fav_add fav) list_seen; + IList.iter (fav_add fav) list_passed; if (Sil.fav_exists fav (Ident.equal id)) then list_passed else (x:: list_passed) in @@ -2117,7 +2117,7 @@ let compute_reindexing fav_add get_id_offset list = let offset_new = Sil.exp_int (Sil.Int.neg offset) in let exp_new = Sil.BinOp(Sil.PlusA, base_new, offset_new) in (id, exp_new) in - let reindexing = list_map transform list_passed in + let reindexing = IList.map transform list_passed in Sil.sub_of_list reindexing let compute_reindexing_from_indices indices = @@ -2132,16 +2132,16 @@ let apply_reindexing subst prop = let nsigma = sigma_normalize subst prop.sigma in let npi = pi_normalize subst nsigma prop.pi in let nsub, atoms = - let dom_subst = list_map fst (Sil.sub_to_list subst) in - let in_dom_subst id = list_exists (Ident.equal id) dom_subst in + let dom_subst = IList.map fst (Sil.sub_to_list subst) in + let in_dom_subst id = IList.exists (Ident.equal id) dom_subst in let sub' = Sil.sub_filter (fun id -> not (in_dom_subst id)) prop.sub in let contains_substituted_id e = Sil.fav_exists (Sil.exp_fav e) in_dom_subst in let sub_eqs, sub_keep = Sil.sub_range_partition contains_substituted_id sub' in let eqs = Sil.sub_to_list sub_eqs in - let atoms = list_map (fun (id, e) -> Sil.Aeq (Sil.Var id, exp_normalize subst e)) eqs in + let atoms = IList.map (fun (id, e) -> Sil.Aeq (Sil.Var id, exp_normalize subst e)) eqs in (sub_keep, atoms) in let p' = { prop with sub = nsub; pi = npi; sigma = nsigma } in - list_fold_left prop_atom_and p' atoms + IList.fold_left prop_atom_and p' atoms let prop_rename_array_indices prop = if !Config.footprint then prop @@ -2154,11 +2154,11 @@ let prop_rename_array_indices prop = not (Sil.exp_equal e1' e2' && Sil.Int.lt n1' n2') | _ -> true in let rec select_minimal_indices indices_seen = function - | [] -> list_rev indices_seen + | [] -> IList.rev indices_seen | index:: indices_rest -> - let indices_seen' = list_filter (not_same_base_lt_offsets index) indices_seen in + let indices_seen' = IList.filter (not_same_base_lt_offsets index) indices_seen in let indices_seen_new = index:: indices_seen' in - let indices_rest_new = list_filter (not_same_base_lt_offsets index) indices_rest in + let indices_rest_new = IList.filter (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 @@ -2172,8 +2172,8 @@ let rec pp_ren pe f = function let compute_renaming fav = let ids = Sil.fav_to_list fav in - let ids_primed, ids_nonprimed = list_partition Ident.is_primed ids in - let ids_footprint = list_filter Ident.is_footprint ids_nonprimed 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 id_base_primed = Ident.create Ident.kprimed 0 in let id_base_footprint = Ident.create Ident.kfootprint 0 in @@ -2250,13 +2250,13 @@ let rec strexp_captured_ren ren = function Sil.Eexp (exp_captured_ren ren e, inst) | Sil.Estruct (fld_se_list, inst) -> let f (fld, se) = (fld, strexp_captured_ren ren se) in - Sil.Estruct (list_map f fld_se_list, inst) + Sil.Estruct (IList.map f fld_se_list, inst) | Sil.Earray (size, idx_se_list, inst) -> let f (idx, se) = let idx' = exp_captured_ren ren idx in (idx', strexp_captured_ren ren se) in let size' = exp_captured_ren ren size in - Sil.Earray (size', list_map f idx_se_list, inst) + Sil.Earray (size', IList.map f idx_se_list, inst) and hpred_captured_ren ren = function | Sil.Hpointsto (base, se, te) -> @@ -2268,7 +2268,7 @@ and hpred_captured_ren ren = function let para' = hpara_ren para in let e1' = exp_captured_ren ren e1 in let e2' = exp_captured_ren ren e2 in - let elist' = list_map (exp_captured_ren ren) elist in + let elist' = IList.map (exp_captured_ren ren) elist in Sil.Hlseg (k, para', e1', e2', elist') | Sil.Hdllseg (k, para, e1, e2, e3, e4, elist) -> let para' = hpara_dll_ren para in @@ -2276,7 +2276,7 @@ and hpred_captured_ren ren = function let e2' = exp_captured_ren ren e2 in let e3' = exp_captured_ren ren e3 in let e4' = exp_captured_ren ren e4 in - let elist' = list_map (exp_captured_ren ren) elist in + let elist' = IList.map (exp_captured_ren ren) elist in Sil.Hdllseg (k, para', e1', e2', e3', e4', elist') and hpara_ren para = @@ -2284,9 +2284,9 @@ and hpara_ren para = let ren = compute_renaming av in let root' = ident_captured_ren ren para.Sil.root in let next' = ident_captured_ren ren para.Sil.next in - let svars' = list_map (ident_captured_ren ren) para.Sil.svars in - let evars' = list_map (ident_captured_ren ren) para.Sil.evars in - let body' = list_map (hpred_captured_ren ren) para.Sil.body in + let svars' = IList.map (ident_captured_ren ren) para.Sil.svars in + let evars' = IList.map (ident_captured_ren ren) para.Sil.evars in + let body' = IList.map (hpred_captured_ren ren) para.Sil.body in { Sil.root = root'; Sil.next = next'; Sil.svars = svars'; Sil.evars = evars'; Sil.body = body'} and hpara_dll_ren para = @@ -2295,16 +2295,16 @@ and hpara_dll_ren para = let iF = ident_captured_ren ren para.Sil.cell in let oF = ident_captured_ren ren para.Sil.flink in let oB = ident_captured_ren ren para.Sil.blink in - let svars' = list_map (ident_captured_ren ren) para.Sil.svars_dll in - let evars' = list_map (ident_captured_ren ren) para.Sil.evars_dll in - let body' = list_map (hpred_captured_ren ren) para.Sil.body_dll in + let svars' = IList.map (ident_captured_ren ren) para.Sil.svars_dll in + let evars' = IList.map (ident_captured_ren ren) para.Sil.evars_dll in + let body' = IList.map (hpred_captured_ren ren) para.Sil.body_dll in { Sil.cell = iF; Sil.flink = oF; Sil.blink = oB; Sil.svars_dll = svars'; Sil.evars_dll = evars'; Sil.body_dll = body'} let pi_captured_ren ren pi = - list_map (atom_captured_ren ren) pi + IList.map (atom_captured_ren ren) pi let sigma_captured_ren ren sigma = - list_map (hpred_captured_ren ren) sigma + IList.map (hpred_captured_ren ren) sigma let sub_captured_ren ren sub = Sil.sub_map (ident_captured_ren ren) (exp_captured_ren ren) sub @@ -2345,7 +2345,7 @@ let prop_rename_primed_footprint_vars p = (** {2 Functionss for changing and generating propositions} *) let mem_idlist i l = - list_exists (fun id -> Ident.equal i id) l + IList.exists (fun id -> Ident.equal i id) l let id_exp_compare (id1, e1) (id2, e2) = let n = Sil.exp_compare e1 e2 in @@ -2357,12 +2357,12 @@ let expose (p : normal t) : exposed t = Obj.magic p (** normalize a prop *) let normalize (eprop : 'a t) : normal t = let p0 = { prop_emp with sigma = sigma_normalize Sil.sub_empty eprop.sigma } in - let nprop = list_fold_left prop_atom_and p0 (get_pure eprop) in + let nprop = IList.fold_left prop_atom_and p0 (get_pure eprop) in footprint_normalize { nprop with foot_pi = eprop.foot_pi; foot_sigma = eprop.foot_sigma } (** Apply subsitution to prop. *) let prop_sub subst (prop: 'a t) : exposed t = - let pi = pi_sub subst (prop.pi @ list_map (fun (x, e) -> Sil.Aeq (Sil.Var x, e)) (Sil.sub_to_list prop.sub)) in + let pi = pi_sub subst (prop.pi @ IList.map (fun (x, e) -> Sil.Aeq (Sil.Var x, e)) (Sil.sub_to_list prop.sub)) in let sigma = sigma_sub subst prop.sigma in let fp_pi = pi_sub subst prop.foot_pi in let fp_sigma = sigma_sub subst prop.foot_sigma in @@ -2376,10 +2376,10 @@ let prop_ren_sub (ren_sub: Sil.subst) (prop: normal t) : normal t = [ids] should not contain any primed variables. *) let exist_quantify fav prop = let ids = Sil.fav_to_list fav in - if list_exists Ident.is_primed ids then assert false; (* sanity check *) + if IList.exists Ident.is_primed ids then assert false; (* sanity check *) if ids == [] then prop else let gen_fresh_id_sub id = (id, Sil.Var (Ident.create_fresh Ident.kprimed)) in - let ren_sub = Sil.sub_of_list (list_map gen_fresh_id_sub ids) in + let ren_sub = Sil.sub_of_list (IList.map gen_fresh_id_sub ids) in let prop' = let sub = Sil.sub_filter (fun i -> not (mem_idlist i ids)) prop.sub in (** throw away x=E if x becomes _x *) if Sil.sub_equal sub prop.sub then prop @@ -2395,16 +2395,16 @@ let exist_quantify fav prop = (** Apply the substitution [fe] to all the expressions in the prop. *) let prop_expmap (fe: Sil.exp -> Sil.exp) prop = let f (e, sil_opt) = (fe e, sil_opt) in - let pi = list_map (Sil.atom_expmap fe) prop.pi in - let sigma = list_map (Sil.hpred_expmap f) prop.sigma in - let foot_pi = list_map (Sil.atom_expmap fe) prop.foot_pi in - let foot_sigma = list_map (Sil.hpred_expmap f) prop.foot_sigma in + let pi = IList.map (Sil.atom_expmap fe) prop.pi in + let sigma = IList.map (Sil.hpred_expmap f) prop.sigma in + let foot_pi = IList.map (Sil.atom_expmap fe) prop.foot_pi in + let foot_sigma = IList.map (Sil.hpred_expmap f) prop.foot_sigma in { prop with pi = pi; sigma = sigma; foot_pi = foot_pi; foot_sigma = foot_sigma } (** convert identifiers in fav to kind [k] *) let vars_make_unprimed fav prop = let ids = Sil.fav_to_list fav in - let ren_sub = Sil.sub_of_list (list_map (fun i -> (i, Sil.Var (Ident.create_fresh Ident.knormal))) ids) in + let ren_sub = Sil.sub_of_list (IList.map (fun i -> (i, Sil.Var (Ident.create_fresh Ident.knormal))) ids) in prop_ren_sub ren_sub prop (** convert the normal vars to primed vars. *) @@ -2418,10 +2418,10 @@ let prop_rename_primed_fresh (p : normal t) : normal t = let ids_primed = let fav = prop_fav p in let ids = Sil.fav_to_list fav in - list_filter Ident.is_primed ids in + IList.filter Ident.is_primed ids in let ren_sub = let f i = (i, Sil.Var (Ident.create_fresh Ident.kprimed)) in - Sil.sub_of_list (list_map f ids_primed) in + Sil.sub_of_list (IList.map f ids_primed) in prop_ren_sub ren_sub p (** convert the primed vars to normal vars. *) @@ -2442,8 +2442,8 @@ let prop_rename_fav_with_existentials (p : normal t) : normal t = let fav = Sil.fav_new () in prop_fav_add fav p; let ids = Sil.fav_to_list fav in - let ids' = list_map (fun i -> (i, Ident.create_fresh Ident.kprimed)) ids in - let ren_sub = Sil.sub_of_list (list_map (fun (i, i') -> (i, Sil.Var i')) ids') in + let ids' = IList.map (fun i -> (i, Ident.create_fresh Ident.kprimed)) ids in + let ren_sub = Sil.sub_of_list (IList.map (fun (i, i') -> (i, Sil.Var i')) ids') in let p' = prop_sub ren_sub p in (*L.d_strln "Prop after renaming:"; d_prop p'; L.d_strln "";*) normalize p' @@ -2480,11 +2480,11 @@ let prop_iter_create prop = (** Return the prop associated to the iterator. *) let prop_iter_to_prop iter = - let sigma = list_rev_append iter.pit_old (iter.pit_curr:: iter.pit_new) in + let sigma = IList.rev_append iter.pit_old (iter.pit_curr:: iter.pit_new) in let prop = normalize { sub = iter.pit_sub; pi = iter.pit_pi; sigma = sigma; foot_pi = iter.pit_foot_pi; foot_sigma = iter.pit_foot_sigma } in - list_fold_left + IList.fold_left (fun p (footprint, atom) -> prop_atom_and ~footprint: footprint p atom) prop iter.pit_newpi @@ -2497,7 +2497,7 @@ let prop_iter_add_atom footprint iter atom = (** Remove the current element of the iterator, and return the prop associated to the resulting iterator *) let prop_iter_remove_curr_then_to_prop iter = - let sigma = list_rev_append iter.pit_old iter.pit_new in + let sigma = IList.rev_append iter.pit_old iter.pit_new in let normalized_sigma = sigma_normalize iter.pit_sub sigma in { sub = iter.pit_sub; pi = iter.pit_pi; @@ -2510,7 +2510,7 @@ let prop_iter_current iter = let curr = hpred_normalize iter.pit_sub iter.pit_curr in let prop = { prop_emp with sigma = [curr] } in let prop' = - list_fold_left + IList.fold_left (fun p (footprint, atom) -> prop_atom_and ~footprint: footprint p atom) prop iter.pit_newpi in match prop'.sigma with @@ -2576,7 +2576,7 @@ let prop_iter_make_id_primed id iter = atom_normalize Sil.sub_empty eq' in let rec split pairs_unpid pairs_pid = function - | [] -> (list_rev pairs_unpid, list_rev pairs_pid) + | [] -> (IList.rev pairs_unpid, IList.rev pairs_pid) | eq:: eqs_cur -> begin match eq with @@ -2596,12 +2596,12 @@ let prop_iter_make_id_primed id iter = let rec get_eqs acc = function | [] | [_] -> - list_rev acc + IList.rev acc | (_, e1) :: (((_, e2) :: pairs') as pairs) -> get_eqs (Sil.Aeq(e1, e2):: acc) pairs in let sub_new, sub_use, eqs_add = - let eqs = list_map normalize (Sil.sub_to_list iter.pit_sub) in + let eqs = IList.map normalize (Sil.sub_to_list iter.pit_sub) in let pairs_unpid, pairs_pid = split [] [] eqs in match pairs_pid with | [] -> @@ -2611,7 +2611,7 @@ let prop_iter_make_id_primed id iter = | (id1, e1):: _ -> let sub_id1 = Sil.sub_of_list [(id1, e1)] in let pairs_unpid' = - list_map (fun (id', e') -> (id', Sil.exp_sub sub_id1 e')) pairs_unpid in + IList.map (fun (id', e') -> (id', Sil.exp_sub sub_id1 e')) pairs_unpid in let sub_unpid = Sil.sub_of_list pairs_unpid' in let pairs = (id, e1) :: pairs_unpid' in sub_unpid, Sil.sub_of_list pairs, get_eqs [] pairs_pid in @@ -2635,7 +2635,7 @@ let prop_iter_footprint_fav iter = let prop_iter_fav_add fav iter = Sil.sub_fav_add fav iter.pit_sub; pi_fav_add fav iter.pit_pi; - pi_fav_add fav (list_map snd iter.pit_newpi); + pi_fav_add fav (IList.map snd iter.pit_newpi); sigma_fav_add fav iter.pit_old; sigma_fav_add fav iter.pit_new; Sil.hpred_fav_add fav iter.pit_curr; @@ -2668,10 +2668,10 @@ let rec strexp_gc_fields (fav: Sil.fav) se = | Sil.Eexp _ -> Some se | Sil.Estruct (fsel, inst) -> - let fselo = list_map (fun (f, se) -> (f, strexp_gc_fields fav se)) fsel in + let fselo = IList.map (fun (f, se) -> (f, strexp_gc_fields fav se)) fsel in let fsel' = - let fselo' = list_filter (function | (_, Some _) -> true | _ -> false) fselo in - list_map (function (f, seo) -> (f, unSome seo)) fselo' in + let fselo' = IList.filter (function | (_, Some _) -> true | _ -> false) fselo in + IList.map (function (f, seo) -> (f, unSome seo)) fselo' in if Sil.fld_strexp_list_compare fsel fsel' = 0 then Some se else Some (Sil.Estruct (fsel', inst)) | Sil.Earray _ -> @@ -2708,8 +2708,8 @@ let prop_case_split prop = let f props_acc (pi, sigma) = let sigma' = sigma_normalize_prop prop sigma in let prop' = { prop with sigma = sigma' } in - (list_fold_left prop_atom_and prop' pi):: props_acc in - list_fold_left f [] pi_sigma_list + (IList.fold_left prop_atom_and prop' pi):: props_acc in + IList.fold_left f [] pi_sigma_list (** Raise an exception if the prop is not normalized *) let check_prop_normalized prop = @@ -2755,9 +2755,9 @@ let trans_land_lor op ((idl1, stml1), e1) ((idl2, stml2), e2) loc = formal variable that is equal to the expression, or the OBJC_NULL attribute of the expression. *) let find_equal_formal_path e prop = let rec find_in_sigma e seen_hpreds = - list_fold_right ( + IList.fold_right ( fun hpred res -> - if list_mem Sil.hpred_equal hpred seen_hpreds then None + if IList.mem Sil.hpred_equal hpred seen_hpreds then None else let seen_hpreds = hpred :: seen_hpreds in match res with @@ -2768,7 +2768,7 @@ let find_equal_formal_path e prop = when Sil.exp_equal exp2 e && (Sil.pvar_is_local pvar1 || Sil.pvar_is_seed pvar1) -> Some (Sil.Lvar pvar1) | Sil.Hpointsto (exp1, Sil.Estruct (fields, _), _) -> - list_fold_right (fun (field, strexp) res -> + IList.fold_right (fun (field, strexp) res -> match res with | Some _ -> res | None -> @@ -2821,9 +2821,9 @@ end = struct and sigma_size sigma = let size = ref 0 in - list_iter (fun hpred -> size := hpred_size hpred + !size) sigma; !size + IList.iter (fun hpred -> size := hpred_size hpred + !size) sigma; !size - let pi_size pi = pi_weight * list_length pi + let pi_size pi = pi_weight * IList.length pi (** Approximate the size of the longest chain by counting the max @@ -2844,7 +2844,7 @@ end = struct | Sil.Var id when Ident.is_primed id || Ident.is_footprint id -> add te | _ -> ()) | Sil.Hlseg _ | Sil.Hdllseg _ -> () in - list_iter process_hpred sigma; + IList.iter process_hpred sigma; let size = ref 0 in Sil.ExpMap.iter (fun t n -> size := max n !size) !tbl; !size @@ -2887,7 +2887,7 @@ module CategorizePreconditions = struct let rec rhs_only_vars = function | Sil.Eexp (Sil.Var _, _) -> true | Sil.Estruct (fsel, _) -> - list_for_all (fun (_, se) -> rhs_only_vars se) fsel + IList.for_all (fun (_, se) -> rhs_only_vars se) fsel | Sil.Earray _ -> true | _ -> false in let hpred_is_var = function (* stack variable with no constraints *) @@ -2902,10 +2902,10 @@ module CategorizePreconditions = struct let check_pi pi = pi = [] in let check_sigma sigma = - list_for_all hpred_filter sigma in + IList.for_all hpred_filter sigma in check_pi (get_pi pre) && check_sigma (get_sigma pre) in - let pres_no_constraints = list_filter (check_pre hpred_is_var) preconditions in - let pres_only_allocation = list_filter (check_pre hpred_only_allocation) preconditions 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 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 a1b833ef8..754770340 100644 --- a/infer/src/backend/propgraph.ml +++ b/infer/src/backend/propgraph.ml @@ -69,9 +69,9 @@ let get_subl footprint_part g = let edge_from_source g n footprint_part is_hpred = let edges = if is_hpred - then list_map (fun hpred -> Ehpred hpred ) (get_sigma footprint_part g) - else list_map (fun a -> Eatom a) (get_pi footprint_part g) @ list_map (fun entry -> Esub_entry entry) (get_subl footprint_part g) in - match list_filter (fun hpred -> Sil.exp_equal n (edge_get_source hpred)) edges with + then IList.map (fun hpred -> Ehpred hpred ) (get_sigma footprint_part g) + else IList.map (fun a -> Eatom a) (get_pi footprint_part g) @ IList.map (fun entry -> Esub_entry entry) (get_subl footprint_part g) in + match IList.filter (fun hpred -> Sil.exp_equal n (edge_get_source hpred)) edges with | [] -> None | edge:: _ -> Some edge @@ -87,7 +87,7 @@ let get_edges footprint_part g = let hpreds = get_sigma footprint_part g in let atoms = get_pi footprint_part g in let subst_entries = get_subl footprint_part g in - list_map (fun hpred -> Ehpred hpred) hpreds @ list_map (fun a -> Eatom a) atoms @ list_map (fun entry -> Esub_entry entry) subst_entries + IList.map (fun hpred -> Ehpred hpred) hpreds @ IList.map (fun a -> Eatom a) atoms @ IList.map (fun entry -> Esub_entry entry) subst_entries let edge_equal e1 e2 = match e1, e2 with | Ehpred hp1, Ehpred hp2 -> Sil.hpred_equal hp1 hp2 @@ -98,13 +98,13 @@ 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 (list_find (fun e' -> edge_equal e e') (get_edges footprint_part g)); true + try ignore (IList.find (fun e' -> edge_equal e e') (get_edges footprint_part g)); true with Not_found -> false (** [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. *) let iter_edges footprint_part f g = - list_iter f (get_edges footprint_part g) (* For now simple iterator; later might use a specific traversal *) + IList.iter f (get_edges footprint_part g) (* For now simple iterator; later might use a specific traversal *) (** Graph annotated with the differences w.r.t. a previous graph *) type diff = @@ -176,9 +176,9 @@ let compute_diff default_color oldgraph newgraph : diff = changed := changed_obj :: !changed | Some oldedge -> changed := compute_edge_diff oldedge edge @ !changed end in - list_iter build_changed newedges; + IList.iter build_changed newedges; let colormap (o: Obj.t) = - if list_exists (fun x -> x == o) !changed then Red + if IList.exists (fun x -> x == o) !changed then Red else default_color in !changed, colormap in let changed_norm, colormap_norm = compute_changed false in @@ -198,7 +198,7 @@ let diff_get_colormap footprint_part diff = If !Config.pring_using_diff is true, print the diff w.r.t. the given prop, extracting its local stack vars if the boolean is true. *) let pp_proplist pe0 s (base_prop, extract_stack) f plist = - let num = list_length plist in + let num = IList.length plist in let base_stack = fst (Prop.sigma_get_stack_nonstack true (Prop.get_sigma base_prop)) in let add_base_stack prop = if extract_stack then Prop.replace_sigma (base_stack @ Prop.get_sigma prop) prop diff --git a/infer/src/backend/propset.ml b/infer/src/backend/propset.ml index 71f2fb5cf..9b48a796c 100644 --- a/infer/src/backend/propset.ml +++ b/infer/src/backend/propset.ml @@ -30,7 +30,7 @@ type t = PropSet.t let add p pset = let ps = Prop.prop_expand p in - list_fold_left (fun pset' p' -> PropSet.add (Prop.prop_rename_primed_footprint_vars p') pset') pset ps + IList.fold_left (fun pset' p' -> PropSet.add (Prop.prop_rename_primed_footprint_vars p') pset') pset ps (** Singleton set. *) let singleton p = @@ -61,27 +61,27 @@ let size = PropSet.cardinal let filter = PropSet.filter let from_proplist plist = - list_fold_left (fun pset p -> add p pset) empty plist + IList.fold_left (fun pset p -> add p pset) empty plist let to_proplist pset = PropSet.elements pset (** Apply function to all the elements of [propset], removing those where it returns [None]. *) let map_option f pset = - let plisto = list_map f (to_proplist pset) in - let plisto = list_filter (function | Some _ -> true | None -> false) plisto in - let plist = list_map (function Some p -> p | None -> assert false) plisto in + let plisto = IList.map f (to_proplist pset) in + let plisto = IList.filter (function | Some _ -> true | None -> false) plisto in + let plist = IList.map (function Some p -> p | None -> assert false) plisto in from_proplist plist (** Apply function to all the elements of [propset]. *) let map f pset = - from_proplist (list_map f (to_proplist pset)) + from_proplist (IList.map f (to_proplist pset)) (** [fold f pset a] computes [f (... (f (f a p1) p2) ...) pn] where [p1 ... pN] are the elements of pset, in increasing order. *) let fold f a pset = let l = to_proplist pset in - list_fold_left f a l + IList.fold_left f a l (** [iter f pset] computes (f p1;f p2;..;f pN) where [p1 ... pN] are the elements of pset, in increasing order. *) diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index d260cc19f..1472f79e4 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -19,10 +19,10 @@ let decrease_indent_when_exception thunk = with exn when exn_not_timeout exn -> (L.d_decrease_indent 1; raise exn) let compute_max_from_nonempty_int_list l = - list_hd (list_rev (list_sort Sil.Int.compare_value l)) + IList.hd (IList.rev (IList.sort Sil.Int.compare_value l)) let compute_min_from_nonempty_int_list l = - list_hd (list_sort Sil.Int.compare_value l) + IList.hd (IList.sort Sil.Int.compare_value l) let exp_pair_compare (e1, e2) (f1, f2) = let c1 = Sil.exp_compare e1 f1 in @@ -33,8 +33,8 @@ let rec list_rev_acc acc = function | x:: l -> list_rev_acc (x:: acc) l let rec remove_redundancy have_same_key acc = function - | [] -> list_rev acc - | [x] -> list_rev (x:: acc) + | [] -> IList.rev acc + | [x] -> IList.rev (x:: acc) | x:: ((y:: l') as l) -> if have_same_key x y then remove_redundancy have_same_key acc (x:: l') else remove_redundancy have_same_key (x:: acc) l @@ -110,18 +110,18 @@ end = struct generate constr acc rest let sort_then_remove_redundancy constraints = - let constraints_sorted = list_sort compare constraints in + let constraints_sorted = IList.sort compare constraints in let have_same_key (e1, e2, _) (f1, f2, _) = exp_pair_compare (e1, e2) (f1, f2) = 0 in remove_redundancy have_same_key [] constraints_sorted let remove_redundancy constraints = let constraints' = sort_then_remove_redundancy constraints in - list_filter (fun entry -> list_exists (equal entry) constraints') constraints + IList.filter (fun entry -> IList.exists (equal entry) constraints') constraints let rec combine acc_todos acc_seen constraints_new constraints_old = match constraints_new, constraints_old with - | [], [] -> list_rev acc_todos, list_rev acc_seen - | [], _ -> list_rev acc_todos, list_rev_acc constraints_old acc_seen + | [], [] -> IList.rev acc_todos, IList.rev acc_seen + | [], _ -> IList.rev acc_todos, list_rev_acc constraints_old acc_seen | _, [] -> list_rev_acc constraints_new acc_todos, list_rev_acc constraints_new acc_seen | constr:: rest, constr':: rest' -> let e1, e2, n = constr in @@ -253,7 +253,7 @@ end = struct if c2 <> 0 then c2 else - (Sil.exp_compare e1 f1) let leqs_sort_then_remove_redundancy leqs = - let leqs_sorted = list_sort leq_compare leqs in + let leqs_sorted = IList.sort leq_compare leqs in let have_same_key leq1 leq2 = match leq1, leq2 with | (e1, Sil.Const (Sil.Cint n1)), (e2, Sil.Const (Sil.Cint n2)) -> @@ -261,7 +261,7 @@ end = struct | _, _ -> false in remove_redundancy have_same_key [] leqs_sorted let lts_sort_then_remove_redundancy lts = - let lts_sorted = list_sort lt_compare lts in + let lts_sorted = IList.sort lt_compare lts in let have_same_key lt1 lt2 = match lt1, lt2 with | (Sil.Const (Sil.Cint n1), e1), (Sil.Const (Sil.Cint n2), e2) -> @@ -271,9 +271,9 @@ end = struct let saturate { leqs = leqs; lts = lts; neqs = neqs } = let diff_constraints1 = - list_fold_left + IList.fold_left DiffConstr.from_lt - (list_fold_left DiffConstr.from_leq [] leqs) + (IList.fold_left DiffConstr.from_leq [] leqs) lts in let inconsistent, diff_constraints2 = DiffConstr.saturate diff_constraints1 in if inconsistent then inconsistent_ineq @@ -328,7 +328,7 @@ end = struct let leqs' = Sil.ExpMap.fold (fun e upper acc_leqs -> (e, Sil.exp_int upper):: acc_leqs) umap' [] in - let leqs'' = (list_map DiffConstr.to_leq diff_constraints2) @ leqs' in + let leqs'' = (IList.map DiffConstr.to_leq diff_constraints2) @ leqs' in leqs_sort_then_remove_redundancy leqs'' in let lts_res = let lmap = lmap_create_from_lts Sil.ExpMap.empty lts in @@ -336,7 +336,7 @@ end = struct let lts' = Sil.ExpMap.fold (fun e lower acc_lts -> (Sil.exp_int lower, e):: acc_lts) lmap' [] in - let lts'' = (list_map DiffConstr.to_lt diff_constraints2) @ lts' in + let lts'' = (IList.map DiffConstr.to_lt diff_constraints2) @ lts' in lts_sort_then_remove_redundancy lts'' in { leqs = leqs_res; lts = lts_res; neqs = neqs } end @@ -354,7 +354,7 @@ end = struct | Sil.Aeq (Sil.BinOp (Sil.Lt, e1, e2), Sil.Const (Sil.Cint i)) when Sil.Int.isone i -> (* < *) lts := (e1, e2) :: !lts | Sil.Aeq _ -> () in - list_iter process_atom pi; + IList.iter process_atom pi; saturate { leqs = !leqs; lts = !lts; neqs = !neqs } let from_sigma sigma = @@ -371,10 +371,10 @@ end = struct let rec strexp_extract = function | Sil.Eexp _ -> () | Sil.Estruct (fsel, _) -> - list_iter (fun (_, se) -> strexp_extract se) fsel + IList.iter (fun (_, se) -> strexp_extract se) fsel | Sil.Earray (size, isel, _) -> add_lt_minus1_e size; - list_iter (fun (idx, se) -> + IList.iter (fun (idx, se) -> add_lt_minus1_e idx; strexp_extract se) isel in let hpred_extract = function @@ -382,7 +382,7 @@ end = struct if texp_is_unsigned texp then strexp_lt_minus1 se; strexp_extract se | Sil.Hlseg _ | Sil.Hdllseg _ -> () in - list_iter hpred_extract sigma; + IList.iter hpred_extract sigma; saturate { leqs = !leqs; lts = !lts; neqs = [] } let join ineq1 ineq2 = @@ -411,11 +411,11 @@ end = struct when Sil.Int.isminusone n2 && type_size_comparable t1 t2 -> (* [ sizeof(t1) - sizeof(t2) <= -1 ] *) check_type_size_lt t1 t2 | e, Sil.Const (Sil.Cint n) -> (* [e <= n' <= n |- e <= n] *) - list_exists (function + IList.exists (function | e', Sil.Const (Sil.Cint n') -> Sil.exp_equal e e' && Sil.Int.leq n' n | _, _ -> false) leqs | Sil.Const (Sil.Cint n), e -> (* [ n-1 <= n' < e |- n <= e] *) - list_exists (function + IList.exists (function | Sil.Const (Sil.Cint n'), e' -> Sil.exp_equal e e' && Sil.Int.leq (n -- Sil.Int.one) n' | _, _ -> false) lts | _ -> Sil.exp_equal e1 e2 @@ -426,11 +426,11 @@ end = struct match e1, e2 with | Sil.Const (Sil.Cint n1), Sil.Const (Sil.Cint n2) -> Sil.Int.lt n1 n2 | Sil.Const (Sil.Cint n), e -> (* [n <= n' < e |- n < e] *) - list_exists (function + IList.exists (function | Sil.Const (Sil.Cint n'), e' -> Sil.exp_equal e e' && Sil.Int.leq n n' | _, _ -> false) lts | e, Sil.Const (Sil.Cint n) -> (* [e <= n' <= n-1 |- e < n] *) - list_exists (function + IList.exists (function | e', Sil.Const (Sil.Cint n') -> Sil.exp_equal e e' && Sil.Int.leq n' (n -- Sil.Int.one) | _, _ -> false) leqs | _ -> false @@ -438,7 +438,7 @@ end = struct (** Check [prop |- e1!=e2]. Result [false] means "don't know". *) let check_ne ineq _e1 _e2 = let e1, e2 = if Sil.exp_compare _e1 _e2 <= 0 then _e1, _e2 else _e2, _e1 in - list_exists (exp_pair_eq (e1, e2)) ineq.neqs || check_lt ineq e1 e2 || check_lt ineq e2 e1 + IList.exists (exp_pair_eq (e1, e2)) ineq.neqs || check_lt ineq e1 e2 || check_lt ineq e2 e1 (** Find a Sil.Int.t n such that [t |- e<=n] if possible. *) let compute_upper_bound { leqs = leqs; lts = _; neqs = _ } e1 = @@ -446,11 +446,11 @@ end = struct | Sil.Const (Sil.Cint n1) -> Some n1 | _ -> let e_upper_list = - list_filter (function + IList.filter (function | e', Sil.Const (Sil.Cint _) -> Sil.exp_equal e1 e' | _, _ -> false) leqs in let upper_list = - list_map (function + IList.map (function | _, Sil.Const (Sil.Cint n) -> n | _ -> assert false) e_upper_list in if upper_list == [] then None @@ -463,11 +463,11 @@ end = struct | Sil.Sizeof _ -> Some Sil.Int.zero | _ -> let e_lower_list = - list_filter (function + IList.filter (function | Sil.Const (Sil.Cint _), e' -> Sil.exp_equal e1 e' | _, _ -> false) lts in let lower_list = - list_map (function + IList.map (function | Sil.Const (Sil.Cint n), _ -> n | _ -> assert false) e_lower_list in if lower_list == [] then None @@ -479,9 +479,9 @@ end = struct check_le ineq e1 e2 && check_le ineq e2 e1 in let inconsistent_leq (e1, e2) = check_lt ineq e2 e1 in let inconsistent_lt (e1, e2) = check_le ineq e2 e1 in - list_exists inconsistent_neq neqs || - list_exists inconsistent_leq leqs || - list_exists inconsistent_lt lts + IList.exists inconsistent_neq neqs || + IList.exists inconsistent_leq leqs || + IList.exists inconsistent_lt lts (** Pretty print inequalities and disequalities *) let pp pe fmt { leqs = leqs; lts = lts; neqs = neqs } = @@ -491,15 +491,15 @@ end = struct Format.fprintf fmt "%a %a %a" (pp_seq pp_leq) leqs (pp_seq pp_lt) lts (pp_seq pp_neq) neqs let d_leqs { leqs = leqs; lts = lts; neqs = neqs } = - let elist = list_map (fun (e1, e2) -> Sil.BinOp(Sil.Le, e1, e2)) leqs in + let elist = IList.map (fun (e1, e2) -> Sil.BinOp(Sil.Le, e1, e2)) leqs in Sil.d_exp_list elist let d_lts { leqs = leqs; lts = lts; neqs = neqs } = - let elist = list_map (fun (e1, e2) -> Sil.BinOp(Sil.Lt, e1, e2)) lts in + let elist = IList.map (fun (e1, e2) -> Sil.BinOp(Sil.Lt, e1, e2)) lts in Sil.d_exp_list elist let d_neqs { leqs = leqs; lts = lts; neqs = neqs } = - let elist = list_map (fun (e1, e2) -> Sil.BinOp(Sil.Ne, e1, e2)) lts in + let elist = IList.map (fun (e1, e2) -> Sil.BinOp(Sil.Ne, e1, e2)) lts in Sil.d_exp_list elist end (* End of module Inequalities *) @@ -525,7 +525,7 @@ let check_equal prop e1 e2 = let eq = Sil.Aeq(n_e1, n_e2) in let n_eq = Prop.atom_normalize_prop prop eq in let pi = Prop.get_pi prop in - list_exists (Sil.atom_equal n_eq) pi in + IList.exists (Sil.atom_equal n_eq) pi in check_equal () || check_equal_const () || check_equal_pi () (** Check [ |- e=0]. Result [false] means "don't know". *) @@ -603,7 +603,7 @@ let check_disequal prop e1 e2 = let sigma_irrelevant' = hpred :: sigma_irrelevant in f sigma_irrelevant' e sigma_rest | Some _ -> - let sigma_irrelevant' = (list_rev sigma_irrelevant) @ sigma_rest + let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest in Some (true, sigma_irrelevant')) | Sil.Hlseg (k, _, e1, e2, _) as hpred :: sigma_rest -> (match is_root prop e1 e with @@ -612,20 +612,20 @@ let check_disequal prop e1 e2 = in f sigma_irrelevant' e sigma_rest | Some _ -> if (k == Sil.Lseg_NE || check_pi_implies_disequal e1 e2) then - let sigma_irrelevant' = (list_rev sigma_irrelevant) @ sigma_rest + let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest in Some (true, sigma_irrelevant') else if (Sil.exp_equal e2 Sil.exp_zero) then - let sigma_irrelevant' = (list_rev sigma_irrelevant) @ sigma_rest + let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest in Some (false, sigma_irrelevant') else - let sigma_rest' = (list_rev sigma_irrelevant) @ sigma_rest + let sigma_rest' = (IList.rev sigma_irrelevant) @ sigma_rest in f [] e2 sigma_rest') | Sil.Hdllseg (Sil.Lseg_NE, _, iF, oB, oF, iB, _) :: sigma_rest -> if is_root prop iF e != None || is_root prop iB e != None then - let sigma_irrelevant' = (list_rev sigma_irrelevant) @ sigma_rest + let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest in Some (true, sigma_irrelevant') else - let sigma_irrelevant' = (list_rev sigma_irrelevant) @ sigma_rest + let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest in Some (false, sigma_irrelevant') | Sil.Hdllseg (Sil.Lseg_PE, _, iF, oB, oF, iB, _) as hpred :: sigma_rest -> (match is_root prop iF e with @@ -634,18 +634,18 @@ let check_disequal prop e1 e2 = in f sigma_irrelevant' e sigma_rest | Some _ -> if (check_pi_implies_disequal iF oF) then - let sigma_irrelevant' = (list_rev sigma_irrelevant) @ sigma_rest + let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest in Some (true, sigma_irrelevant') else if (Sil.exp_equal oF Sil.exp_zero) then - let sigma_irrelevant' = (list_rev sigma_irrelevant) @ sigma_rest + let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest in Some (false, sigma_irrelevant') else - let sigma_rest' = (list_rev sigma_irrelevant) @ sigma_rest + let sigma_rest' = (IList.rev sigma_irrelevant) @ sigma_rest in f [] oF sigma_rest') in let f_null_check sigma_irrelevant e sigma_rest = if not (Sil.exp_equal e Sil.exp_zero) then f sigma_irrelevant e sigma_rest else - let sigma_irrelevant' = (list_rev sigma_irrelevant) @ sigma_rest + let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest in Some (false, sigma_irrelevant') in match f_null_check [] n_e1 spatial_part with | None -> false @@ -748,7 +748,7 @@ let check_allocatedness prop e = if k == Sil.Lseg_NE || check_disequal prop iF oF || check_disequal prop iB oB then is_root prop iF n_e != None || is_root prop iB n_e != None else false - in list_exists f spatial_part + in IList.exists f spatial_part (** Compute an upper bound of an expression *) let compute_upper_bound_of_exp p e = @@ -823,7 +823,7 @@ let check_inconsistency_base prop = Sil.exp_equal e Sil.exp_zero && Sil.pvar_is_seed pv | _ -> false in - list_exists do_hpred sigma in + IList.exists do_hpred sigma in let inconsistent_self () = (* "self" cannot be null in ObjC *) let procdesc = Cfg.Node.get_proc_desc (State.get_node ()) in let procedure_attr = Cfg.Procdesc.get_attributes procdesc in @@ -835,7 +835,7 @@ let check_inconsistency_base prop = Sil.pvar_get_name pv = Mangled.from_string "self" && procedure_attr.ProcAttributes.is_objc_instance_method | _ -> false in - list_exists do_hpred sigma in + IList.exists do_hpred sigma in let inconsistent_atom = function | Sil.Aeq (e1, e2) -> (match e1, e2 with @@ -857,7 +857,7 @@ let check_inconsistency_base prop = Inequalities.inconsistent ineq in inconsistent_ptsto () || check_inconsistency_two_hpreds prop - || list_exists inconsistent_atom pi + || IList.exists inconsistent_atom pi || inconsistent_inequalities () || inconsistent_this () || inconsistent_self () @@ -895,7 +895,7 @@ type check = let d_typings typings = let d_elem (exp, texp) = Sil.d_exp exp; L.d_str ": "; Sil.d_texp_full texp; L.d_str " " in - list_iter d_elem typings + IList.iter d_elem typings (** Module to encapsulate operations on the internal state of the prover *) module ProverState : sig @@ -950,7 +950,7 @@ end = struct | Sil.Hpointsto (_, Sil.Earray (Sil.Var _ as size, _, _), _) -> Sil.exp_fav_add fav size | _ -> () in - list_iter do_hpred (Prop.get_sigma prop); + IList.iter do_hpred (Prop.get_sigma prop); fav let reset lhs rhs = @@ -1246,7 +1246,7 @@ let rec sexp_imply source calc_index_frame calc_missing subs se1 se2 typ2 : subs raise (Exceptions.Abduction_case_not_implemented (try assert false with Assert_failure x -> x)) end | Sil.Earray (size1, esel1, inst1), Sil.Earray (size2, esel2, _) -> - let indices2 = list_map fst esel2 in + let indices2 = IList.map fst esel2 in let subs' = array_size_imply calc_missing subs size1 size2 indices2 in if Sil.strexp_equal se1 se2 then subs', None, None else begin @@ -1259,7 +1259,7 @@ let rec sexp_imply source calc_index_frame calc_missing subs se1 se2 typ2 : subs d_impl_err ("WARNING: function call with parameters of struct type, treating as unknown", subs, (EXC_FALSE_SEXPS (se1, se2))); let fsel' = let g (f, se) = (f, Sil.Eexp (Sil.Var (Ident.create_fresh Ident.knormal), inst)) in - list_map g fsel in + IList.map g fsel in sexp_imply source calc_index_frame calc_missing subs (Sil.Estruct (fsel', inst')) se2 typ2 | Sil.Eexp _, Sil.Earray (size, esel, inst) | Sil.Estruct _, Sil.Earray (size, esel, inst) -> @@ -1404,7 +1404,7 @@ let move_primed_lhs_from_front subs sigma = match sigma with | [] -> sigma | hpred:: sigma' -> if hpred_has_primed_lhs (snd subs) hpred then - let (sigma_primed, sigma_unprimed) = list_partition (hpred_has_primed_lhs (snd subs)) sigma + let (sigma_primed, sigma_unprimed) = IList.partition (hpred_has_primed_lhs (snd subs)) sigma in match sigma_unprimed with | [] -> raise (IMPL_EXC ("every hpred has primed lhs, cannot proceed", subs, (EXC_FALSE_SIGMA sigma))) | _:: _ -> sigma_unprimed @ sigma_primed @@ -1436,7 +1436,7 @@ let expand_hpred_pointer calc_index_frame hpred : bool * bool * Sil.hpred = | Sil.Hpointsto (Sil.BinOp (Sil.PlusPI, e1, e2), Sil.Earray (size, esel, inst), t) -> let shift_exp e = Sil.BinOp (Sil.PlusA, e, e2) in let size' = shift_exp size in - let esel' = list_map (fun (e, se) -> (shift_exp e, se)) esel in + let esel' = IList.map (fun (e, se) -> (shift_exp e, se)) esel in let hpred' = Sil.Hpointsto (e1, Sil.Earray (size', esel', inst), t) in expand true calc_index_frame hpred' | _ -> changed, calc_index_frame, hpred in @@ -1451,7 +1451,7 @@ let cloneable_type = Mangled.from_string "java.lang.Cloneable" let is_interface tenv c = match Sil.tenv_lookup tenv (Sil.TN_csu (Sil.Class, c)) with | Some (Sil.Tstruct (fields, sfields, Sil.Class, Some c1', supers1, methods, iann)) -> - (list_length fields = 0) && (list_length methods = 0) + (IList.length fields = 0) && (IList.length methods = 0) | _ -> false (** check if c1 is a subclass of c2 *) @@ -1460,7 +1460,7 @@ let check_subclass_tenv tenv c1 c2 = Mangled.equal c c2 || (Mangled.equal c2 object_type) || match Sil.tenv_lookup tenv (Sil.TN_csu (Sil.Class, c)) with | Some (Sil.Tstruct (_, _, Sil.Class, Some c1', supers1, _, _)) -> - list_exists check supers1 + IList.exists check supers1 | _ -> false in (check (Sil.Class, c1)) @@ -1601,7 +1601,7 @@ let handle_parameter_subtype tenv prop1 sigma2 subs (e1, se1, texp1) (se2, texp2 let filter = function | Sil.Hpointsto(e', _, _) -> Sil.exp_equal e' e | _ -> false in - list_exists filter (Prop.get_sigma prop1) in + IList.exists filter (Prop.get_sigma prop1) in let type_rhs e = let sub_opt = ref None in let filter = function @@ -1609,7 +1609,7 @@ let handle_parameter_subtype tenv prop1 sigma2 subs (e1, se1, texp1) (se2, texp2 sub_opt := Some (t, sub); true | _ -> false in - if list_exists filter sigma2 then !sub_opt else None in + if IList.exists filter sigma2 then !sub_opt else None in let add_subtype () = match texp1, texp2, se1, se2 with | Sil.Sizeof(Sil.Tptr (_t1, _), _), Sil.Sizeof(Sil.Tptr (_t2, _), sub2), Sil.Eexp(e1', _), Sil.Eexp(e2', _) when not (is_allocated_lhs e1') -> begin @@ -1735,7 +1735,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 | Some iter1 -> (match Prop.prop_iter_find iter1 (filter_hpred (fst subs) (Sil.hpred_sub (snd subs) hpred2)) with | None -> - let elist2 = list_map (fun e -> Sil.exp_sub (snd subs) e) _elist2 in + let elist2 = IList.map (fun e -> Sil.exp_sub (snd subs) e) _elist2 in let _, para_inst2 = Sil.hpara_instantiate para2 e2 f2 elist2 in L.d_increase_indent 1; let res = @@ -1745,7 +1745,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 L.d_decrease_indent 1; res | Some iter1' -> - let elist2 = list_map (fun e -> Sil.exp_sub (snd subs) e) _elist2 in + let elist2 = IList.map (fun e -> Sil.exp_sub (snd subs) e) _elist2 in let subs' = exp_list_imply calc_missing subs (f2:: elist2) (f2:: elist2) in (* force instantiation of existentials *) let prop1' = Prop.prop_iter_remove_curr_then_to_prop iter1' in let hpred1 = match Prop.prop_iter_current iter1' with @@ -1799,7 +1799,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 | Some iter1 -> (match Prop.prop_iter_find iter1 (filter_hpred (fst subs) (Sil.hpred_sub (snd subs) hpred2)) with | None -> - let elist2 = list_map (fun e -> Sil.exp_sub (snd subs) e) elist2 in + let elist2 = IList.map (fun e -> Sil.exp_sub (snd subs) e) elist2 in let _, para_inst2 = if Sil.exp_equal iF2 iB2 then Sil.hpara_dll_instantiate para2 iF2 oB2 oF2 elist2 @@ -1812,7 +1812,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 L.d_decrease_indent 1; res | Some iter1' -> (** Only consider implications between identical listsegs for now *) - let elist2 = list_map (fun e -> Sil.exp_sub (snd subs) e) elist2 in + let elist2 = IList.map (fun e -> Sil.exp_sub (snd subs) e) elist2 in let subs' = exp_list_imply calc_missing subs (iF2:: oB2:: oF2:: iB2:: elist2) (iF2:: oB2:: oF2:: iB2:: elist2) in (* force instantiation of existentials *) let prop1' = Prop.prop_iter_remove_curr_then_to_prop iter1' in (subs', prop1') @@ -1846,7 +1846,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 * let se = Sil.Eexp (Sil.Var (Ident.create_fresh Ident.kprimed), Sil.Inone) in (fld, se) in let fields = ["java.lang.String.count"; "java.lang.String.hash"; "java.lang.String.offset"; "java.lang.String.value"] in - Sil.Estruct (list_map mk_fld_sexp fields, Sil.inst_none) in + Sil.Estruct (IList.map mk_fld_sexp fields, Sil.inst_none) in let const_string_texp = match !Config.curr_language with | Config.C_CPP -> Sil.Sizeof (Sil.Tarray (Sil.Tint Sil.IChar, size), Sil.Subtype.exact) @@ -1941,7 +1941,7 @@ let imply_pi calc_missing (sub1, sub2) prop pi2 = | IMPL_EXC _ when calc_missing -> L.d_str "imply_pi: adding missing atom "; Sil.d_atom a; L.d_ln (); ProverState.add_missing_pi a in - list_iter do_atom pi2 + IList.iter do_atom pi2 let imply_atom calc_missing (sub1, sub2) prop a = imply_pi calc_missing (sub1, sub2) prop [a] @@ -2001,12 +2001,12 @@ let check_array_bounds (sub1, sub2) prop = (* L.d_strln_color Orange "check_bound "; Sil.d_exp size1; L.d_str " "; Sil.d_exp size2; L.d_ln(); *) let indices_to_check = match size2 with | _ -> [Sil.BinOp(Sil.PlusA, size2, Sil.exp_minus_one)] (* only check size *) in - list_iter (fail_if_le size1) indices_to_check + IList.iter (fail_if_le size1) indices_to_check | ProverState.BCfrom_pre _atom -> let atom_neg = Prop.atom_negate (Sil.atom_sub sub2 _atom) in (* L.d_strln_color Orange "BCFrom_pre"; Sil.d_atom atom_neg; L.d_ln (); *) if check_atom prop atom_neg then check_failed atom_neg in - list_iter check_bound (ProverState.get_bounds_checks ()) + IList.iter check_bound (ProverState.get_bounds_checks ()) (** [check_implication_base] returns true if [prop1|-prop2], ignoring the footprint part of the props *) @@ -2021,8 +2021,8 @@ let check_implication_base pname tenv check_frame_empty calc_missing prop1 prop2 let sigma1, sigma2 = Prop.get_sigma prop1, Prop.get_sigma prop2 in let subs = pre_check_pure_implication calc_missing (Prop.get_sub prop1, sub1_base) pi1 pi2 in let pi2_bcheck, pi2_nobcheck = (* find bounds checks implicit in pi2 *) - list_partition ProverState.atom_is_array_bounds_check pi2 in - list_iter (fun a -> ProverState.add_bounds_check (ProverState.BCfrom_pre a)) pi2_bcheck; + IList.partition ProverState.atom_is_array_bounds_check pi2 in + IList.iter (fun a -> ProverState.add_bounds_check (ProverState.BCfrom_pre a)) pi2_bcheck; L.d_strln "pre_check_pure_implication"; L.d_strln "pi1:"; L.d_increase_indent 1; Prop.d_pi pi1; L.d_decrease_indent 1; L.d_ln (); @@ -2099,7 +2099,7 @@ let is_cover cases = match cases with | [] -> check_inconsistency_pi acc_pi | (pi, _):: cases' -> - list_for_all (fun a -> _is_cover ((Prop.atom_negate a) :: acc_pi) cases') pi in + IList.for_all (fun a -> _is_cover ((Prop.atom_negate a) :: acc_pi) cases') pi in _is_cover [] cases exception NO_COVER @@ -2107,8 +2107,8 @@ exception NO_COVER (** Find miminum set of pi's in [cases] whose disjunction covers true *) let find_minimum_pure_cover cases = let cases = - let compare (pi1, _) (pi2, _) = int_compare (list_length pi1) (list_length pi2) - in list_sort compare cases in + let compare (pi1, _) (pi2, _) = int_compare (IList.length pi1) (IList.length pi2) + in IList.sort compare cases in let rec grow seen todo = match todo with | [] -> raise NO_COVER | (pi, x):: todo' -> @@ -2120,7 +2120,7 @@ let find_minimum_pure_cover cases = if is_cover (seen @ todo') then _shrink seen todo' else _shrink ((pi, x):: seen) todo' in let shrink cases = - if list_length cases > 2 then _shrink [] cases + if IList.length cases > 2 then _shrink [] cases else cases in try Some (shrink (grow [] cases)) with NO_COVER -> None diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index 979bcd2fd..825670305 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -17,10 +17,10 @@ open Utils let (++) = Sil.Int.add let list_product l1 l2 = - let l1' = list_rev l1 in - let l2' = list_rev l2 in - list_fold_left - (fun acc x -> list_fold_left (fun acc' y -> (x, y):: acc') acc l2') + let l1' = IList.rev l1 in + let l2' = IList.rev l2 in + IList.fold_left + (fun acc x -> IList.fold_left (fun acc' y -> (x, y):: acc') acc l2') [] l1' let rec list_rev_and_concat l1 l2 = @@ -29,7 +29,7 @@ let rec list_rev_and_concat l1 l2 = | x1:: l1' -> list_rev_and_concat l1' (x1:: l2) let pp_off fmt off = - list_iter (fun n -> match n with + IList.iter (fun n -> match n with | Sil.Off_fld (f, t) -> F.fprintf fmt "%a " Ident.pp_fieldname f | Sil.Off_index e -> F.fprintf fmt "%a " (Sil.pp_exp pe_text) e) off @@ -106,14 +106,14 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp ([], Sil.Estruct ([], inst), t) | Sil.Tstruct (ftal, sftal, csu, nameo, supers, def_mthds, iann), (Sil.Off_fld (f, _)):: off' -> let _, t', _ = - try list_find (fun (f', _, _) -> Ident.fieldname_equal f f') ftal + try IList.find (fun (f', _, _) -> Ident.fieldname_equal f f') ftal with Not_found -> raise (Exceptions.Bad_footprint (try assert false with Assert_failure x -> x)) in let atoms', se', res_t' = create_struct_values pname tenv orig_prop footprint_part kind max_stamp t' off' inst in let se = Sil.Estruct ([(f, se')], inst) in let replace_typ_of_f (f', t', a') = if Ident.fieldname_equal f f' then (f, res_t', a') else (f', t', a') in - let ftal' = list_sort Sil.fld_typ_ann_compare (list_map replace_typ_of_f ftal) in + let ftal' = IList.sort Sil.fld_typ_ann_compare (IList.map replace_typ_of_f ftal) in (atoms', se, Sil.Tstruct (ftal', sftal, csu, nameo, supers, def_mthds, iann)) | Sil.Tstruct _, (Sil.Off_index e):: off' -> let atoms', se', res_t' = @@ -199,28 +199,28 @@ let rec _strexp_extend_values | (Sil.Off_fld (f, _)):: off', Sil.Estruct (fsel, inst'), Sil.Tstruct (ftal, sftal, csu, nameo, supers, def_mthds, iann) -> let replace_fv new_v fv = if Ident.fieldname_equal (fst fv) f then (f, new_v) else fv in let typ' = - try (fun (x, y, z) -> y) (list_find (fun (f', t', a') -> Ident.fieldname_equal f f') ftal) + try (fun (x, y, z) -> y) (IList.find (fun (f', t', a') -> Ident.fieldname_equal f f') ftal) with Not_found -> raise (Exceptions.Missing_fld (f, try assert false with Assert_failure x -> x)) in begin try - let _, se' = list_find (fun (f', _) -> Ident.fieldname_equal f f') fsel in + let _, se' = IList.find (fun (f', _) -> Ident.fieldname_equal f f') fsel in let atoms_se_typ_list' = _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se' typ' off' inst in let replace acc (res_atoms', res_se', res_typ') = let replace_fse = replace_fv res_se' in - let res_fsel' = list_sort Sil.fld_strexp_compare (list_map replace_fse fsel) in + let res_fsel' = IList.sort Sil.fld_strexp_compare (IList.map replace_fse fsel) in let replace_fta (f, t, a) = let f', t' = replace_fv res_typ' (f, t) in (f', t', a) in - let res_ftl' = list_sort Sil.fld_typ_ann_compare (list_map replace_fta ftal) in + let res_ftl' = IList.sort Sil.fld_typ_ann_compare (IList.map replace_fta ftal) in (res_atoms', Sil.Estruct (res_fsel', inst'), Sil.Tstruct (res_ftl', sftal, csu, nameo, supers, def_mthds, iann)) :: acc in - list_fold_left replace [] atoms_se_typ_list' + IList.fold_left replace [] atoms_se_typ_list' with Not_found -> let atoms', se', res_typ' = create_struct_values pname tenv orig_prop footprint_part kind max_stamp typ' off' inst in - let res_fsel' = list_sort Sil.fld_strexp_compare ((f, se'):: fsel) in + let res_fsel' = IList.sort Sil.fld_strexp_compare ((f, se'):: fsel) in let replace_fta (f', t', a') = if Ident.fieldname_equal f' f then (f, res_typ', a') else (f', t', a') in - let res_ftl' = list_sort Sil.fld_typ_ann_compare (list_map replace_fta ftal) in + let res_ftl' = IList.sort Sil.fld_typ_ann_compare (IList.map replace_fta ftal) in [(atoms', Sil.Estruct (res_fsel', inst'), Sil.Tstruct (res_ftl', sftal, csu, nameo, supers, def_mthds, iann))] end | (Sil.Off_fld (f, _)):: off', _, _ -> @@ -247,17 +247,17 @@ let rec _strexp_extend_values bounds_check pname tenv orig_prop size e (State.get_loc ()); begin try - let _, se' = list_find (fun (e', _) -> Sil.exp_equal e e') esel in + let _, se' = IList.find (fun (e', _) -> Sil.exp_equal e e') esel in let atoms_se_typ_list' = _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se' typ' off' inst in let replace acc (res_atoms', res_se', res_typ') = let replace_ise ise = if Sil.exp_equal e (fst ise) then (e, res_se') else ise in - let res_esel' = list_map replace_ise esel in - if (Sil.typ_equal res_typ' typ') || (list_length res_esel' = 1) + let res_esel' = IList.map replace_ise esel in + if (Sil.typ_equal res_typ' typ') || (IList.length res_esel' = 1) then (res_atoms', Sil.Earray(size, res_esel', inst_arr), Sil.Tarray(res_typ', size_for_typ')) :: acc else raise (Exceptions.Bad_footprint (try assert false with Assert_failure x -> x)) in - list_fold_left replace [] atoms_se_typ_list' + IList.fold_left replace [] atoms_se_typ_list' with Not_found -> array_case_analysis_index pname tenv orig_prop footprint_part kind max_stamp @@ -278,10 +278,10 @@ and array_case_analysis_index pname tenv orig_prop if not (Sil.typ_equal typ_cont t' || array_cont == []) then raise (Exceptions.Bad_footprint (try assert false with Assert_failure x -> x)) in let index_in_array = - list_exists (fun (i, _) -> Prover.check_equal Prop.prop_emp index i) array_cont in + IList.exists (fun (i, _) -> Prover.check_equal Prop.prop_emp index i) array_cont in let array_is_full = match array_size with - | Sil.Const (Sil.Cint n') -> Sil.Int.geq (Sil.Int.of_int (list_length array_cont)) n' + | Sil.Const (Sil.Cint n') -> Sil.Int.geq (Sil.Int.of_int (IList.length array_cont)) n' | _ -> false in if index_in_array then @@ -293,7 +293,7 @@ and array_case_analysis_index pname tenv orig_prop create_struct_values pname tenv orig_prop footprint_part kind max_stamp typ_cont off inst in check_sound elem_typ; - let cont_new = list_sort Sil.exp_strexp_compare ((index, elem_se):: array_cont) in + let cont_new = IList.sort Sil.exp_strexp_compare ((index, elem_se):: array_cont) in let array_new = Sil.Earray(array_size, cont_new, inst_arr) in let typ_new = Sil.Tarray(elem_typ, typ_array_size) in [(atoms, array_new, typ_new)] @@ -306,19 +306,19 @@ and array_case_analysis_index pname tenv orig_prop create_struct_values pname tenv orig_prop footprint_part kind max_stamp typ_cont off inst in check_sound elem_typ; - let cont_new = list_sort Sil.exp_strexp_compare ((index, elem_se):: array_cont) in + let cont_new = IList.sort Sil.exp_strexp_compare ((index, elem_se):: array_cont) in let array_new = Sil.Earray(array_size, cont_new, inst_arr) in let typ_new = Sil.Tarray(elem_typ, typ_array_size) in [(atoms, array_new, typ_new)] end in let rec handle_case acc isel_seen_rev = function - | [] -> list_flatten (list_rev (res_new:: acc)) + | [] -> IList.flatten (IList.rev (res_new:: acc)) | (i, se) as ise :: isel_unseen -> let atoms_se_typ_list = _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se typ_cont off inst in let atoms_se_typ_list' = - list_fold_left (fun acc' (atoms', se', typ') -> + IList.fold_left (fun acc' (atoms', se', typ') -> check_sound typ'; let atoms_new = Sil.Aeq(index, i) :: atoms' in let isel_new = list_rev_and_concat isel_seen_rev ((i, se'):: isel_unseen) in @@ -341,7 +341,7 @@ let laundry_offset_for_footprint max_stamp offs_in = let rec laundry offs_seen eqs offs = match offs with | [] -> - (list_rev offs_seen, list_rev eqs) + (IList.rev offs_seen, IList.rev eqs) | (Sil.Off_fld _ as off):: offs' -> let offs_seen' = off:: offs_seen in laundry offs_seen' eqs offs' @@ -367,7 +367,7 @@ let strexp_extend_values let off', eqs = laundry_offset_for_footprint max_stamp off in (* do laundry_offset whether footprint_part is true or not, so max_stamp is modified anyway *) if footprint_part then - off', list_map (fun (id, e) -> Prop.mk_eq (Sil.Var id) e) eqs + off', IList.map (fun (id, e) -> Prop.mk_eq (Sil.Var id) e) eqs else off, [] in if !Config.trace_rearrange then (L.d_str "entering strexp_extend_values se: "; Sil.d_sexp se; L.d_str " typ: "; Sil.d_typ_full typ; L.d_str " off': "; Sil.d_offset_list off'; L.d_strln (if footprint_part then " FP" else " RE")); @@ -377,13 +377,13 @@ let strexp_extend_values let atoms_se_typ_list_filtered = let neg_atom = function Sil.Aeq(e1, e2) -> Sil.Aneq(e1, e2) | Sil.Aneq(e1, e2) -> Sil.Aeq(e1, e2) in let check_neg_atom atom = Prover.check_atom Prop.prop_emp (neg_atom atom) in - let check_not_inconsistent (atoms, _, _) = not (list_exists check_neg_atom atoms) in - list_filter check_not_inconsistent atoms_se_typ_list in + let check_not_inconsistent (atoms, _, _) = not (IList.exists check_neg_atom atoms) in + IList.filter check_not_inconsistent atoms_se_typ_list in if !Config.trace_rearrange then L.d_strln "exiting strexp_extend_values"; let st = match te with | Sil.Sizeof(_, st) -> st | _ -> Sil.Subtype.exact in - list_map (fun (atoms', se', typ') -> (laundry_atoms @ atoms', se', Sil.Sizeof (typ', st))) atoms_se_typ_list_filtered + IList.map (fun (atoms', se', typ') -> (laundry_atoms @ atoms', se', Sil.Sizeof (typ', st))) atoms_se_typ_list_filtered let collect_root_offset exp = let root = Sil.root_of_lexp exp in @@ -432,7 +432,7 @@ let mk_ptsto_exp_footprint let atoms, ptsto_foot = create_ptsto true off_foot in let sub = Sil.sub_of_list eqs in let ptsto = Sil.hpred_sub sub ptsto_foot in - let atoms' = list_map (fun (id, e) -> Prop.mk_eq (Sil.Var id) e) eqs in + let atoms' = IList.map (fun (id, e) -> Prop.mk_eq (Sil.Var id) e) eqs in (ptsto, ptsto_foot, atoms @ atoms') (** Check if the path in exp exists already in the current ptsto predicate. @@ -449,7 +449,7 @@ let prop_iter_check_fields_ptsto_shallow iter lexp = (match se with | Sil.Estruct (fsel, _) -> (try - let _, se' = list_find (fun (fld', _) -> Sil.fld_equal fld fld') fsel in + let _, se' = IList.find (fun (fld', _) -> Sil.fld_equal fld fld') fsel in check_offset se' off' with Not_found -> Some fld) | _ -> Some fld) @@ -459,7 +459,7 @@ let prop_iter_check_fields_ptsto_shallow iter lexp = let fav_max_stamp fav = let max_stamp = ref 0 in let f id = max_stamp := max !max_stamp (Ident.get_stamp id) in - list_iter f (Sil.fav_to_list fav); + IList.iter f (Sil.fav_to_list fav); max_stamp (** [prop_iter_extend_ptsto iter lexp] extends the current psto @@ -476,7 +476,7 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst = let atoms_se_te_list = strexp_extend_values pname tenv orig_prop true Ident.kfootprint (ref max_stamp_val) se te offset inst in - list_map (fun (atoms', se', te') -> (atoms', Sil.Hpointsto (e, se', te'))) atoms_se_te_list + IList.map (fun (atoms', se', te') -> (atoms', Sil.Hpointsto (e, se', te'))) atoms_se_te_list | Sil.Hlseg (k, hpara, e1, e2, el) -> begin match hpara.Sil.body with @@ -486,15 +486,15 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst = pname tenv orig_prop true Ident.kfootprint (ref max_stamp_val) se' te' offset inst in let atoms_body_list = - list_map (fun (atoms0, se0, te0) -> (atoms0, Sil.Hpointsto(e', se0, te0):: body_rest)) atoms_se_te_list in + IList.map (fun (atoms0, se0, te0) -> (atoms0, Sil.Hpointsto(e', se0, te0):: body_rest)) atoms_se_te_list in let atoms_hpara_list = - list_map (fun (atoms, body') -> (atoms, { hpara with Sil.body = body'})) atoms_body_list in - list_map (fun (atoms, hpara') -> (atoms, Sil.Hlseg(k, hpara', e1, e2, el))) atoms_hpara_list + IList.map (fun (atoms, body') -> (atoms, { hpara with Sil.body = body'})) atoms_body_list in + IList.map (fun (atoms, hpara') -> (atoms, Sil.Hlseg(k, hpara', e1, e2, el))) atoms_hpara_list | _ -> assert false end | _ -> assert false in let atoms_se_te_to_iter e (atoms, se, te) = - let iter' = list_fold_left (Prop.prop_iter_add_atom !Config.footprint) iter atoms in + let iter' = IList.fold_left (Prop.prop_iter_add_atom !Config.footprint) iter atoms in Prop.prop_iter_update_current iter' (Sil.Hpointsto (e, se, te)) in let do_extend e se te = if !Config.trace_rearrange then begin @@ -510,7 +510,7 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst = let atoms_se_te_list = strexp_extend_values pname tenv orig_prop false extend_kind max_stamp se te offset inst in - list_map (atoms_se_te_to_iter e) atoms_se_te_list in + IList.map (atoms_se_te_to_iter e) atoms_se_te_list in let res_iter_list = if Ident.kind_equal extend_kind Ident.kprimed then iter_list (* normal part already extended: nothing to do *) @@ -518,7 +518,7 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst = let atoms_fp_sigma_list = let footprint_sigma = Prop.prop_iter_get_footprint_sigma iter in let sigma_pto, sigma_rest = - list_partition (function + IList.partition (function | Sil.Hpointsto(e', _, _) -> Sil.exp_equal e e' | Sil.Hlseg (_, _, e1, e2, _) -> Sil.exp_equal e e1 | Sil.Hdllseg (_, _, e_iF, e_oB, e_oF, e_iB, _) -> Sil.exp_equal e e_iF || Sil.exp_equal e e_iB @@ -527,19 +527,19 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst = match sigma_pto with | [hpred] -> let atoms_hpred_list = extend_footprint_pred hpred in - list_map (fun (atoms, hpred') -> (atoms, hpred' :: sigma_rest)) atoms_hpred_list + IList.map (fun (atoms, hpred') -> (atoms, hpred' :: sigma_rest)) atoms_hpred_list | _ -> L.d_warning "Cannot extend "; Sil.d_exp lexp; L.d_strln " in"; Prop.d_prop (Prop.prop_iter_to_prop iter); L.d_ln(); [([], footprint_sigma)] in - list_map (fun (atoms, sigma') -> (atoms, list_stable_sort Sil.hpred_compare sigma')) atoms_sigma_list in + IList.map (fun (atoms, sigma') -> (atoms, IList.stable_sort Sil.hpred_compare sigma')) atoms_sigma_list in let iter_atoms_fp_sigma_list = list_product iter_list atoms_fp_sigma_list in - list_map (fun (iter, (atoms, fp_sigma)) -> - let iter' = list_fold_left (Prop.prop_iter_add_atom !Config.footprint) iter atoms in + IList.map (fun (iter, (atoms, fp_sigma)) -> + let iter' = IList.fold_left (Prop.prop_iter_add_atom !Config.footprint) iter atoms in Prop.prop_iter_replace_footprint_sigma iter' fp_sigma ) iter_atoms_fp_sigma_list in let res_prop_list = - list_map Prop.prop_iter_to_prop res_iter_list in + IList.map Prop.prop_iter_to_prop res_iter_list in begin L.d_str "in prop_iter_extend_ptsto lexp: "; Sil.d_exp lexp; L.d_ln (); L.d_strln "prop before:"; @@ -573,7 +573,7 @@ let prop_iter_add_hpred_footprint_to_prop pname tenv prop (lexp, typ) inst = let foot_sigma = ptsto_foot :: Prop.get_sigma_footprint eprop in let nfoot_sigma = Prop.sigma_normalize_prop Prop.prop_emp foot_sigma in let prop' = Prop.normalize (Prop.replace_sigma_footprint nfoot_sigma eprop) in - let prop_new = list_fold_left (Prop.prop_atom_and ~footprint:!Config.footprint) prop' atoms in + let prop_new = IList.fold_left (Prop.prop_atom_and ~footprint:!Config.footprint) prop' atoms in let iter = match (Prop.prop_iter_create prop_new) with | None -> let prop_new' = Prop.normalize (Prop.prop_hpred_star prop_new ptsto) in @@ -599,14 +599,14 @@ let prop_iter_add_hpred_footprint pname tenv orig_prop iter (lexp, typ) inst = L.d_ln (); L.d_ln (); let foot_sigma = ptsto_foot :: (Prop.prop_iter_get_footprint_sigma iter) in let iter_foot = Prop.prop_iter_prev_then_insert iter ptsto in - let iter_foot_atoms = list_fold_left (Prop.prop_iter_add_atom (!Config.footprint)) iter_foot atoms in + let iter_foot_atoms = IList.fold_left (Prop.prop_iter_add_atom (!Config.footprint)) iter_foot atoms in let iter' = Prop.prop_iter_replace_footprint_sigma iter_foot_atoms foot_sigma in let offsets_default = Sil.exp_get_offsets lexp in Prop.prop_iter_set_state iter' offsets_default let sort_ftl ftl = let compare (f1, _) (f2, _) = Sil.fld_compare f1 f2 in - list_sort compare ftl + IList.sort compare ftl exception ARRAY_ACCESS @@ -663,18 +663,18 @@ let iter_rearrange_ptsto pname tenv orig_prop iter lexp inst = strexp_extend_values pname tenv orig_prop false Ident.kprimed max_stamp se te offset inst in let handle_case (atoms', se', te') = - let iter' = list_fold_left (Prop.prop_iter_add_atom !Config.footprint) iter atoms' in + let iter' = IList.fold_left (Prop.prop_iter_add_atom !Config.footprint) iter atoms' in Prop.prop_iter_update_current iter' (Sil.Hpointsto (e, se', te')) in let filter it = let p = Prop.prop_iter_to_prop it in not (Prover.check_inconsistency p) in - list_filter filter (list_map handle_case atoms_se_te_list) + IList.filter filter (IList.map handle_case atoms_se_te_list) | _ -> [iter] end in begin if !Config.trace_rearrange then begin L.d_strln "exiting iter_rearrange_ptsto, returning results"; - Prop.d_proplist_with_typ (list_map Prop.prop_iter_to_prop res); + Prop.d_proplist_with_typ (IList.map Prop.prop_iter_to_prop res); L.d_decrease_indent 1; L.d_ln (); L.d_ln () end; @@ -796,7 +796,7 @@ let type_at_offset texp off = (try let typ' = (fun (x, y, z) -> y) - (list_find (fun (f', t', a') -> Ident.fieldname_equal f f') ftal) in + (IList.find (fun (f', t', a') -> Ident.fieldname_equal f f') ftal) in strip_offset off' typ' with Not_found -> None) | (Sil.Off_index _):: off', Sil.Tarray (typ', _) -> @@ -882,7 +882,7 @@ let rec iter_rearrange if Prover.check_inconsistency prop' then [] else iter_rearrange pname tenv (Prop.lexp_normalize_prop prop' lexp) typ prop' iter' inst in let rec f_many_iters iters_lst = function - | [] -> list_flatten (list_rev iters_lst) + | [] -> IList.flatten (IList.rev iters_lst) | iter':: iters' -> let iters_res' = f_one_iter iter' in f_many_iters (iters_res':: iters_lst) iters' in @@ -924,7 +924,7 @@ let rec iter_rearrange end in if !Config.trace_rearrange then begin L.d_strln "exiting iter_rearrange, returning results"; - Prop.d_proplist_with_typ (list_map Prop.prop_iter_to_prop res); + Prop.d_proplist_with_typ (IList.map Prop.prop_iter_to_prop res); L.d_decrease_indent 1; L.d_ln (); L.d_ln () end; @@ -936,7 +936,7 @@ let check_dereference_error pdesc (prop : Prop.normal Prop.t) lexp loc = (* return true if deref_exp is only pointed to by fields/params with @Nullable annotations *) let is_only_pt_by_nullable_fld_or_param deref_exp = let ann_sig = Models.get_modelled_annotated_signature (Specs.pdesc_resolve_attributes pdesc) in - list_for_all + IList.for_all (fun hpred -> match hpred with | Sil.Hpointsto (Sil.Lvar pvar, Sil.Eexp (Sil.Var _ as exp, _), _) @@ -959,7 +959,7 @@ let check_dereference_error pdesc (prop : Prop.normal Prop.t) lexp loc = nullable_obj_str := Some (Ident.fieldname_to_simplified_string fld); is_nullable | _ -> true in - list_for_all is_strexp_pt_by_nullable_fld flds + IList.for_all is_strexp_pt_by_nullable_fld flds | _ -> true) (Prop.get_sigma prop) && !nullable_obj_str <> None in @@ -1046,7 +1046,7 @@ let check_call_to_objc_block_error pdesc prop fun_exp loc = match get_exp_called () with | Some (_, Sil.Lvar pvar) -> (* pvar is the block *) let name = Sil.pvar_get_name pvar in - list_exists (fun (cn, _) -> (Mangled.to_string name) = (Mangled.to_string cn)) (Cfg.Procdesc.get_captured pdesc) + IList.exists (fun (cn, _) -> (Mangled.to_string name) = (Mangled.to_string cn)) (Cfg.Procdesc.get_captured pdesc) | _ -> false in let is_field_deref () = (*Called expression is a field *) match get_exp_called () with diff --git a/infer/src/backend/sil.ml b/infer/src/backend/sil.ml index e52f4d723..b18bb23aa 100644 --- a/infer/src/backend/sil.ml +++ b/infer/src/backend/sil.ml @@ -37,18 +37,18 @@ type access = Default | Public | Private | Protected (** Compare function for annotations. *) let annotation_compare a1 a2 = let n = string_compare a1.class_name a2.class_name in - if n <> 0 then n else list_compare string_compare a1.parameters a2.parameters + if n <> 0 then n else IList.compare string_compare a1.parameters a2.parameters (** Compare function for annotation items. *) let item_annotation_compare ia1 ia2 = let cmp (a1, b1) (a2, b2) = let n = annotation_compare a1 a2 in if n <> 0 then n else bool_compare b1 b2 in - list_compare cmp ia1 ia2 + IList.compare cmp ia1 ia2 (** Compare function for Method annotations. *) let method_annotation_compare (ia1, ial1) (ia2, ial2) = - list_compare item_annotation_compare (ia1 :: ial1) (ia2 :: ial2) + IList.compare item_annotation_compare (ia1 :: ial1) (ia2 :: ial2) (** Empty item annotation. *) let item_annotation_empty = [] @@ -65,7 +65,7 @@ let item_annotation_is_empty ia = ia = [] (** Check if the method annodation is empty. *) let method_annotation_is_empty (ia, ial) = - list_for_all item_annotation_is_empty (ia :: ial) + IList.for_all item_annotation_is_empty (ia :: ial) (** Pretty print an annotation. *) let pp_annotation fmt annotation = F.fprintf fmt "@@%s" annotation.class_name @@ -84,7 +84,7 @@ let get_sentinel_func_attribute_value attr_list = (* Sentinel is the only kind of attributes *) let is_sentinel a = true in try - match list_find is_sentinel attr_list with + match IList.find is_sentinel attr_list with | FA_sentinel (sentinel, null_pos) -> Some (sentinel, null_pos) with Not_found -> None @@ -216,14 +216,9 @@ module Subtype = struct let s = (aux rest) in if (s = "") then (Mangled.to_string el) else (Mangled.to_string el)^", "^s in - if (list_length list = 0) then "( sub )" + if (IList.length list = 0) then "( sub )" else ("- {"^(aux list)^"}") - let list_equal list1 list2 = - if (list_length list1 = list_length list2) then - list_for_all2 Mangled.equal list1 list2 - else false - type t' = | Exact (** denotes the current type only *) | Subtypes of Mangled.t list(** denotes the current type and a list of types that are not their subtypes *) @@ -278,8 +273,8 @@ module Subtype = struct let is_instof t = snd t = INSTOF let list_intersect equal l1 l2 = - let in_l2 a = list_mem equal a l2 in - list_filter in_l2 l1 + let in_l2 a = IList.mem equal a l2 in + IList.filter in_l2 l1 let join_flag flag1 flag2 = match flag1, flag2 with @@ -297,7 +292,7 @@ module Subtype = struct s, flag let subtypes_compare l1 l2 = - list_compare Mangled.compare l1 l2 + IList.compare Mangled.compare l1 l2 let compare_flag flag1 flag2 = match flag1, flag2 with @@ -348,7 +343,7 @@ module Subtype = struct (match t with | Exact -> Some (t, new_flag) | Subtypes l -> - Some (Subtypes (list_sort Mangled.compare l), new_flag)) + Some (Subtypes (IList.sort Mangled.compare l), new_flag)) | None -> None let subtypes_to_string t = @@ -358,7 +353,7 @@ module Subtype = struct (* c is a subtype when it does not appear in the list l of no-subtypes *) let is_subtype f c l = - try ignore( list_find (f c) l); false + try ignore( IList.find (f c) l); false with Not_found -> true let is_strict_subtype f c1 c2 = @@ -375,7 +370,7 @@ module Subtype = struct else if (f c ci) then (ci:: l, false) else (ci:: l, true) in l, (add && should_add) in - (list_fold_left aux ([], true) l) + (IList.fold_left aux ([], true) l) let rec updates_head f c l = match l with @@ -832,7 +827,7 @@ let is_objc_ref_counter_field (fld, t, a) = let has_objc_ref_counter hpred = match hpred with | Hpointsto(_, _, Sizeof(Tstruct(fl, _, _, _, _, _, _), _)) -> - list_exists is_objc_ref_counter_field fl + IList.exists is_objc_ref_counter_field fl | _ -> false (** turn a *T into a T. fails if [typ] is not a pointer type *) @@ -1295,7 +1290,7 @@ let rec const_compare (c1 : const) (c2 : const) : int = if n <> 0 then n else typ_compare t1 t2 | Cptr_to_fld _, _ -> -1 | _, Cptr_to_fld _ -> 1 - | Ctuple el1, Ctuple el2 -> list_compare exp_compare el1 el2 + | Ctuple el1, Ctuple el2 -> IList.compare exp_compare el1 el2 (** Comparision for types. *) and typ_compare t1 t2 = @@ -1335,7 +1330,7 @@ and typ_compare t1 t2 = let compare_pair (n1, e1) (n2, e2) = let n = Mangled.compare n1 n2 in if n <> 0 then n else const_compare e1 e2 in - list_compare compare_pair l1 l2 + IList.compare compare_pair l1 l2 and typ_opt_compare to1 to2 = match to1, to2 with | None, None -> 0 @@ -1347,7 +1342,7 @@ and fld_typ_ann_compare fta1 fta2 = triple_compare fld_compare typ_compare item_annotation_compare fta1 fta2 and fld_typ_ann_list_compare ftal1 ftal2 = - list_compare fld_typ_ann_compare ftal1 ftal2 + IList.compare fld_typ_ann_compare ftal1 ftal2 and attribute_compare (att1 : attribute) (att2 : attribute) : int = match att1, att2 with @@ -1448,7 +1443,7 @@ let ident_exp_equal ide1 ide2 = ident_exp_compare ide1 ide2 = 0 let exp_list_compare = - list_compare exp_compare + IList.compare exp_compare let exp_list_equal el1 el2 = exp_list_compare el1 el2 = 0 @@ -1473,7 +1468,7 @@ let atom_equal x y = atom_compare x y = 0 let atom_list_compare l1 l2 = - list_compare atom_compare l1 l2 + IList.compare atom_compare l1 l2 let lseg_kind_compare k1 k2 = match k1, k2 with | Lseg_NE, Lseg_NE -> 0 @@ -1502,13 +1497,13 @@ and fld_strexp_compare fse1 fse2 = pair_compare fld_compare strexp_compare fse1 fse2 and fld_strexp_list_compare fsel1 fsel2 = - list_compare fld_strexp_compare fsel1 fsel2 + IList.compare fld_strexp_compare fsel1 fsel2 and exp_strexp_compare ese1 ese2 = pair_compare exp_compare strexp_compare ese1 ese2 and exp_strexp_list_compare esel1 esel2 = - list_compare exp_strexp_compare esel1 esel2 + IList.compare exp_strexp_compare esel1 esel2 (** Comparsion between heap predicates. Hpointsto comes before others. *) and hpred_compare hpred1 hpred2 = @@ -1561,7 +1556,7 @@ and hpred_compare hpred1 hpred2 = else exp_list_compare el2 el1 and hpred_list_compare l1 l2 = - list_compare hpred_compare l1 l2 + IList.compare hpred_compare l1 l2 and hpara_compare hp1 hp2 = let n = Ident.compare hp1.root hp2.root in @@ -1631,7 +1626,7 @@ module ExpMap = Map.Make(struct let elist_to_eset es = - list_fold_left (fun set e -> ExpSet.add e set) ExpSet.empty es + IList.fold_left (fun set e -> ExpSet.add e set) ExpSet.empty es (** {2 Sets of heap predicates} *) @@ -1793,7 +1788,7 @@ let pp_pvar_list pe f pvl = (** Dump a list of program variables. *) let d_pvar_list pvl = - list_iter (fun pv -> d_pvar pv; L.d_str " ") pvl + IList.iter (fun pv -> d_pvar pv; L.d_str " ") pvl let ikind_to_string = function | IChar -> "char" @@ -2134,13 +2129,13 @@ let instr_get_exps = function | Prune (cond, _, _, _) -> [cond] | Call (ret_ids, e, _, _, _) -> - e :: (list_map (fun id -> Var id)) ret_ids + e :: (IList.map (fun id -> Var id)) ret_ids | Nullify (pvar, _, _) -> [Lvar pvar] | Abstract _ -> [] | Remove_temps (temps, _) -> - list_map (fun id -> Var id) temps + IList.map (fun id -> Var id) temps | Stackop _ -> [] | Declare_locals _ -> @@ -2227,7 +2222,7 @@ let rec typ_iter_types (f : typ -> unit) typ = | Tptr (t', pk) -> typ_iter_types f t' | Tstruct (ftal, sftal, csu, nameo, supers, def_mthds, iann) -> - list_iter (fun (_, t, _) -> typ_iter_types f t) ftal + IList.iter (fun (_, t, _) -> typ_iter_types f t) ftal | Tarray (t, e) -> typ_iter_types f t; exp_iter_types f e @@ -2241,7 +2236,7 @@ and exp_iter_types f e = | Const (Cexn e1) -> exp_iter_types f e1 | Const (Ctuple el) -> - list_iter (exp_iter_types f) el + IList.iter (exp_iter_types f) el | Const _ -> () | Cast (t, e1) -> @@ -2279,7 +2274,7 @@ let instr_iter_types f instr = match instr with exp_iter_types f cond | Call (ret_ids, e, arg_ts, loc, cf) -> exp_iter_types f e; - list_iter (fun (e, t) -> exp_iter_types f e; typ_iter_types f t) arg_ts + IList.iter (fun (e, t) -> exp_iter_types f e; typ_iter_types f t) arg_ts | Nullify (pvar, loc, deallocate) -> () | Abstract loc -> @@ -2289,7 +2284,7 @@ let instr_iter_types f instr = match instr with | Stackop (stackop, loc) -> () | Declare_locals (ptl, loc) -> - list_iter (fun (_, t) -> typ_iter_types f t) ptl + IList.iter (fun (_, t) -> typ_iter_types f t) ptl | Goto_node _ -> () @@ -2420,19 +2415,19 @@ end = struct let rec process_sexp env = function | Eexp _ -> () | Earray (_, esel, _) -> - list_iter (fun (e, se) -> process_sexp env se) esel + IList.iter (fun (e, se) -> process_sexp env se) esel | Estruct (fsel, _) -> - list_iter (fun (f, se) -> process_sexp env se) fsel + IList.iter (fun (f, se) -> process_sexp env se) fsel (** Process one hpred, updating env *) let rec process_hpred env = function | Hpointsto (_, se, _) -> process_sexp env se | Hlseg (_, hpara, _, _, _) -> - list_iter (process_hpred env) hpara.body; + IList.iter (process_hpred env) hpara.body; process_hpara env hpara | Hdllseg(_, hpara_dll, _, _, _, _, _) -> - list_iter (process_hpred env) hpara_dll.body_dll; + IList.iter (process_hpred env) hpara_dll.body_dll; process_hpara_dll env hpara_dll (** create an empty predicate environment *) @@ -2452,15 +2447,15 @@ end = struct while env.todo != [] || env.todo_dll != [] do if env.todo != [] then begin - let hpara = list_hd env.todo in - let () = env.todo <- list_tl env.todo in + let hpara = IList.hd env.todo in + let () = env.todo <- IList.tl env.todo in let (n, emitted) = HparaHash.find env.hash hpara in if not emitted then f n hpara end else if env.todo_dll != [] then begin - let hpara_dll = list_hd env.todo_dll in - let () = env.todo_dll <- list_tl env.todo_dll in + let hpara_dll = IList.hd env.todo_dll in + let () = env.todo_dll <- IList.tl env.todo_dll in let (n, emitted) = HparaDllHash.find env.hash_dll hpara_dll in if not emitted then f_dll n hpara_dll end @@ -2527,7 +2522,7 @@ let inst_to_string inst = let inst_partial_join inst1 inst2 = let fail () = L.d_strln ("inst_partial_join failed on " ^ inst_to_string inst1 ^ " " ^ inst_to_string inst2); - raise Fail in + raise IList.Fail in if inst1 = inst2 then inst1 else match inst1, inst2 with | _, Inone | Inone, _ -> inst_none @@ -2741,13 +2736,13 @@ let rec strexp_expmap (f: exp * inst option -> exp * inst option) = Eexp (e', inst') | Estruct (fld_se_list, inst) -> let f_fld_se (fld, se) = (fld, strexp_expmap f se) in - Estruct (list_map f_fld_se fld_se_list, inst) + Estruct (IList.map f_fld_se fld_se_list, inst) | Earray (size, idx_se_list, inst) -> let size' = fe size in let f_idx_se (idx, se) = let idx' = fe idx in (idx', strexp_expmap f se) in - Earray (size', list_map f_idx_se idx_se_list, inst) + Earray (size', IList.map f_idx_se idx_se_list, inst) let hpred_expmap (f: exp * inst option -> exp * inst option) = let fe e = fst (f (e, None)) in @@ -2760,14 +2755,14 @@ let hpred_expmap (f: exp * inst option -> exp * inst option) = | Hlseg (k, hpara, root, next, shared) -> let root' = fe root in let next' = fe next in - let shared' = list_map fe shared in + let shared' = IList.map fe shared in Hlseg (k, hpara, root', next', shared') | Hdllseg (k, hpara, iF, oB, oF, iB, shared) -> let iF' = fe iF in let oB' = fe oB in let oF' = fe oF in let iB' = fe iB in - let shared' = list_map fe shared in + let shared' = IList.map fe shared in Hdllseg (k, hpara, iF', oB', oF', iB', shared') let rec strexp_instmap (f: inst -> inst) strexp = match strexp with @@ -2775,17 +2770,17 @@ let rec strexp_instmap (f: inst -> inst) strexp = match strexp with Eexp (e, f inst) | Estruct (fld_se_list, inst) -> let f_fld_se (fld, se) = (fld, strexp_instmap f se) in - Estruct (list_map f_fld_se fld_se_list, f inst) + Estruct (IList.map f_fld_se fld_se_list, f inst) | Earray (size, idx_se_list, inst) -> let f_idx_se (idx, se) = (idx, strexp_instmap f se) in - Earray (size, list_map f_idx_se idx_se_list, f inst) + Earray (size, IList.map f_idx_se idx_se_list, f inst) and hpara_instmap (f: inst -> inst) hpara = - { hpara with body = list_map (hpred_instmap f) hpara.body } + { hpara with body = IList.map (hpred_instmap f) hpara.body } and hpara_dll_instmap (f: inst -> inst) hpara_dll = - { hpara_dll with body_dll = list_map (hpred_instmap f) hpara_dll.body_dll } + { hpara_dll with body_dll = IList.map (hpred_instmap f) hpara_dll.body_dll } and hpred_instmap (fn: inst -> inst) (hpred: hpred) : hpred = match hpred with | Hpointsto (e, se, te) -> @@ -2797,14 +2792,14 @@ and hpred_instmap (fn: inst -> inst) (hpred: hpred) : hpred = match hpred with Hdllseg (k, hpara_dll_instmap fn hpar_dll, e, f, g, h, el) let hpred_list_expmap (f: exp * inst option -> exp * inst option) (hlist: hpred list) = - list_map (hpred_expmap f) hlist + IList.map (hpred_expmap f) hlist let atom_expmap (f: exp -> exp) = function | Aeq (e1, e2) -> Aeq (f e1, f e2) | Aneq (e1, e2) -> Aneq (f e1, f e2) let atom_list_expmap (f: exp -> exp) (alist: atom list) = - list_map (atom_expmap f) alist + IList.map (atom_expmap f) alist (** {2 Function for computing lexps in sigma} *) @@ -2814,8 +2809,8 @@ let hpred_get_lexp acc = function | Hdllseg(_, _, e1, _, _, e2, _) -> e1:: e2:: acc let hpred_list_get_lexps (filter: exp -> bool) (hlist: hpred list) : exp list = - let lexps = list_fold_left hpred_get_lexp [] hlist in - list_filter filter lexps + let lexps = IList.fold_left hpred_get_lexp [] hlist in + IList.filter filter lexps (** {2 Utility Functions for Expressions} *) @@ -2838,7 +2833,7 @@ let struct_typ_fld default_opt f = let def () = unsome_typ "struct_typ_fld" default_opt in function | Tstruct (ftal, sftal, _, _, _, _, _) -> - (try (fun (x, y, z) -> y) (list_find (fun (_f, t, ann) -> Ident.fieldname_equal _f f) ftal) + (try (fun (x, y, z) -> y) (IList.find (fun (_f, t, ann) -> Ident.fieldname_equal _f f) ftal) with Not_found -> def ()) | _ -> def () @@ -2922,7 +2917,7 @@ let rec exp_fpv = function | Lindex (e1, e2) -> exp_fpv e1 @ exp_fpv e2 | Sizeof _ -> [] -and exp_list_fpv el = list_flatten (list_map exp_fpv el) +and exp_list_fpv el = IList.flatten (IList.map exp_fpv el) let atom_fpv = function | Aeq (e1, e2) -> exp_fpv e1 @ exp_fpv e2 @@ -2932,11 +2927,11 @@ let rec strexp_fpv = function | Eexp (e, inst) -> exp_fpv e | Estruct (fld_se_list, inst) -> let f (_, se) = strexp_fpv se in - list_flatten (list_map f fld_se_list) + IList.flatten (IList.map f fld_se_list) | Earray (size, idx_se_list, inst) -> let fpv_in_size = exp_fpv size in let f (idx, se) = exp_fpv idx @ strexp_fpv se in - fpv_in_size @ list_flatten (list_map f idx_se_list) + fpv_in_size @ IList.flatten (IList.map f idx_se_list) and hpred_fpv = function | Hpointsto (base, se, te) -> @@ -2961,7 +2956,7 @@ and hpred_fpv = function analysis. In interprocedural analysis, we should consider the issue of scopes of program variables. *) and hpara_fpv para = - let fpvars_in_body = list_flatten (list_map hpred_fpv para.body) in + let fpvars_in_body = IList.flatten (IList.map hpred_fpv para.body) in match fpvars_in_body with | [] -> [] | _ -> assert false @@ -2971,7 +2966,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 = list_flatten (list_map hpred_fpv para.body_dll) in + let fpvars_in_body = IList.flatten (IList.map hpred_fpv para.body_dll) in match fpvars_in_body with | [] -> [] | _ -> assert false @@ -2991,22 +2986,22 @@ let fav_is_empty fav = match !fav with (** Check whether a predicate holds for all elements. *) let fav_for_all fav predicate = - list_for_all predicate !fav + IList.for_all predicate !fav (** Check whether a predicate holds for some elements. *) let fav_exists fav predicate = - list_exists predicate !fav + IList.exists predicate !fav (** flag to indicate whether fav's are stored in duplicate form -- only to be used with fav_to_list *) let fav_duplicates = ref false (** extend [fav] with a [id] *) let (++) fav id = - if !fav_duplicates || not (list_exists (Ident.equal id) !fav) then fav := id::!fav + if !fav_duplicates || not (IList.exists (Ident.equal id) !fav) then fav := id::!fav (** extend [fav] with ident list [idl] *) let (+++) fav idl = - list_iter (fun id -> fav ++ id) idl + IList.iter (fun id -> fav ++ id) idl (** add identity lists to fav *) let ident_list_fav_add idl fav = @@ -3015,7 +3010,7 @@ let ident_list_fav_add idl fav = (** Convert a list to a fav. *) let fav_from_list l = let fav = fav_new () in - let _ = list_iter (fun id -> fav ++ id) l in + let _ = IList.iter (fun id -> fav ++ id) l in fav let rec remove_duplicates_from_sorted special_equal = function @@ -3029,7 +3024,7 @@ let rec remove_duplicates_from_sorted special_equal = function (** Convert a [fav] to a list of identifiers while preserving the order that the identifiers were added to [fav]. *) let fav_to_list fav = - list_rev !fav + IList.rev !fav (** Pretty print a fav. *) let pp_fav pe f fav = @@ -3037,7 +3032,7 @@ let pp_fav pe f fav = (** Copy a [fav]. *) let fav_copy fav = - ref (list_map (fun x -> x) !fav) + ref (IList.map (fun x -> x) !fav) (** Turn a xxx_fav_add function into a xxx_fav function *) let fav_imperative_to_functional f x = @@ -3047,11 +3042,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 := list_filter filter !fav + fav := IList.filter filter !fav (** Like [fav_filter_ident] but return a copy. *) let fav_copy_filter_ident fav filter = - ref (list_filter filter !fav) + ref (IList.filter filter !fav) (** checks whether every element in l1 appears l2 **) let rec ident_sorted_list_subset l1 l2 = @@ -3070,12 +3065,12 @@ let fav_subset_ident fav1 fav2 = ident_sorted_list_subset (fav_to_list fav1) (fav_to_list fav2) let fav_mem fav id = - list_exists (Ident.equal id) !fav + IList.exists (Ident.equal id) !fav let rec exp_fav_add fav = function | Var id -> fav ++ id | Const (Cexn e) -> exp_fav_add fav e - | Const (Ctuple el) -> list_iter (exp_fav_add fav) el + | Const (Ctuple el) -> IList.iter (exp_fav_add fav) el | Const _ -> () | Cast (_, e) | UnOp (_, e, _) -> exp_fav_add fav e | BinOp (_, e1, e2) -> exp_fav_add fav e1; exp_fav_add fav e2 @@ -3110,22 +3105,22 @@ let hpara_dll_fav_add fav para = () (* Global invariant: hpara_dll is closed *) let rec strexp_fav_add fav = function | Eexp (e, inst) -> exp_fav_add fav e | Estruct (fld_se_list, inst) -> - list_iter (fun (_, se) -> strexp_fav_add fav se) fld_se_list + IList.iter (fun (_, se) -> strexp_fav_add fav se) fld_se_list | Earray (size, idx_se_list, inst) -> exp_fav_add fav size; - list_iter (fun (e, se) -> exp_fav_add fav e; strexp_fav_add fav se) idx_se_list + IList.iter (fun (e, se) -> exp_fav_add fav e; strexp_fav_add fav se) idx_se_list let hpred_fav_add fav = function | Hpointsto (base, sexp, te) -> exp_fav_add fav base; strexp_fav_add fav sexp; exp_fav_add fav te | Hlseg (_, para, e1, e2, elist) -> hpara_fav_add fav para; exp_fav_add fav e1; exp_fav_add fav e2; - list_iter (exp_fav_add fav) elist + IList.iter (exp_fav_add fav) elist | Hdllseg (_, para, e1, e2, e3, e4, elist) -> hpara_dll_fav_add fav para; exp_fav_add fav e1; exp_fav_add fav e2; exp_fav_add fav e3; exp_fav_add fav e4; - list_iter (exp_fav_add fav) elist + IList.iter (exp_fav_add fav) elist let hpred_fav = fav_imperative_to_functional hpred_fav_add @@ -3154,12 +3149,12 @@ let exp_av_add = exp_fav_add (** Expressions do not bind variables *) let strexp_av_add = strexp_fav_add (** Structured expressions do not bind variables *) let rec hpara_av_add fav para = - list_iter (hpred_av_add fav) para.body; + IList.iter (hpred_av_add fav) para.body; fav ++ para.root; fav ++ para.next; fav +++ para.svars; fav +++ para.evars and hpara_dll_av_add fav para = - list_iter (hpred_av_add fav) para.body_dll; + IList.iter (hpred_av_add fav) para.body_dll; fav ++ para.cell; fav ++ para.blink; fav ++ para.flink; fav +++ para.svars_dll; fav +++ para.evars_dll @@ -3169,20 +3164,20 @@ and hpred_av_add fav = function | Hlseg (_, para, e1, e2, elist) -> hpara_av_add fav para; exp_av_add fav e1; exp_av_add fav e2; - list_iter (exp_av_add fav) elist + IList.iter (exp_av_add fav) elist | Hdllseg (_, para, e1, e2, e3, e4, elist) -> hpara_dll_av_add fav para; exp_av_add fav e1; exp_av_add fav e2; exp_av_add fav e3; exp_av_add fav e4; - list_iter (exp_av_add fav) elist + IList.iter (exp_av_add fav) elist let hpara_shallow_av_add fav para = - list_iter (hpred_fav_add fav) para.body; + IList.iter (hpred_fav_add fav) para.body; fav ++ para.root; fav ++ para.next; fav +++ para.svars; fav +++ para.evars let hpara_dll_shallow_av_add fav para = - list_iter (hpred_fav_add fav) para.body_dll; + IList.iter (hpred_fav_add fav) para.body_dll; fav ++ para.cell; fav ++ para.blink; fav ++ para.flink; fav +++ para.svars_dll; fav +++ para.evars_dll @@ -3239,7 +3234,7 @@ let sub_check_duplicated_ids sub = sorted_list_check_consecutives f sub let sub_check_sortedness sub = - let sub' = list_sort ident_exp_compare sub in + let sub' = IList.sort ident_exp_compare sub in sub_equal sub sub' let sub_check_inv sub = @@ -3249,14 +3244,14 @@ let sub_check_inv sub = For all (id1, e1), (id2, e2) in the input list, if id1 = id2, then e1 = e2. *) let sub_of_list sub = - let sub' = list_sort ident_exp_compare sub in + let sub' = IList.sort ident_exp_compare sub in let sub'' = remove_duplicates_from_sorted ident_exp_equal sub' in (if sub_check_duplicated_ids sub'' then assert false); sub' (** like sub_of_list, but allow duplicate ids and only keep the first occurrence *) let sub_of_list_duplicates sub = - let sub' = list_sort ident_exp_compare sub in + let sub' = IList.sort ident_exp_compare sub in let rec remove_duplicate_ids = function | (id1, e1) :: (id2, e2) :: l -> if Ident.equal id1 id2 @@ -3308,46 +3303,46 @@ let typ_update_memo = Typtbl.create 17 (** [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 (list_find (fun (i, _) -> filter i) sub) + snd (IList.find (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) = - list_filter (fun (i, _) -> filter i) sub + IList.filter (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 = list_filter +let sub_filter_pair = IList.filter (** [sub_range_partition filter sub] partitions [sub] according to whether range expressions satisfy [filter]. *) let sub_range_partition filter (sub: subst) = - list_partition (fun (_, e) -> filter e) sub + IList.partition (fun (_, e) -> filter e) sub (** [sub_domain_partition filter sub] partitions [sub] according to whether domain identifiers satisfy [filter]. *) let sub_domain_partition filter (sub: subst) = - list_partition (fun (i, _) -> filter i) sub + IList.partition (fun (i, _) -> filter i) sub (** Return the list of identifiers in the domain of the substitution. *) let sub_domain sub = - list_map fst sub + IList.map fst sub (** Return the list of expressions in the range of the substitution. *) let sub_range sub = - list_map snd sub + IList.map snd sub (** [sub_range_map f sub] applies [f] to the expressions in the range of [sub]. *) let sub_range_map f sub = - sub_of_list (list_map (fun (i, e) -> (i, f e)) sub) + sub_of_list (IList.map (fun (i, e) -> (i, f e)) sub) (** [sub_map f g sub] applies the renaming [f] to identifiers in the domain of [sub] and the substitution [g] to the expressions in the range of [sub]. *) let sub_map f g sub = - sub_of_list (list_map (fun (i, e) -> (f i, g e)) sub) + sub_of_list (IList.map (fun (i, e) -> (f i, g e)) sub) let mem_sub id sub = - list_exists (fun (id1, _) -> Ident.equal id id1) sub + IList.exists (fun (id1, _) -> Ident.equal id id1) sub (** Extend substitution and return [None] if not possible. *) let extend_sub sub id exp : subst option = @@ -3358,10 +3353,10 @@ let extend_sub sub id exp : subst option = (** Free auxilary variables in the domain and range of the substitution. *) let sub_fav_add fav (sub: subst) = - list_iter (fun (id, e) -> fav ++ id; exp_fav_add fav e) sub + IList.iter (fun (id, e) -> fav ++ id; exp_fav_add fav e) sub let sub_fpv (sub: subst) = - list_flatten (list_map (fun (_, e) -> exp_fpv e) sub) + IList.flatten (IList.map (fun (_, e) -> exp_fpv e) sub) (** Substitutions do not contain binders *) let sub_av_add = sub_fav_add @@ -3393,7 +3388,7 @@ and exp_sub (subst: subst) e = let e1' = exp_sub subst e1 in Const (Cexn e1') | Const (Ctuple el) -> - let el' = list_map (exp_sub subst) el in + let el' = IList.map (exp_sub subst) el in Const (Ctuple el') | Const _ -> e @@ -3438,18 +3433,18 @@ let instr_sub (subst: subst) instr = Prune (exp_s cond, loc, true_branch, ik) | Call (ret_ids, e, arg_ts, loc, cf) -> let arg_s (e, t) = (exp_s e, typ_s t) in - Call (list_map id_s ret_ids, exp_s e, list_map arg_s arg_ts, loc, cf) + Call (IList.map id_s ret_ids, exp_s e, IList.map arg_s arg_ts, loc, cf) | Nullify (pvar, loc, deallocate) -> instr | Abstract loc -> instr | Remove_temps (temps, loc) -> - Remove_temps (list_map id_s temps, loc) + Remove_temps (IList.map id_s temps, loc) | Stackop (stackop, loc) -> instr | Declare_locals (ptl, loc) -> let pt_s (pv, t) = (pv, typ_s t) in - Declare_locals (list_map pt_s ptl, loc) + Declare_locals (IList.map pt_s ptl, loc) | Goto_node (e, loc) -> Goto_node (exp_s e, loc) @@ -3484,9 +3479,9 @@ let instr_compare instr1 instr2 = match instr1, instr2 with | Prune _, _ -> -1 | _, Prune _ -> 1 | Call (ret_ids1, e1, arg_ts1, loc1, cf1), Call (ret_ids2, e2, arg_ts2, loc2, cf2) -> - let n = list_compare Ident.compare ret_ids1 ret_ids2 in + let n = IList.compare Ident.compare ret_ids1 ret_ids2 in if n <> 0 then n else let n = exp_compare e1 e2 in - if n <> 0 then n else let n = list_compare exp_typ_compare arg_ts1 arg_ts2 in + if n <> 0 then n else let n = IList.compare exp_typ_compare arg_ts1 arg_ts2 in if n <> 0 then n else let n = Location.compare loc1 loc2 in if n <> 0 then n else call_flags_compare cf1 cf2 | Call _, _ -> -1 @@ -3502,7 +3497,7 @@ let instr_compare instr1 instr2 = match instr1, instr2 with | Abstract _, _ -> -1 | _, Abstract _ -> 1 | Remove_temps (temps1, loc1), Remove_temps (temps2, loc2) -> - let n = list_compare Ident.compare temps1 temps2 in + let n = IList.compare Ident.compare temps1 temps2 in if n <> 0 then n else Location.compare loc1 loc2 | Remove_temps _, _ -> -1 | _, Remove_temps _ -> 1 @@ -3516,7 +3511,7 @@ let instr_compare instr1 instr2 = match instr1, instr2 with let n = pvar_compare pv1 pv2 in if n <> 0 then n else typ_compare t1 t2 in - let n = list_compare pt_compare ptl1 ptl2 in + let n = IList.compare pt_compare ptl1 ptl2 in if n <> 0 then n else Location.compare loc1 loc2 | Declare_locals _, _ -> -1 | _, Declare_locals _ -> 1 @@ -3575,10 +3570,10 @@ let exp_typ_compare_structural (e1, t1) (e2, t2) exp_map = used in the procedure of [instr2] *) let instr_compare_structural instr1 instr2 exp_map = let id_list_compare_structural ids1 ids2 exp_map = - let n = Pervasives.compare (list_length ids1) (list_length ids2) in + let n = Pervasives.compare (IList.length ids1) (IList.length ids2) in if n <> 0 then n, exp_map else - list_fold_left2 + IList.fold_left2 (fun (n, exp_map) id1 id2 -> if n <> 0 then (n, exp_map) else exp_compare_structural (Var id1) (Var id2) exp_map) @@ -3607,10 +3602,10 @@ let instr_compare_structural instr1 instr2 exp_map = else Pervasives.compare ik1 ik2), exp_map | Call (ret_ids1, e1, arg_ts1, loc1, cf1), Call (ret_ids2, e2, arg_ts2, loc2, cf2) -> let args_compare_structural args1 args2 exp_map = - let n = Pervasives.compare (list_length args1) (list_length args2) in + let n = Pervasives.compare (IList.length args1) (IList.length args2) in if n <> 0 then n, exp_map else - list_fold_left2 + IList.fold_left2 (fun (n, exp_map) arg1 arg2 -> if n <> 0 then (n, exp_map) else exp_typ_compare_structural arg1 arg2 exp_map) @@ -3633,10 +3628,10 @@ let instr_compare_structural instr1 instr2 exp_map = | Stackop (stackop1, loc1), Stackop (stackop2, loc2) -> Pervasives.compare stackop1 stackop2, exp_map | Declare_locals (ptl1, loc1), Declare_locals (ptl2, loc2) -> - let n = Pervasives.compare (list_length ptl1) (list_length ptl2) in + let n = Pervasives.compare (IList.length ptl1) (IList.length ptl2) in if n <> 0 then n, exp_map else - list_fold_left2 + IList.fold_left2 (fun (n, exp_map) (pv1, t1) (pv2, t2) -> if n <> 0 then (n, exp_map) else @@ -3670,12 +3665,12 @@ let hpara_dll_sub subst para = para let exp_replace_exp epairs e = try - let (_, e') = list_find (fun (e1, _) -> exp_equal e e1) epairs in + let (_, e') = IList.find (fun (e1, _) -> exp_equal e e1) epairs in e' with Not_found -> e let exp_list_replace_exp epairs l = - list_map (exp_replace_exp epairs) l + IList.map (exp_replace_exp epairs) l let atom_replace_exp epairs = function | Aeq (e1, e2) -> @@ -3692,13 +3687,13 @@ let rec strexp_replace_exp epairs = function Eexp (exp_replace_exp epairs e, inst) | Estruct (fsel, inst) -> let f (fld, se) = (fld, strexp_replace_exp epairs se) in - Estruct (list_map f fsel, inst) + Estruct (IList.map f fsel, inst) | Earray (size, isel, inst) -> let size' = exp_replace_exp epairs size in let f (idx, se) = let idx' = exp_replace_exp epairs idx in (idx', strexp_replace_exp epairs se) in - Earray (size', list_map f isel, inst) + Earray (size', IList.map f isel, inst) let hpred_replace_exp epairs = function | Hpointsto (root, se, te) -> @@ -3709,14 +3704,14 @@ let hpred_replace_exp epairs = function | Hlseg (k, para, root, next, shared) -> let root_repl = exp_replace_exp epairs root in let next_repl = exp_replace_exp epairs next in - let shared_repl = list_map (exp_replace_exp epairs) shared in + let shared_repl = IList.map (exp_replace_exp epairs) shared in Hlseg (k, para, root_repl, next_repl, shared_repl) | Hdllseg (k, para, e1, e2, e3, e4, shared) -> let e1' = exp_replace_exp epairs e1 in let e2' = exp_replace_exp epairs e2 in let e3' = exp_replace_exp epairs e3 in let e4' = exp_replace_exp epairs e4 in - let shared_repl = list_map (exp_replace_exp epairs) shared in + let shared_repl = IList.map (exp_replace_exp epairs) shared in Hdllseg (k, para, e1', e2', e3', e4', shared_repl) (** {2 Compaction} *) @@ -3751,7 +3746,7 @@ let rec sexp_compact sh se = | Eexp (e, inst) -> Eexp (exp_compact sh e, inst) | Estruct (fsel, inst) -> - Estruct (list_map (fun (f, se) -> (f, sexp_compact sh se)) fsel, inst) + Estruct (IList.map (fun (f, se) -> (f, sexp_compact sh se)) fsel, inst) | Earray _ -> se @@ -3911,14 +3906,14 @@ let sigma_to_sigma_ne sigma : (atom list * hpred list) list = let f eqs_sigma_list hpred = match hpred with | Hpointsto _ | Hlseg(Lseg_NE, _, _, _, _) | Hdllseg(Lseg_NE, _, _, _, _, _, _) -> let g (eqs, sigma) = (eqs, hpred:: sigma) in - list_map g eqs_sigma_list + IList.map g eqs_sigma_list | Hlseg(Lseg_PE, para, e1, e2, el) -> let g (eqs, sigma) = [(Aeq(e1, e2):: eqs, sigma); (eqs, Hlseg(Lseg_NE, para, e1, e2, el):: sigma)] in - list_flatten (list_map g eqs_sigma_list) + IList.flatten (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)] in - list_flatten (list_map g eqs_sigma_list) in - list_fold_left f [([],[])] sigma + IList.flatten (IList.map g eqs_sigma_list) in + IList.fold_left f [([],[])] sigma else [([], sigma)] @@ -3929,17 +3924,17 @@ let sigma_to_sigma_ne sigma : (atom list * hpred list) list = let hpara_instantiate para e1 e2 elist = let subst_for_svars = let g id e = (id, e) in - try (list_map2 g para.svars elist) + try (IList.map2 g para.svars elist) with Invalid_argument _ -> assert false in let ids_evars = let g id = Ident.create_fresh Ident.kprimed in - list_map g para.evars in + IList.map g para.evars in let subst_for_evars = let g id id' = (id, Var id') in - try (list_map2 g para.evars ids_evars) + try (IList.map2 g para.evars ids_evars) with Invalid_argument _ -> assert false in let subst = sub_of_list ((para.root, e1):: (para.next, e2):: subst_for_svars@subst_for_evars) in - (ids_evars, list_map (hpred_sub subst) para.body) + (ids_evars, IList.map (hpred_sub subst) para.body) (** [hpara_dll_instantiate para cell blink flink elist] instantiates [para] with [cell], [blink], [flink], and [elist]. If [para = lambda (x, y, z, xs). exists zs. b], @@ -3948,25 +3943,25 @@ let hpara_instantiate para e1 e2 elist = let hpara_dll_instantiate (para: hpara_dll) cell blink flink elist = let subst_for_svars = let g id e = (id, e) in - try (list_map2 g para.svars_dll elist) + try (IList.map2 g para.svars_dll elist) with Invalid_argument _ -> assert false in let ids_evars = let g id = Ident.create_fresh Ident.kprimed in - list_map g para.evars_dll in + IList.map g para.evars_dll in let subst_for_evars = let g id id' = (id, Var id') in - try (list_map2 g para.evars_dll ids_evars) + try (IList.map2 g para.evars_dll ids_evars) with Invalid_argument _ -> assert false in let subst = sub_of_list ((para.cell, cell):: (para.blink, blink):: (para.flink, flink):: subst_for_svars@subst_for_evars) in - (ids_evars, list_map (hpred_sub subst) para.body_dll) + (ids_evars, IList.map (hpred_sub subst) para.body_dll) (** Return the list of expressions that could be understood as outgoing arrows from the strexp *) let rec strexp_get_target_exps = function | Eexp (e, inst) -> [e] - | Estruct (fsel, inst) -> list_flatten (list_map (fun (_, se) -> strexp_get_target_exps se) fsel) + | Estruct (fsel, inst) -> IList.flatten (IList.map (fun (_, se) -> strexp_get_target_exps se) fsel) | Earray (_, esel, _) -> (* We ignore size and indices since they are not quite outgoing arrows. *) - list_flatten (list_map (fun (_, se) -> strexp_get_target_exps se) esel) + IList.flatten (IList.map (fun (_, se) -> strexp_get_target_exps se) esel) let global_error = mk_pvar_global (Mangled.from_string "INFER_ERROR") diff --git a/infer/src/backend/specs.ml b/infer/src/backend/specs.ml index e9e51b513..e7b779000 100644 --- a/infer/src/backend/specs.ml +++ b/infer/src/backend/specs.ml @@ -147,13 +147,13 @@ let visited_str vis = let s = ref "" in let lines = ref IntSet.empty in let do_one (node, ns) = - (* if list_length ns > 1 then + (* if IList.length ns > 1 then begin let ss = ref "" in - list_iter (fun n -> ss := !ss ^ " " ^ string_of_int n) ns; + IList.iter (fun n -> ss := !ss ^ " " ^ string_of_int n) ns; L.err "Node %d has lines %s@." node !ss end; *) - list_iter (fun n -> lines := IntSet.add n !lines) ns in + IList.iter (fun n -> lines := IntSet.add n !lines) ns in Visitedset.iter do_one vis; IntSet.iter (fun n -> s := !s ^ " " ^ string_of_int n) !lines; !s @@ -181,12 +181,12 @@ end = struct let spec_fav (spec: Prop.normal spec) : Sil.fav = let fav = Sil.fav_new () in Jprop.fav_add_dfs fav spec.pre; - list_iter (fun (p, path) -> Prop.prop_fav_add_dfs fav p) spec.posts; + IList.iter (fun (p, path) -> Prop.prop_fav_add_dfs fav p) spec.posts; fav let spec_sub sub spec = { pre = Jprop.normalize (Jprop.jprop_sub sub spec.pre); - posts = list_map (fun (p, path) -> (Prop.normalize (Prop.prop_sub sub p), path)) spec.posts; + posts = IList.map (fun (p, path) -> (Prop.normalize (Prop.prop_sub sub p), path)) spec.posts; visited = spec.visited } (** Convert spec into normal form w.r.t. variable renaming *) @@ -194,13 +194,13 @@ end = struct let fav = spec_fav spec in let idlist = Sil.fav_to_list fav in let count = ref 0 in - let sub = Sil.sub_of_list (list_map (fun id -> incr count; (id, Sil.Var (Ident.create_normal Ident.name_spec !count))) idlist) in + let sub = Sil.sub_of_list (IList.map (fun id -> incr count; (id, Sil.Var (Ident.create_normal Ident.name_spec !count))) idlist) in spec_sub sub spec (** Return a compact representation of the spec *) let compact sh spec = let pre = Jprop.compact sh spec.pre in - let posts = list_map (fun (p, path) -> (Prop.prop_compact sh p, path)) spec.posts in + let posts = IList.map (fun (p, path) -> (Prop.prop_compact sh p, path)) spec.posts in { pre = pre; posts = posts; visited = spec.visited } (** Erase join info from pre of spec *) @@ -244,7 +244,7 @@ module CallStats = struct (** module for tracing stats of function calls *) let init calls = let hash = PnameLocHash.create 1 in let do_call pn_loc = PnameLocHash.add hash pn_loc empty_trace in - list_iter do_call calls; + IList.iter do_call calls; hash let trace t proc_name loc res in_footprint = @@ -264,7 +264,7 @@ module CallStats = struct (** module for tracing stats of function calls *) let s2 = if in_footprint then "FP" else "RE" in s1 ^ ":" ^ s2 - let pp_trace fmt tr = Utils.pp_seq (fun fmt x -> F.fprintf fmt "%s" (tr_elem_str x)) fmt (list_rev tr) + let pp_trace fmt tr = Utils.pp_seq (fun fmt x -> F.fprintf fmt "%s" (tr_elem_str x)) fmt (IList.rev tr) let iter f t = let elems = ref [] in @@ -273,8 +273,8 @@ module CallStats = struct (** module for tracing stats of function calls *) let compare ((pname1, loc1), _) ((pname2, loc2), _) = let n = Procname.compare pname1 pname2 in if n <> 0 then n else Location.compare loc1 loc2 in - list_sort compare !elems in - list_iter (fun (x, tr) -> f x tr) sorted_elems + IList.sort compare !elems in + IList.iter (fun (x, tr) -> f x tr) sorted_elems let pp fmt t = let do_call (pname, loc) tr = @@ -354,7 +354,7 @@ let pp_spec pe num_opt fmt spec = | Some (n, tot) -> Format.sprintf "%d of %d [nvisited:%s]" n tot (visited_str spec.visited) in let pre = Jprop.to_prop spec.pre in let pe_post = Prop.prop_update_obj_sub pe pre in - let post_list = list_map fst spec.posts in + let post_list = IList.map fst spec.posts in match pe.pe_kind with | PP_TEXT -> F.fprintf fmt "--------------------------- %s ---------------------------@\n" num_str; @@ -374,15 +374,15 @@ let pp_spec pe num_opt fmt spec = let d_spec (spec: 'a spec) = L.add_print_action (L.PTspec, Obj.repr spec) let pp_specs pe fmt specs = - let total = list_length specs in + let total = IList.length specs in let cnt = ref 0 in match pe.pe_kind with | PP_TEXT -> - list_iter (fun spec -> incr cnt; F.fprintf fmt "%a@\n" (pp_spec pe (Some (!cnt, total))) spec) specs + IList.iter (fun spec -> incr cnt; F.fprintf fmt "%a@\n" (pp_spec pe (Some (!cnt, total))) spec) specs | PP_HTML -> - list_iter (fun spec -> incr cnt; F.fprintf fmt "%a
@\n" (pp_spec pe (Some (!cnt, total))) spec) specs + IList.iter (fun spec -> incr cnt; F.fprintf fmt "%a
@\n" (pp_spec pe (Some (!cnt, total))) spec) specs | PP_LATEX -> - list_iter (fun spec -> incr cnt; F.fprintf fmt "\\subsection*{Spec %d of %d}@\n\\(%a\\)@\n" !cnt total (pp_spec pe None) spec) specs + IList.iter (fun spec -> incr cnt; F.fprintf fmt "\\subsection*{Spec %d of %d}@\n\\(%a\\)@\n" !cnt total (pp_spec pe None) spec) specs (** Print the decpendency map *) let pp_dependency_map fmt dependency_map = @@ -401,7 +401,7 @@ let describe_phase summary = (** Return the signature of a procedure declaration as a string *) let get_signature summary = let s = ref "" in - list_iter (fun (p, typ) -> + IList.iter (fun (p, typ) -> let pp_name f () = F.fprintf f "%s" p in let pp f () = Sil.pp_type_decl pe_text pp_name Sil.pp_exp f typ in let decl = pp_to_string pp () in @@ -479,7 +479,7 @@ let rec post_equal pl1 pl2 = match pl1, pl2 with else false let payload_compact sh payload = match payload with - | PrePosts specs -> PrePosts (list_map (NormSpec.compact sh) specs) + | PrePosts specs -> PrePosts (IList.map (NormSpec.compact sh) specs) | TypeState _ -> payload (** Return a compact representation of the summary *) @@ -510,7 +510,7 @@ let summary_exists pname = (** paths to the .specs file for the given procedure in the current spec libraries *) let specs_library_filenames pname = - list_map + IList.map (fun specs_dir -> DB.filename_from_string (Filename.concat specs_dir (specs_filename pname))) !Config.specs_library @@ -527,7 +527,7 @@ let summary_serializer : summary Serialization.serializer = (** Save summary for the procedure into the spec database *) let store_summary pname (summ: summary) = let process_payload = function - | PrePosts specs -> PrePosts (list_map NormSpec.erase_join_info_pre specs) + | PrePosts specs -> PrePosts (IList.map NormSpec.erase_join_info_pre specs) | TypeState typestate_opt -> TypeState typestate_opt in let summ1 = { summ with payload = process_payload summ.payload } in let summ2 = if !Config.save_compact_summaries @@ -754,7 +754,7 @@ let set_status proc_name status = (** Create the initial dependency map with the given list of dependencies *) let mk_initial_dependency_map proc_list : dependency_map_t = - list_fold_left (fun map pname -> Procname.Map.add pname (- 1) map) Procname.Map.empty proc_list + IList.fold_left (fun map pname -> Procname.Map.add pname (- 1) map) Procname.Map.empty proc_list (** Re-initialize a dependency map *) let re_initialize_dependency_map dependency_map = diff --git a/infer/src/backend/state.ml b/infer/src/backend/state.ml index f07039828..64542c1f6 100644 --- a/infer/src/backend/state.ml +++ b/infer/src/backend/state.ml @@ -111,14 +111,14 @@ let node_simple_key node = | Sil.Stackop _ -> add_key 8 | Sil.Declare_locals _ -> add_key 9 | Sil.Goto_node _ -> add_key 10 in - list_iter do_instr (Cfg.Node.get_instrs node); + IList.iter do_instr (Cfg.Node.get_instrs node); Hashtbl.hash !key (** key for a node: look at the current node, successors and predecessors *) let node_key node = let succs = Cfg.Node.get_succs node in let preds = Cfg.Node.get_preds node in - let v = (node_simple_key node, list_map node_simple_key succs, list_map node_simple_key preds) in + let v = (node_simple_key node, IList.map node_simple_key succs, IList.map node_simple_key preds) in Hashtbl.hash v (** normalize the list of instructions by renaming let-bound ids *) @@ -127,14 +127,14 @@ let instrs_normalize instrs = let do_instr ids = function | Sil.Letderef (id, _, _, _) -> id :: ids | _ -> ids in - list_fold_left do_instr [] instrs in + IList.fold_left do_instr [] instrs in let subst = let count = ref min_int in let gensym id = incr count; Ident.set_stamp id !count in - Sil.sub_of_list (list_map (fun id -> (id, Sil.Var (gensym id))) bound_ids) in - list_map (Sil.instr_sub subst) instrs + Sil.sub_of_list (IList.map (fun id -> (id, Sil.Var (gensym id))) bound_ids) in + IList.map (Sil.instr_sub subst) instrs (** Create a function to find duplicate nodes. A node is a duplicate of another one if they have the same kind and location @@ -179,7 +179,7 @@ let mk_find_duplicate_nodes proc_desc : (Cfg.Node.t -> Cfg.NodeSet.t) = let nodes = Cfg.Procdesc.get_nodes proc_desc in try - list_iter do_node nodes; + IList.iter do_node nodes; !m with E.Threshold -> M.empty in @@ -190,14 +190,14 @@ let mk_find_duplicate_nodes proc_desc : (Cfg.Node.t -> Cfg.NodeSet.t) = let elements = S.elements s in let (_, node_normalized_instrs), others = let filter (node', _) = Cfg.Node.equal node node' in - match list_partition filter elements with + match IList.partition filter elements with | [this], others -> this, others | _ -> raise Not_found in let duplicates = let equal_normalized_instrs (_, normalized_instrs') = - list_compare Sil.instr_compare node_normalized_instrs normalized_instrs' = 0 in - list_filter equal_normalized_instrs elements in - list_fold_left + IList.compare Sil.instr_compare node_normalized_instrs normalized_instrs' = 0 in + IList.filter equal_normalized_instrs elements in + IList.fold_left (fun nset (node', _) -> Cfg.NodeSet.add node' nset) Cfg.NodeSet.empty duplicates with Not_found -> Cfg.NodeSet.singleton node in @@ -231,7 +231,7 @@ let extract_pre p tenv pdesc abstract_fun = let fav = Prop.prop_fav p in let idlist = Sil.fav_to_list fav in let count = ref 0 in - Sil.sub_of_list (list_map (fun id -> incr count; (id, Sil.Var (Ident.create_normal Ident.name_spec !count))) idlist) in + Sil.sub_of_list (IList.map (fun id -> incr count; (id, Sil.Var (Ident.create_normal Ident.name_spec !count))) idlist) in let _, p' = Cfg.remove_locals_formals pdesc p in let pre, _ = Prop.extract_spec p' in let pre' = try abstract_fun tenv pre with exn when exn_not_timeout exn -> pre in diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index 43989fb50..fced9f84f 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -35,7 +35,7 @@ let append_list_op list_op1 list_op2 = let reverse_list_op list_op = match list_op with | None -> None - | Some list -> Some (list_rev list) + | Some list -> Some (IList.rev list) let rec unroll_type tenv typ off = match (typ, off) with @@ -61,18 +61,9 @@ let rec unroll_type tenv typ off = L.d_str "Type : "; Sil.d_typ_full typ; L.d_ln (); assert false -(* This function has the same name the standard list_split in Utils.*) -(* Maybe it's better to change name as we open Utils. *) -let list_split equal x xys = - let (xy, xys') = list_partition (fun (x', _) -> equal x x') xys in - match xy with - | [] -> (xys', None) - | [(x', y')] -> (xys', Some y') - | _ -> assert false - (* Given a node, returns a list of pvar of blocks that have been nullified in the block *) let get_nullified_block node = - let null_blocks = list_flatten(list_map (fun i -> match i with + let null_blocks = IList.flatten(IList.map (fun i -> match i with | Sil.Nullify(pvar, _, true) when Sil.is_block_pvar pvar -> [pvar] | _ -> []) (Cfg.Node.get_instrs node)) in null_blocks @@ -82,7 +73,7 @@ let get_nullified_block node = let check_block_retain_cycle cfg tenv pname _prop block_nullified = let mblock = Sil.pvar_get_name block_nullified in let block_captured = (match Cfg.get_block_pdesc cfg mblock with - | Some pd -> fst (Utils.list_split (Cfg.Procdesc.get_captured pd)) + | Some pd -> fst (IList.split (Cfg.Procdesc.get_captured pd)) | None -> []) in let _prop' = Cfg.remove_seed_captured_vars_block block_captured _prop in let _prop'' = Prop.prop_rename_fav_with_existentials _prop' in @@ -168,15 +159,15 @@ let rec apply_offlist let ftal, sftal, csu, nameo, supers, def_mthds, iann = match typ' with Sil.Tstruct (ftal, sftal, csu, nameo, supers, def_mthds, iann) -> ftal, sftal, csu, nameo, supers, def_mthds, iann | _ -> assert false in let t' = unroll_type tenv typ (Sil.Off_fld (fld, fld_typ)) in try - let _, se' = list_find (fun fse -> Ident.fieldname_equal fld (fst fse)) fsel in + let _, se' = IList.find (fun fse -> Ident.fieldname_equal fld (fst fse)) fsel in let res_e', res_se', res_t', res_pred_insts_op' = apply_offlist footprint_part pdesc tenv p fp_root nullify_struct (root_lexp, se', t') offlist' f inst lookup_inst in let replace_fse fse = if Sil.fld_equal fld (fst fse) then (fld, res_se') else fse in - let res_se = Sil.Estruct (list_map replace_fse fsel, inst') in + let res_se = Sil.Estruct (IList.map replace_fse fsel, inst') in let replace_fta (f, t, a) = if Sil.fld_equal fld f then (fld, res_t', a) else (f, t, a) in - let res_t = Sil.Tstruct (list_map replace_fta ftal, sftal, csu, nameo, supers, def_mthds, iann) in + let res_t = Sil.Tstruct (IList.map replace_fta ftal, sftal, csu, nameo, supers, def_mthds, iann) in (res_e', res_se, res_t, res_pred_insts_op') with Not_found -> pp_error(); @@ -194,13 +185,13 @@ let rec apply_offlist let typ' = Sil.expand_type tenv typ in let t', size' = match typ' with Sil.Tarray (t', size') -> (t', size') | _ -> assert false in try - let idx_ese', se' = list_find (fun ese -> Prover.check_equal p nidx (fst ese)) esel in + let idx_ese', se' = IList.find (fun ese -> Prover.check_equal p nidx (fst ese)) esel in let res_e', res_se', res_t', res_pred_insts_op' = apply_offlist footprint_part pdesc tenv p fp_root nullify_struct (root_lexp, se', t') offlist' f inst lookup_inst in let replace_ese ese = if Sil.exp_equal idx_ese' (fst ese) then (idx_ese', res_se') else ese in - let res_se = Sil.Earray(size, list_map replace_ese esel, inst1) in + let res_se = Sil.Earray(size, IList.map replace_ese esel, inst1) in let res_t = Sil.Tarray(res_t', size') 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 *) @@ -269,7 +260,7 @@ let ptsto_update footprint_part pdesc tenv p (lexp, se, typ, st) offlist exp = let update_iter iter pi sigma = let iter' = Prop.prop_iter_update_current_by_list iter sigma in - list_fold_left (Prop.prop_iter_add_atom false) iter' pi + IList.fold_left (Prop.prop_iter_add_atom false) iter' pi let execute_letderef pdesc tenv id rhs_exp acc_in iter = let iter_ren = Prop.prop_iter_make_id_primed id iter in @@ -293,7 +284,7 @@ let execute_letderef pdesc tenv id rhs_exp acc_in iter = begin match pred_insts_op with | None -> update acc_in ([],[]) - | Some pred_insts -> list_rev (list_fold_left update acc_in pred_insts) + | Some pred_insts -> IList.rev (IList.fold_left update acc_in pred_insts) end | (Sil.Hpointsto _, _) -> @@ -321,7 +312,7 @@ let execute_set pdesc tenv rhs_exp acc_in iter = prop' :: acc in match pred_insts_op with | None -> update acc_in ([],[]) - | Some pred_insts -> list_fold_left update acc_in pred_insts + | Some pred_insts -> IList.fold_left update acc_in pred_insts (** Module for builtin functions with their symbolic execution handler *) module Builtin = struct @@ -372,10 +363,10 @@ module Builtin = struct let pp_registered fmt () = let builtin_names = ref [] in Procname.Hash.iter (fun name _ -> builtin_names := name :: !builtin_names) builtin_functions; - builtin_names := list_sort Procname.compare !builtin_names; + builtin_names := IList.sort Procname.compare !builtin_names; let pp pname = Format.fprintf fmt "%a@\n" Procname.pp pname in Format.fprintf fmt "Registered builtins:@\n @["; - list_iter pp !builtin_names; + IList.iter pp !builtin_names; Format.fprintf fmt "@]@." end @@ -393,10 +384,10 @@ let rec execute_nullify_se = function | Sil.Eexp _ -> Sil.Eexp (Sil.exp_zero, Sil.inst_nullify) | Sil.Estruct (fsel, _) -> - let fsel' = list_map (fun (fld, se) -> (fld, execute_nullify_se se)) fsel in + let fsel' = IList.map (fun (fld, se) -> (fld, execute_nullify_se se)) fsel in Sil.Estruct (fsel', Sil.inst_nullify) | Sil.Earray (size, esel, inst) -> - let esel' = list_map (fun (idx, se) -> (idx, execute_nullify_se se)) esel in + let esel' = IList.map (fun (idx, se) -> (idx, execute_nullify_se se)) esel in Sil.Earray (size, esel', Sil.inst_nullify) (** Do pruning for conditional [if (e1 != e2) ] if [positive] is true @@ -505,10 +496,10 @@ let prune_prop tenv condition prop = let dangerous_functions = let dangerous_list = ["gets"] in - ref ((list_map Procname.from_string_c_fun) dangerous_list) + ref ((IList.map Procname.from_string_c_fun) dangerous_list) let check_inherently_dangerous_function caller_pname callee_pname = - if list_exists (Procname.equal callee_pname) !dangerous_functions then + if IList.exists (Procname.equal callee_pname) !dangerous_functions then let exn = Exceptions.Inherently_dangerous_function (Localise.desc_inherently_dangerous_function callee_pname) in let pre_opt = State.get_normalized_pre (Abs.abstract_no_symop caller_pname) in Reporting.log_warning caller_pname ~pre: pre_opt exn @@ -580,7 +571,7 @@ let exp_norm_check_arith pname prop exp = (** Check if [cond] is testing for NULL a pointer already dereferenced *) let check_already_dereferenced pname cond prop = let find_hpred lhs = - try Some (list_find (function + try Some (IList.find (function | Sil.Hpointsto (e, _, _) -> Sil.exp_equal e lhs | _ -> false) (Prop.get_sigma prop)) with Not_found -> None in @@ -632,7 +623,7 @@ let check_deallocate_static_memory prop_after = raise (Exceptions.Deallocate_static_memory freed_desc) | _ -> () in let exp_att_list = Prop.get_all_attributes prop_after in - list_iter check_deallocated_attribute exp_att_list; + IList.iter check_deallocated_attribute exp_att_list; prop_after (** create a copy of a procdesc with a new proc name *) @@ -651,7 +642,7 @@ let proc_desc_copy cfg pdesc pname pname' = let method_exists right_proc_name methods = if !Config.curr_language = Config.Java then - list_exists (fun meth_name -> Procname.equal right_proc_name meth_name) methods + IList.exists (fun meth_name -> Procname.equal right_proc_name meth_name) methods else (* ObjC case *) Specs.summary_exists right_proc_name @@ -822,7 +813,7 @@ let handle_objc_method_call actual_pars actual_params pre tenv cfg ret_ids pdesc let propset = prune_ne tenv false receiver Sil.exp_zero pre_with_attr_or_null in if Propset.is_empty propset then [] else - let prop = list_hd (Propset.to_proplist propset) in + let prop = IList.hd (Propset.to_proplist propset) in let path = Paths.Path.add_description path path_description in [(prop, path)] in res_null @ res @@ -832,8 +823,8 @@ let normalize_params pdesc prop actual_params = let norm_arg (p, args) (e, t) = let e', p' = exp_norm_check_arith pdesc p e in (p', (e', t) :: args) in - let prop, args = list_fold_left norm_arg (prop, []) actual_params in - (prop, list_rev args) + let prop, args = IList.fold_left norm_arg (prop, []) actual_params in + (prop, IList.rev args) (** Execute [instr] with a symbolic heap [prop].*) let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path @@ -843,14 +834,14 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path State.set_prop_tenv_pdesc _prop tenv pdesc; (* mark prop,tenv,pdesc last seen *) SymOp.pay(); (* pay one symop *) let ret_old_path pl = (* return the old path unchanged *) - list_map (fun p -> (p, path)) pl in + IList.map (fun p -> (p, path)) pl in let instr = match _instr with | Sil.Call (ret, exp, par, loc, call_flags) -> let exp' = Prop.exp_normalize_prop _prop exp in let instr' = match exp' with | Sil.Const (Sil.Ctuple (e1 :: el)) -> (* closure: combine arguments to call *) let e1' = Prop.exp_normalize_prop _prop e1 in - let par' = list_map (fun e -> (e, Sil.Tvoid)) el in + let par' = IList.map (fun e -> (e, Sil.Tvoid)) el in Sil.Call (ret, e1', par' @ par, loc, call_flags) | _ -> Sil.Call (ret, exp', par, loc, call_flags) in @@ -870,7 +861,7 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path let fold_undef_pname callee_opt attr = if Option.is_none callee_opt && Sil.attr_is_undef attr then Some attr else callee_opt in - list_fold_left fold_undef_pname None (Prop.get_exp_attributes prop exp) in + IList.fold_left fold_undef_pname None (Prop.get_exp_attributes prop exp) in let prop' = if !Config.angelic_execution then (* when we try to deref an undefined value, add it to the footprint *) @@ -881,8 +872,8 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path else prop in let iter_list = Rearrange.rearrange pdesc tenv n_rhs_exp' typ prop' loc in let prop_list = - list_fold_left (execute_letderef pdesc tenv id n_rhs_exp') [] iter_list in - ret_old_path (list_rev prop_list) + IList.fold_left (execute_letderef pdesc tenv id n_rhs_exp') [] iter_list in + ret_old_path (IList.rev prop_list) with | Rearrange.ARRAY_ACCESS -> if (!Config.array_level = 0) then assert false @@ -898,8 +889,8 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path let prop = Prop.replace_objc_null prop n_lhs_exp n_rhs_exp in let n_lhs_exp' = Prop.exp_collapse_consecutive_indices_prop prop typ n_lhs_exp in let iter_list = Rearrange.rearrange pdesc tenv n_lhs_exp' typ prop loc in - let prop_list = list_fold_left (execute_set pdesc tenv n_rhs_exp) [] iter_list in - ret_old_path (list_rev prop_list) + let prop_list = IList.fold_left (execute_set pdesc tenv n_rhs_exp) [] iter_list in + ret_old_path (IList.rev prop_list) with | Rearrange.ARRAY_ACCESS -> if (!Config.array_level = 0) then assert false @@ -934,7 +925,7 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path | Sil.Tvar (Sil.TN_csu (Sil.Class, name)) -> Mangled.to_string name = "NSNumber" | _ -> false in let lhs_is_ns_ptr () = - list_exists + IList.exists (function | Sil.Hpointsto (_, Sil.Eexp (exp, _), Sil.Sizeof (Sil.Tptr (typ, _), _)) -> Sil.exp_equal exp lhs_normal && is_nsnumber typ @@ -999,7 +990,7 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path | Some summary -> sym_exec_call cfg pdesc tenv prop path ret_ids n_actual_params summary loc in - list_flatten (list_map do_call sentinel_result) + IList.flatten (IList.map do_call sentinel_result) | Sil.Call (ret_ids, fun_exp, actual_params, loc, call_flags) -> (** Call via function pointer *) let (prop_r, n_actual_params) = normalize_params pname _prop actual_params in if call_flags.Sil.cf_is_objc_block then @@ -1017,7 +1008,7 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path | Sil.Nullify (pvar, loc, deallocate) -> begin let eprop = Prop.expose _prop in - match list_partition + match IList.partition (function | Sil.Hpointsto (Sil.Lvar pvar', _, _) -> Sil.pvar_equal pvar pvar' | _ -> false) (Prop.get_sigma eprop) with @@ -1034,7 +1025,7 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path | Sil.Abstract loc -> let node = State.get_node () in let blocks_nullified = get_nullified_block node in - list_iter (check_block_retain_cycle cfg tenv pname _prop) blocks_nullified; + IList.iter (check_block_retain_cycle cfg tenv pname _prop) blocks_nullified; if Prover.check_inconsistency _prop then ret_old_path [] @@ -1049,9 +1040,9 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path let fp_mode = !Config.footprint in Config.footprint := false; (* no footprint vars for locals *) let sigma_locals = - list_map + IList.map (Prop.mk_ptsto_lvar (Some tenv) Prop.Fld_init Sil.inst_initial) - (list_map add_None ptl) in + (IList.map add_None ptl) in Config.footprint := fp_mode; sigma_locals in let sigma' = Prop.get_sigma _prop @ sigma_locals in @@ -1087,8 +1078,8 @@ and sym_exec_generated mask_errors cfg tenv pdesc instrs ppl = | None -> "") in L.d_warning ("Generated Instruction Failed with: " ^ (Localise.to_string err_name)^loc ); L.d_ln(); [(p, path)] in - let f plist instr = list_flatten (list_map (exe_instr instr) plist) in - list_fold_left f ppl instrs + let f plist instr = IList.flatten (IList.map (exe_instr instr) plist) in + IList.fold_left f ppl instrs and add_to_footprint abducted_pv typ prop = let abducted_lvar = Sil.Lvar abducted_pv in @@ -1113,7 +1104,7 @@ and add_constraints_on_retval pdesc prop exp typ callee_pname callee_loc = (* introduce a fresh program variable to allow abduction on the return value *) let abducted_ret_pv = Sil.mk_pvar_abducted_ret callee_pname callee_loc in let already_has_abducted_retval p = - list_exists + IList.exists (fun hpred -> match hpred with | Sil.Hpointsto (Sil.Lvar pv, _, _) -> Sil.pvar_equal pv abducted_ret_pv | _ -> false) @@ -1133,7 +1124,7 @@ and add_constraints_on_retval pdesc prop exp typ callee_pname callee_loc = when Sil.pvar_equal pv abducted_pvar -> Prop.conjoin_eq exp_to_bind rhs prop | _ -> prop in - list_fold_left bind_exp prop (Prop.get_sigma prop) in + IList.fold_left bind_exp prop (Prop.get_sigma prop) in (* bind return id to the abducted value pointed to by the pvar we introduced *) bind_exp_to_abducted_val exp abducted_ret_pv prop else add_ret_non_null exp typ prop @@ -1142,7 +1133,7 @@ and add_constraints_on_actuals_by_ref prop actuals_by_ref callee_pname callee_lo (* replace an hpred of the form actual_var |-> _ with new_hpred in prop *) let replace_actual_hpred actual_var new_hpred prop = let sigma' = - list_map + IList.map (function | Sil.Hpointsto (lhs, _, _) when Sil.exp_equal lhs actual_var -> new_hpred | hpred -> hpred) @@ -1156,7 +1147,7 @@ and add_constraints_on_actuals_by_ref prop actuals_by_ref callee_pname callee_lo let abducted_ref_pv = Sil.mk_pvar_abducted_ref_param callee_pname actual_pv callee_loc in let already_has_abducted_retval p = - list_exists + IList.exists (fun hpred -> match hpred with | Sil.Hpointsto (Sil.Lvar pv, _, _) -> Sil.pvar_equal pv abducted_ref_pv | _ -> false) @@ -1169,7 +1160,7 @@ and add_constraints_on_actuals_by_ref prop actuals_by_ref callee_pname callee_lo add_to_footprint abducted_ref_pv (Sil.typ_strip_ptr actual_typ) prop in (* replace [actual] |-> _ with [actual] |-> [fresh_fp_var] *) let filtered_sigma = - list_map + IList.map (function | Sil.Hpointsto (lhs, _, typ_exp) when Sil.exp_equal lhs actual -> Sil.Hpointsto (lhs, Sil.Eexp (fresh_fp_var, Sil.Inone), typ_exp) @@ -1180,14 +1171,14 @@ and add_constraints_on_actuals_by_ref prop actuals_by_ref callee_pname callee_lo (* bind actual passed by ref to the abducted value pointed to by the synthetic pvar *) let prop' = let filtered_sigma = - list_filter + IList.filter (function | Sil.Hpointsto (lhs, _, typ_exp) when Sil.exp_equal lhs actual -> false | _ -> true) (Prop.get_sigma prop) in Prop.normalize (Prop.replace_sigma filtered_sigma prop) in - list_fold_left + IList.fold_left (fun p hpred -> match hpred with | Sil.Hpointsto (Sil.Lvar pv, rhs, texp) when Sil.pvar_equal pv abducted_ref_pv -> @@ -1197,7 +1188,7 @@ and add_constraints_on_actuals_by_ref prop actuals_by_ref callee_pname callee_lo prop' (Prop.get_sigma prop') | _ -> assert false in - list_fold_left add_actual_by_ref_to_footprint prop actuals_by_ref + IList.fold_left add_actual_by_ref_to_footprint prop actuals_by_ref else (* non-angelic mode; havoc each var passed by reference by assigning it to a fresh id *) let havoc_actual_by_ref (actual, actual_typ) prop = @@ -1206,7 +1197,7 @@ and add_constraints_on_actuals_by_ref prop actuals_by_ref callee_pname callee_lo let sizeof_exp = Sil.Sizeof (Sil.typ_strip_ptr actual_typ, Sil.Subtype.subtypes) in Prop.mk_ptsto actual (Sil.Eexp (havocd_var, Sil.Inone)) sizeof_exp in replace_actual_hpred actual actual_pt_havocd_var prop in - list_fold_left (fun p var -> havoc_actual_by_ref var p) prop actuals_by_ref + IList.fold_left (fun p var -> havoc_actual_by_ref var p) prop actuals_by_ref (** execute a call for an unknown or scan function *) and call_unknown_or_scan is_scan cfg pdesc tenv pre path @@ -1218,10 +1209,10 @@ and call_unknown_or_scan is_scan cfg pdesc tenv pre path when res_action.Sil.ra_res = Sil.Rfile -> Prop.remove_attribute res q | _ -> q in - list_fold_left do_attribute p (Prop.get_exp_attributes p e) in - list_fold_left do_exp prop actual_pars in + IList.fold_left do_attribute p (Prop.get_exp_attributes p e) in + IList.fold_left do_exp prop actual_pars in let actuals_by_ref = - list_filter + IList.filter (function | Sil.Lvar _, _ -> true | _ -> false) @@ -1238,8 +1229,8 @@ and call_unknown_or_scan is_scan cfg pdesc tenv pre path else (* otherwise, add undefined attribute to retvals and actuals passed by ref *) let exps_to_mark = - let ret_exps = list_map (fun ret_id -> Sil.Var ret_id) ret_ids in - list_fold_left + let ret_exps = IList.map (fun ret_id -> Sil.Var ret_id) ret_ids in + IList.fold_left (fun exps_to_mark (exp, _) -> exp :: exps_to_mark) ret_exps actuals_by_ref in let path_pos = State.get_path_pos () in [(Prop.mark_vars_as_undefined pre''' exps_to_mark callee_pname loc path_pos, path)] @@ -1251,14 +1242,14 @@ and sym_exe_check_variadic_sentinel ?(fails_on_nil = false) cfg pdesc tenv prop (* useful if you would prefer to not have *any* formal parameters, *) (* but the language forces you to have at least one. *) let first_var_arg_pos = if null_pos > n_formals then 0 else n_formals - null_pos in - let nargs = list_length actual_params in + let nargs = IList.length actual_params in (* sentinels start counting from the last argument to the function *) let sentinel_pos = nargs - sentinel - 1 in let mk_non_terminal_argsi (acc, i) a = if i < first_var_arg_pos || i >= sentinel_pos then (acc, i +1) else ((a, i):: acc, i +1) in - (* list_fold_left reverses the arguments *) - let non_terminal_argsi = fst (list_fold_left mk_non_terminal_argsi ([], 0) actual_params) in + (* IList.fold_left reverses the arguments *) + let non_terminal_argsi = fst (IList.fold_left mk_non_terminal_argsi ([], 0) actual_params) in let check_allocated result ((lexp, typ), i) = (* simulate a Letderef for [lexp] *) let tmp_id_deref = Ident.create_fresh Ident.kprimed in @@ -1275,9 +1266,9 @@ and sym_exe_check_variadic_sentinel ?(fails_on_nil = false) cfg pdesc tenv prop (err_desc, try assert false with Assert_failure x -> x)) else raise e in - (* list_fold_left reverses the arguments back so that we report an *) + (* IList.fold_left reverses the arguments back so that we report an *) (* error on the first premature nil argument *) - list_fold_left check_allocated [(prop, path)] non_terminal_argsi + IList.fold_left check_allocated [(prop, path)] non_terminal_argsi and sym_exe_check_variadic_sentinel_if_present cfg pdesc tenv prop path actual_params callee_pname loc = @@ -1291,7 +1282,7 @@ and sym_exe_check_variadic_sentinel_if_present | Some sentinel_arg -> let formals = callee_attributes.ProcAttributes.formals in sym_exe_check_variadic_sentinel - cfg pdesc tenv prop path (list_length formals) + cfg pdesc tenv prop path (IList.length formals) actual_params sentinel_arg callee_pname loc @@ -1318,7 +1309,7 @@ and sym_exec_call cfg pdesc tenv pre path ret_ids actual_pars summary loc = Reporting.log_warning caller_pname ~pre: pre_opt exn in check_inherently_dangerous_function caller_pname callee_pname; begin - let formal_types = list_map (fun (_, typ) -> typ) (Specs.get_formals summary) in + let formal_types = IList.map (fun (_, typ) -> typ) (Specs.get_formals summary) in let rec comb actual_pars formal_types = match actual_pars, formal_types with | [], [] -> actual_pars @@ -1331,13 +1322,13 @@ and sym_exec_call cfg pdesc tenv pre path ret_ids actual_pars summary loc = | _,[] -> if !Config.developer_mode then Errdesc.warning_err (State.get_loc ()) "likely use of variable-arguments function, or function prototype missing@."; L.d_warning "likely use of variable-arguments function, or function prototype missing"; L.d_ln(); - L.d_str "actual parameters: "; Sil.d_exp_list (list_map fst actual_pars); L.d_ln (); + L.d_str "actual parameters: "; Sil.d_exp_list (IList.map fst actual_pars); L.d_ln (); L.d_str "formal parameters: "; Sil.d_typ_list formal_types; L.d_ln (); actual_pars | [], _ -> L.d_str ("**** ERROR: Procedure " ^ Procname.to_string callee_pname); L.d_strln (" mismatch in the number of parameters ****"); - L.d_str "actual parameters: "; Sil.d_exp_list (list_map fst actual_pars); L.d_ln (); + L.d_str "actual parameters: "; Sil.d_exp_list (IList.map fst actual_pars); L.d_ln (); L.d_str "formal parameters: "; Sil.d_typ_list formal_types; L.d_ln (); raise (Exceptions.Wrong_argument_number (try assert false with Assert_failure x -> x)) in let actual_params = comb actual_pars formal_types in @@ -1366,10 +1357,10 @@ and sym_exec_wrapper handle_exn cfg tenv pdesc instr ((prop: Prop.normal Prop.t) Sil.fav_filter_ident fav Ident.is_primed; let ids_primed = Sil.fav_to_list fav in let ids_primed_normal = - list_map (fun id -> (id, Ident.create_fresh Ident.knormal)) ids_primed in - let ren_sub = Sil.sub_of_list (list_map (fun (id1, id2) -> (id1, Sil.Var id2)) ids_primed_normal) in + IList.map (fun id -> (id, Ident.create_fresh Ident.knormal)) ids_primed in + let ren_sub = Sil.sub_of_list (IList.map (fun (id1, id2) -> (id1, Sil.Var id2)) ids_primed_normal) in let p' = Prop.normalize (Prop.prop_sub ren_sub p) in - let fav_normal = Sil.fav_from_list (list_map snd ids_primed_normal) in + let fav_normal = Sil.fav_from_list (IList.map snd ids_primed_normal) in p', fav_normal in let prop_normal_to_primed fav_normal p = (* rename given normal vars to fresh primed *) if Sil.fav_to_list fav_normal = [] then p @@ -1393,7 +1384,7 @@ and sym_exec_wrapper handle_exn cfg tenv pdesc instr ((prop: Prop.normal Prop.t) let instr_is_abstraction = function | Sil.Abstract _ -> true | _ -> false in - list_exists instr_is_abstraction (Cfg.Node.get_instrs node) in + IList.exists instr_is_abstraction (Cfg.Node.get_instrs node) in let curr_node = State.get_node () in match Cfg.Node.get_kind curr_node with | Cfg.Node.Prune_node _ when not (node_has_abstraction curr_node) -> @@ -1406,10 +1397,10 @@ and sym_exec_wrapper handle_exn cfg tenv pdesc instr ((prop: Prop.normal Prop.t) let res_list = run_with_abs_val_eq_zero (* no exp abstraction during sym exe *) (fun () -> sym_exec cfg tenv pdesc instr prop' path) in - let res_list_nojunk = list_map (fun (p, path) -> (post_process_result fav_normal p path, path)) res_list in - let results = list_map (fun (p, path) -> (Prop.prop_rename_primed_footprint_vars p, path)) res_list_nojunk in + let res_list_nojunk = IList.map (fun (p, path) -> (post_process_result fav_normal p path, path)) res_list in + let results = IList.map (fun (p, path) -> (Prop.prop_rename_primed_footprint_vars p, path)) res_list_nojunk in L.d_strln "Instruction Returns"; - Propgraph.d_proplist prop (list_map fst results); L.d_ln (); + Propgraph.d_proplist prop (IList.map fst results); L.d_ln (); State.mark_instr_ok (); Paths.PathSet.from_renamed_list results with exn when Exceptions.handle_exception exn && !Config.footprint -> @@ -1458,7 +1449,7 @@ let lifted_sym_exec let pset' = Paths.PathSet.fold (exe_instr_prop instr) pset Paths.PathSet.empty in (pset', stack) in let stack = [] in - let pset', stack' = list_fold_left exe_instr_pset (pset, stack) instrs in + let pset', stack' = IList.fold_left exe_instr_pset (pset, stack) instrs in if stack' != [] then assert false; (* final stack must be empty *) pset' @@ -1501,13 +1492,13 @@ module ModelBuiltins = struct let execute___get_array_size cfg pdesc instr tenv _prop path ret_ids args callee_pname loc : Builtin.ret_typ = match args with - | [(lexp, typ)] when list_length ret_ids <= 1 -> + | [(lexp, typ)] when IList.length ret_ids <= 1 -> let pname = Cfg.Procdesc.get_proc_name pdesc in let return_result_for_array_size e prop ret_ids = return_result e prop ret_ids in let n_lexp, prop = exp_norm_check_arith pname _prop lexp in begin try - let hpred = list_find (function + let hpred = IList.find (function | Sil.Hpointsto(e, _, _) -> Sil.exp_equal e n_lexp | _ -> false) (Prop.get_sigma prop) in match hpred with @@ -1540,7 +1531,7 @@ module ModelBuiltins = struct let n_size, prop = exp_norm_check_arith pname _prop' size in begin try - let hpred, sigma' = list_partition (function + let hpred, sigma' = IList.partition (function | Sil.Hpointsto(e, _, t) -> Sil.exp_equal e n_lexp | _ -> false) (Prop.get_sigma prop) in match hpred with @@ -1574,7 +1565,7 @@ module ModelBuiltins = struct let do_arg (lexp, typ) = let n_lexp, _ = exp_norm_check_arith pname prop lexp in L.err "%a " (Sil.pp_exp pe_text) n_lexp in - list_iter do_arg args; + IList.iter do_arg args; L.err "@."; [(prop, path)] @@ -1588,7 +1579,7 @@ module ModelBuiltins = struct let create_type tenv n_lexp typ prop = let prop_type = try - let _ = list_find (function + let _ = IList.find (function | Sil.Hpointsto(e, _, _) -> Sil.exp_equal e n_lexp | _ -> false) (Prop.get_sigma prop) in prop @@ -1626,23 +1617,23 @@ module ModelBuiltins = struct let sil_is_nonnull = Sil.UnOp(Sil.LNot, sil_is_null, None) in let null_case = Propset.to_proplist (prune_prop tenv sil_is_null prop) in let non_null_case = Propset.to_proplist (prune_prop tenv sil_is_nonnull prop_type) in - if ((list_length non_null_case) > 0) && (!Config.footprint) then + if ((IList.length non_null_case) > 0) && (!Config.footprint) then non_null_case - else if ((list_length non_null_case) > 0) && (is_undefined_opt prop n_lexp) then + else if ((IList.length non_null_case) > 0) && (is_undefined_opt prop n_lexp) then non_null_case else null_case@non_null_case let execute___get_type_of cfg pdesc instr tenv _prop path ret_ids args callee_pname loc : Builtin.ret_typ = match args with - | [(lexp, typ)] when list_length ret_ids <= 1 -> + | [(lexp, typ)] when IList.length ret_ids <= 1 -> let pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp, prop = exp_norm_check_arith pname _prop lexp in let props = create_type tenv n_lexp typ prop in let aux prop = begin try - let hpred = list_find (function + let hpred = IList.find (function | Sil.Hpointsto(e, _, _) -> Sil.exp_equal e n_lexp | _ -> false) (Prop.get_sigma prop) in match hpred with @@ -1651,14 +1642,14 @@ module ModelBuiltins = struct | _ -> assert false with Not_found -> (return_result Sil.exp_zero prop ret_ids), path end in - (list_map aux props) + (IList.map aux props) | _ -> raise (Exceptions.Wrong_argument_number (try assert false with Assert_failure x -> x)) (** replace the type of the ptsto rooted at [root_e] with [texp] in [prop] *) let replace_ptsto_texp prop root_e texp = let process_sigma sigma = let sigma1, sigma2 = - list_partition (function + IList.partition (function | Sil.Hpointsto(e, _, _) -> Sil.exp_equal e root_e | _ -> false) sigma in match sigma1 with @@ -1674,7 +1665,7 @@ module ModelBuiltins = struct cfg pdesc instr tenv _prop path ret_ids args callee_pname loc instof : Builtin.ret_typ = match args with - | [(_val1, typ1); (_texp2, typ2)] when list_length ret_ids <= 1 -> + | [(_val1, typ1); (_texp2, typ2)] when IList.length ret_ids <= 1 -> let pname = Cfg.Procdesc.get_proc_name pdesc in let val1, __prop = exp_norm_check_arith pname _prop _val1 in let texp2, prop = exp_norm_check_arith pname __prop _texp2 in @@ -1684,7 +1675,7 @@ module ModelBuiltins = struct else begin try - let hpred = list_find (function + let hpred = IList.find (function | Sil.Hpointsto(e1, _, _) -> Sil.exp_equal e1 val1 | _ -> false) (Prop.get_sigma prop) in match hpred with @@ -1731,7 +1722,7 @@ module ModelBuiltins = struct [(return_result val1 prop ret_ids, path)] end in let props = create_type tenv val1 typ1 prop in - list_flatten (list_map exe_one_prop props) + IList.flatten (IList.map exe_one_prop props) | _ -> raise (Exceptions.Wrong_argument_number (try assert false with Assert_failure x -> x)) let execute___instanceof cfg pdesc instr tenv _prop path ret_ids args callee_pname loc @@ -1838,7 +1829,7 @@ module ModelBuiltins = struct | None -> p in let foot_var = lazy (Sil.Var (Ident.create_fresh Ident.kfootprint)) in let filter_fld_hidden (f, _ ) = Ident.fieldname_is_hidden f in - let has_fld_hidden fsel = list_exists filter_fld_hidden fsel in + let has_fld_hidden fsel = IList.exists filter_fld_hidden fsel in let do_hpred in_foot hpred = match hpred with | Sil.Hpointsto(e, Sil.Estruct (fsel, inst), texp) when Sil.exp_equal e n_lexp && (not (has_fld_hidden fsel)) -> let foot_e = Lazy.force foot_var in @@ -1848,14 +1839,14 @@ module ModelBuiltins = struct Sil.Hpointsto(e, Sil.Estruct (fsel', inst), texp) | Sil.Hpointsto(e, Sil.Estruct (fsel, _), texp) when Sil.exp_equal e n_lexp && not in_foot && has_fld_hidden fsel -> let set_ret_val () = - match list_find filter_fld_hidden fsel with + match IList.find filter_fld_hidden fsel with | _, Sil.Eexp(e, _) -> ret_val := Some e | _ -> () in set_ret_val(); hpred | _ -> hpred in - let sigma' = list_map (do_hpred false) (Prop.get_sigma prop) in - let sigma_fp' = list_map (do_hpred true) (Prop.get_sigma_footprint prop) in + let sigma' = IList.map (do_hpred false) (Prop.get_sigma prop) in + let sigma_fp' = IList.map (do_hpred true) (Prop.get_sigma_footprint prop) in let prop' = Prop.replace_sigma_footprint sigma_fp' (Prop.replace_sigma sigma' prop) in let prop'' = return_val (Prop.normalize prop') in [(prop'', path)] @@ -1871,11 +1862,11 @@ module ModelBuiltins = struct let n_lexp2, prop = exp_norm_check_arith pname _prop1 lexp2 in let foot_var = lazy (Sil.Var (Ident.create_fresh Ident.kfootprint)) in let filter_fld_hidden (f, _ ) = Ident.fieldname_is_hidden f in - let has_fld_hidden fsel = list_exists filter_fld_hidden fsel in + let has_fld_hidden fsel = IList.exists filter_fld_hidden fsel in let do_hpred in_foot hpred = match hpred with | Sil.Hpointsto(e, Sil.Estruct (fsel, inst), texp) when Sil.exp_equal e n_lexp1 && not in_foot -> let se = Sil.Eexp(n_lexp2, Sil.inst_none) in - let fsel' = (Ident.fieldname_hidden, se) :: (list_filter (fun x -> not (filter_fld_hidden x)) fsel) in + let fsel' = (Ident.fieldname_hidden, se) :: (IList.filter (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 Sil.exp_equal e n_lexp1 && in_foot && not (has_fld_hidden fsel) -> let foot_e = Lazy.force foot_var in @@ -1883,8 +1874,8 @@ module ModelBuiltins = struct let fsel' = (Ident.fieldname_hidden, se) :: fsel in Sil.Hpointsto(e, Sil.Estruct (fsel', inst), texp) | _ -> hpred in - let sigma' = list_map (do_hpred false) (Prop.get_sigma prop) in - let sigma_fp' = list_map (do_hpred true) (Prop.get_sigma_footprint prop) in + let sigma' = IList.map (do_hpred false) (Prop.get_sigma prop) in + let sigma_fp' = IList.map (do_hpred true) (Prop.get_sigma_footprint prop) in let prop' = Prop.replace_sigma_footprint sigma_fp' (Prop.replace_sigma sigma' prop) in let prop'' = Prop.normalize prop' in [(prop'', path)] @@ -1893,7 +1884,7 @@ module ModelBuiltins = struct let execute___state_untainted cfg pdesc instr tenv _prop path ret_ids args callee_name loc : Builtin.ret_typ = match args with - | [(lexp, typ)] when list_length ret_ids <= 1 -> + | [(lexp, typ)] when IList.length ret_ids <= 1 -> let pname = Cfg.Procdesc.get_proc_name pdesc in (match ret_ids with | [ret_id] -> @@ -1998,7 +1989,7 @@ module ModelBuiltins = struct match res with | (prop, path):: _ -> (try - let hpred = list_find (function + let hpred = IList.find (function | Sil.Hpointsto(e1, _, _) -> Sil.exp_equal e1 exp | _ -> false) (Prop.get_sigma _prop) in match hpred with @@ -2010,18 +2001,18 @@ module ModelBuiltins = struct | _ -> res with Not_found -> res) | [] -> res in - list_fold_left call_release [(prop, path)] autoreleased_objects + IList.fold_left call_release [(prop, path)] autoreleased_objects else execute___no_op _prop path let execute___objc_cast cfg pdesc instr tenv _prop path ret_ids args callee_pname loc : Builtin.ret_typ = match args with - | [(_val1, typ1); (_texp2, typ2)] when list_length ret_ids <= 1 -> + | [(_val1, typ1); (_texp2, typ2)] when IList.length ret_ids <= 1 -> let pname = Cfg.Procdesc.get_proc_name pdesc in let val1, __prop = exp_norm_check_arith pname _prop _val1 in let texp2, prop = exp_norm_check_arith pname __prop _texp2 in (try - let hpred = list_find (function + let hpred = IList.find (function | Sil.Hpointsto(e1, _, _) -> Sil.exp_equal e1 val1 | _ -> false) (Prop.get_sigma prop) in match hpred, texp2 with @@ -2061,9 +2052,9 @@ module ModelBuiltins = struct assert false | Some _ -> let prop_list = - list_fold_left (_execute_free tenv mk loc) [] + IList.fold_left (_execute_free tenv mk loc) [] (Rearrange.rearrange pdesc tenv lexp typ prop loc) in - list_rev prop_list + IList.rev prop_list end with Rearrange.ARRAY_ACCESS -> if (!Config.array_level = 0) then assert false @@ -2087,10 +2078,10 @@ module ModelBuiltins = struct Propset.to_proplist (prune_polarity tenv false n_lexp prop) in let plist = prop_zero @ (* model: if 0 then skip else _execute_free_nonzero *) - list_flatten (list_map (fun p -> + IList.flatten (IList.map (fun p -> _execute_free_nonzero mk pdesc tenv instr p path (Prop.exp_normalize_prop p lexp) typ loc) prop_nonzero) in - list_map (fun p -> (p, path)) plist + IList.map (fun p -> (p, path)) plist end | _ -> raise (Exceptions.Wrong_argument_number (try assert false with Assert_failure x -> x)) @@ -2170,9 +2161,9 @@ module ModelBuiltins = struct skip_n_arguments cfg pdesc instr tenv prop path ret_ids args callee_pname loc : Builtin.ret_typ = match args with - | _ when list_length args >= skip_n_arguments -> + | _ when IList.length args >= skip_n_arguments -> let varargs = ref args in - for i = 1 to skip_n_arguments do varargs := list_tl !varargs done; + for i = 1 to skip_n_arguments do varargs := IList.tl !varargs done; call_unknown_or_scan true cfg pdesc tenv prop path ret_ids None !varargs callee_pname loc | _ -> raise (Exceptions.Wrong_argument_number (try assert false with Assert_failure x -> x)) @@ -2214,7 +2205,7 @@ module ModelBuiltins = struct (let n = Sil.Int.to_int n_sil in try let parts = Str.split (Str.regexp_string str2) str1 in - let n_part = list_nth parts n in + let n_part = IList.nth parts n in let res = Sil.Const (Sil.Cstr n_part) in [(return_result res prop ret_ids, path)] with Not_found -> assert false) @@ -2223,7 +2214,7 @@ module ModelBuiltins = struct let execute___create_tuple cfg pdesc instr tenv prop path ret_ids args callee_pname loc : Builtin.ret_typ = - let el = list_map fst args in + let el = IList.map fst args in let res = Sil.Const (Sil.Ctuple el) in [(return_result res prop ret_ids, path)] @@ -2237,7 +2228,7 @@ module ModelBuiltins = struct (match n_lexp1, n_lexp2 with | Sil.Const (Sil.Ctuple el), Sil.Const (Sil.Cint i) -> let n = Sil.Int.to_int i in - let en = list_nth el n in + let en = IList.nth el n in [(return_result en prop ret_ids, path)] | _ -> [(prop, path)]) | _ -> raise (Exceptions.Wrong_argument_number (try assert false with Assert_failure x -> x)) @@ -2275,7 +2266,7 @@ module ModelBuiltins = struct : Builtin.ret_typ = let error_str = match args with - | l when list_length l = 4 -> + | l when IList.length l = 4 -> Config.default_failure_name | _ -> raise (Exceptions.Wrong_argument_number (try assert false with Assert_failure x -> x)) in diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index 0b73b236e..a28dd9872 100644 --- a/infer/src/backend/tabulation.ml +++ b/infer/src/backend/tabulation.ml @@ -89,14 +89,14 @@ let spec_rename_vars pname spec = | Specs.Jprop.Joined (n, p, jp1, jp2) -> Specs.Jprop.Joined (n, prop_add_callee_suffix p, jp1, jp2) in let fav = Sil.fav_new () in Specs.Jprop.fav_add fav spec.Specs.pre; - list_iter (fun (p, path) -> Prop.prop_fav_add fav p) spec.Specs.posts; + IList.iter (fun (p, path) -> Prop.prop_fav_add fav p) spec.Specs.posts; let ids = Sil.fav_to_list fav in - let ids' = list_map (fun i -> (i, Ident.create_fresh Ident.kprimed)) ids in - let ren_sub = Sil.sub_of_list (list_map (fun (i, i') -> (i, Sil.Var i')) ids') in + let ids' = IList.map (fun i -> (i, Ident.create_fresh Ident.kprimed)) ids in + let ren_sub = Sil.sub_of_list (IList.map (fun (i, i') -> (i, Sil.Var i')) ids') in let pre' = Specs.Jprop.jprop_sub ren_sub spec.Specs.pre in - let posts' = list_map (fun (p, path) -> (Prop.prop_sub ren_sub p, path)) spec.Specs.posts in + let posts' = IList.map (fun (p, path) -> (Prop.prop_sub ren_sub p, path)) spec.Specs.posts in let pre'' = jprop_add_callee_suffix pre' in - let posts'' = list_map (fun (p, path) -> (prop_add_callee_suffix p, path)) posts' in + let posts'' = IList.map (fun (p, path) -> (prop_add_callee_suffix p, path)) posts' in { Specs.pre = pre''; Specs.posts = posts''; Specs.visited = spec.Specs.visited } (** Find and number the specs for [proc_name], after renaming their vars, and also return the parameters *) @@ -112,8 +112,8 @@ let spec_find_rename trace_call (proc_name : Procname.t) : (int * Prop.exposed S raise (Exceptions.Precondition_not_found (Localise.verbatim_desc (Procname.to_string proc_name), try assert false with Assert_failure x -> x)) end; let formal_parameters = - list_map (fun (x, _) -> Sil.mk_pvar_callee (Mangled.from_string x) proc_name) formals in - list_map f specs, formal_parameters + IList.map (fun (x, _) -> Sil.mk_pvar_callee (Mangled.from_string x) proc_name) formals in + IList.map f specs, formal_parameters with Not_found -> begin L.d_strln ("ERROR: found no entry for procedure " ^ Procname.to_string proc_name ^ ". Give up..."); raise (Exceptions.Precondition_not_found (Localise.verbatim_desc (Procname.to_string proc_name), try assert false with Assert_failure x -> x)) @@ -130,11 +130,11 @@ let process_splitting actual_pre sub1 sub2 frame missing_pi missing_sigma frame_ let rng1 = Sil.sub_range sub1 in let dom2 = Sil.sub_domain sub2 in let rng2 = Sil.sub_range sub2 in - let overlap = list_exists (fun id -> list_exists (Ident.equal id) dom1) dom2 in + let overlap = IList.exists (fun id -> IList.exists (Ident.equal id) dom1) dom2 in if overlap then begin - L.d_str "Dom(Sub1): "; Sil.d_exp_list (list_map (fun id -> Sil.Var id) dom1); L.d_ln (); + L.d_str "Dom(Sub1): "; Sil.d_exp_list (IList.map (fun id -> Sil.Var id) dom1); L.d_ln (); L.d_str "Ran(Sub1): "; Sil.d_exp_list rng1; L.d_ln (); - L.d_str "Dom(Sub2): "; Sil.d_exp_list (list_map (fun id -> Sil.Var id) dom2); L.d_ln (); + L.d_str "Dom(Sub2): "; Sil.d_exp_list (IList.map (fun id -> Sil.Var id) dom2); L.d_ln (); L.d_str "Ran(Sub2): "; Sil.d_exp_list rng2; L.d_ln (); assert false end in @@ -144,13 +144,13 @@ let process_splitting actual_pre sub1 sub2 frame missing_pi missing_sigma frame_ let sub1_inverse = let sub1_list = Sil.sub_to_list sub1 in - let sub1_list' = list_filter (function (_, Sil.Var _) -> true | _ -> false) sub1_list in - let sub1_inverse_list = list_map (function (id, Sil.Var id') -> (id', Sil.Var id) | _ -> assert false) sub1_list' + let sub1_list' = IList.filter (function (_, Sil.Var _) -> true | _ -> false) sub1_list in + let sub1_inverse_list = IList.map (function (id, Sil.Var id') -> (id', Sil.Var id) | _ -> assert false) sub1_list' in Sil.sub_of_list_duplicates sub1_inverse_list in let fav_actual_pre = let fav_sub2 = (* vars which represent expansions of fields *) let fav = Sil.fav_new () in - list_iter (Sil.exp_fav_add fav) (Sil.sub_range sub2); + IList.iter (Sil.exp_fav_add fav) (Sil.sub_range sub2); let filter id = Ident.get_stamp id = - 1 in Sil.fav_filter_ident fav filter; fav in @@ -176,7 +176,7 @@ let process_splitting actual_pre sub1 sub2 frame missing_pi missing_sigma frame_ let sub_list = Sil.sub_to_list sub in let fav_sub_list = let fav_sub = Sil.fav_new () in - list_iter (fun (_, e) -> Sil.exp_fav_add fav_sub e) sub_list; + IList.iter (fun (_, e) -> Sil.exp_fav_add fav_sub e) sub_list; Sil.fav_to_list fav_sub in let sub1 = let f id = @@ -189,21 +189,21 @@ let process_splitting actual_pre sub1 sub2 frame missing_pi missing_sigma frame_ let rng1 = Sil.sub_range sub1 in let dom2 = Sil.sub_domain sub2 in let rng2 = Sil.sub_range sub2 in - let vars_actual_pre = list_map (fun id -> Sil.Var id) (Sil.fav_to_list fav_actual_pre) in + let vars_actual_pre = IList.map (fun id -> Sil.Var id) (Sil.fav_to_list fav_actual_pre) in L.d_str "fav_actual_pre: "; Sil.d_exp_list vars_actual_pre; L.d_ln (); - L.d_str "Dom(Sub1): "; Sil.d_exp_list (list_map (fun id -> Sil.Var id) dom1); L.d_ln (); + L.d_str "Dom(Sub1): "; Sil.d_exp_list (IList.map (fun id -> Sil.Var id) dom1); L.d_ln (); L.d_str "Ran(Sub1): "; Sil.d_exp_list rng1; L.d_ln (); - L.d_str "Dom(Sub2): "; Sil.d_exp_list (list_map (fun id -> Sil.Var id) dom2); L.d_ln (); + L.d_str "Dom(Sub2): "; Sil.d_exp_list (IList.map (fun id -> Sil.Var id) dom2); L.d_ln (); L.d_str "Ran(Sub2): "; Sil.d_exp_list rng2; L.d_ln (); L.d_str "Don't know about id: "; Sil.d_exp (Sil.Var id); L.d_ln (); assert false; end - in Sil.sub_of_list (list_map f fav_sub_list) in + in Sil.sub_of_list (IList.map f fav_sub_list) in let sub2_list = let f id = (id, Sil.Var (Ident.create_fresh Ident.kfootprint)) - in list_map f (Sil.fav_to_list fav_missing_primed) in + in IList.map f (Sil.fav_to_list fav_missing_primed) in let sub_list' = - list_map (fun (id, e) -> (id, Sil.exp_sub sub1 e)) sub_list in + IList.map (fun (id, e) -> (id, Sil.exp_sub sub1 e)) sub_list in let sub' = Sil.sub_of_list (sub2_list @ sub_list') in { sub = sub'; frame = frame; missing_pi = missing_pi; missing_sigma = missing_sigma; frame_fld = frame_fld; missing_fld = missing_fld; frame_typ = frame_typ; missing_typ = missing_typ } @@ -219,12 +219,12 @@ let rec find_dereference_without_null_check_in_sexp = function | Sil.Estruct (fsel, inst) -> let res = find_dereference_without_null_check_in_inst inst in if res = None then - find_dereference_without_null_check_in_sexp_list (list_map snd fsel) + find_dereference_without_null_check_in_sexp_list (IList.map snd fsel) else res | Sil.Earray (_, esel, inst) -> let res = find_dereference_without_null_check_in_inst inst in if res = None then - find_dereference_without_null_check_in_sexp_list (list_map snd esel) + find_dereference_without_null_check_in_sexp_list (IList.map snd esel) else res and find_dereference_without_null_check_in_sexp_list = function | [] -> None @@ -276,7 +276,7 @@ let check_dereferences callee_pname actual_pre sub spec_pre formal_params = | Sil.Hpointsto (lexp, se, _) -> check_dereference (Sil.root_of_lexp lexp) se | _ -> None in - let deref_err_list = list_fold_left (fun deref_errs hpred -> match check_hpred hpred with + let deref_err_list = IList.fold_left (fun deref_errs hpred -> match check_hpred hpred with | Some reason -> reason :: deref_errs | None -> deref_errs ) [] (Prop.get_sigma spec_pre) in @@ -290,7 +290,7 @@ let check_dereferences callee_pname actual_pre sub spec_pre formal_params = (* TOOD (t4893533): use this trick outside of angelic mode and in other parts of the code *) Some (try - list_find + IList.find (fun err -> match err with | (Deref_null _, _) -> true | _ -> false ) @@ -301,7 +301,7 @@ let check_dereferences callee_pname actual_pre sub spec_pre formal_params = let post_process_sigma (sigma: Sil.hpred list) loc : Sil.hpred list = let map_inst inst = Sil.inst_new_loc loc inst in let do_hpred (_, _, hpred) = Sil.hpred_instmap map_inst hpred in (** update the location of instrumentations *) - list_map (fun hpred -> do_hpred (Prover.expand_hpred_pointer false hpred)) sigma + IList.map (fun hpred -> do_hpred (Prover.expand_hpred_pointer false hpred)) sigma (** check for interprocedural path errors in the post *) let check_path_errors_in_post caller_pname post post_path = @@ -319,7 +319,7 @@ let check_path_errors_in_post caller_pname post post_path = let pre_opt = State.get_normalized_pre (fun te p -> p) (* Abs.abstract_no_symop *) in Reporting.log_warning caller_pname ~pre: pre_opt exn | _ -> () in - list_iter check_attr (Prop.get_all_attributes post) + IList.iter check_attr (Prop.get_all_attributes post) (** Post process the instantiated post after the function call so that x.f |-> se becomes x |-> \{ f: se \}. @@ -339,7 +339,7 @@ let post_process_post Sil.Aneq (e, c) | a -> a in let prop' = Prop.replace_sigma (post_process_sigma (Prop.get_sigma post) loc) post in - let pi' = list_map atom_update_alloc_attribute (Prop.get_pi prop') in (* update alloc attributes to refer to the caller *) + let pi' = IList.map atom_update_alloc_attribute (Prop.get_pi prop') in (* update alloc attributes to refer to the caller *) let post' = Prop.replace_pi pi' prop' in check_path_errors_in_post caller_pname post' post_path; post', post_path @@ -360,9 +360,9 @@ let rec sexp_set_inst inst = function | Sil.Eexp (e, _) -> Sil.Eexp (e, inst) | Sil.Estruct (fsel, _) -> - Sil.Estruct ((list_map (fun (f, se) -> (f, sexp_set_inst inst se)) fsel), inst) + Sil.Estruct ((IList.map (fun (f, se) -> (f, sexp_set_inst inst se)) fsel), inst) | Sil.Earray (size, esel, _) -> - Sil.Earray (size, list_map (fun (e, se) -> (e, sexp_set_inst inst se)) esel, inst) + Sil.Earray (size, IList.map (fun (e, se) -> (e, sexp_set_inst inst se)) esel, inst) let rec fsel_star_fld fsel1 fsel2 = match fsel1, fsel2 with | [], fsel2 -> fsel2 @@ -379,7 +379,7 @@ and array_content_star se1 se2 = and esel_star_fld esel1 esel2 = match esel1, esel2 with | [], esel2 -> (* don't know whether element is read or written in fun call with array *) - list_map (fun (e, se) -> (e, sexp_set_inst Sil.Inone se)) esel2 + IList.map (fun (e, se) -> (e, sexp_set_inst Sil.Inone se)) esel2 | esel1,[] -> esel1 | (e1, se1):: esel1', (e2, se2):: esel2' -> (match Sil.exp_compare e1 e2 with @@ -432,8 +432,8 @@ let hpred_star_fld (hpred1 : Sil.hpred) (hpred2 : Sil.hpred) : Sil.hpred = (** Implementation of [*] for the field-splitting model *) let sigma_star_fld (sigma1 : Sil.hpred list) (sigma2 : Sil.hpred list) : Sil.hpred list = - let sigma1 = list_stable_sort hpred_lhs_compare sigma1 in - let sigma2 = list_stable_sort hpred_lhs_compare sigma2 in + let sigma1 = IList.stable_sort hpred_lhs_compare sigma1 in + let sigma2 = IList.stable_sort hpred_lhs_compare sigma2 in (* L.out "@.@. computing %a@.STAR @.%a@.@." pp_sigma sigma1 pp_sigma sigma2; *) let rec star sg1 sg2 : Sil.hpred list = match sg1, sg2 with @@ -468,8 +468,8 @@ let sigma_star_typ (sigma1 : Sil.hpred list) (typings2 : (Sil.exp * Sil.exp) lis if !Config.Experiment.activate_subtyping_in_cpp || !Config.curr_language = Config.Java then begin let typing_lhs_compare (e1, _) (e2, _) = Sil.exp_compare e1 e2 in - let sigma1 = list_stable_sort hpred_lhs_compare sigma1 in - let typings2 = list_stable_sort typing_lhs_compare typings2 in + let sigma1 = IList.stable_sort hpred_lhs_compare sigma1 in + let typings2 = IList.stable_sort typing_lhs_compare typings2 in let rec star sg1 typ2 : Sil.hpred list = match sg1, typ2 with | [], _ -> [] @@ -538,11 +538,11 @@ let check_attr_dealloc_mismatch att_old att_new = match att_old, att_new with let prop_copy_footprint_pure p1 p2 = let p2' = Prop.replace_sigma_footprint (Prop.get_sigma_footprint p1) (Prop.replace_pi_footprint (Prop.get_pi_footprint p1) p2) in let pi2 = Prop.get_pi p2' in - let pi2_attr, pi2_noattr = list_partition Prop.atom_is_attribute pi2 in + let pi2_attr, pi2_noattr = IList.partition Prop.atom_is_attribute pi2 in let res_noattr = Prop.replace_pi (Prop.get_pure p1 @ pi2_noattr) p2' in let replace_attr prop atom = (* call replace_atom_attribute which deals with existing attibutes *) Prop.replace_atom_attribute check_attr_dealloc_mismatch prop atom in - list_fold_left replace_attr (Prop.normalize res_noattr) pi2_attr + IList.fold_left replace_attr (Prop.normalize res_noattr) pi2_attr (** check if an expression is an exception *) let exp_is_exn = function @@ -556,7 +556,7 @@ let prop_is_exn pname prop = | Sil.Hpointsto (e1, Sil.Eexp(e2, _), _) when Sil.exp_equal e1 ret_pvar -> exp_is_exn e2 | _ -> false in - list_exists is_exn (Prop.get_sigma prop) + IList.exists is_exn (Prop.get_sigma prop) (** when prop is an exception, return the exception name *) let prop_get_exn_name pname prop = @@ -567,13 +567,13 @@ let prop_get_exn_name pname prop = | Sil.Hpointsto (e1, _, Sil.Sizeof(Sil.Tstruct (_, _, _, Some name, _, _, _), _)) when Sil.exp_equal e1 e -> exn_name := name | _ -> () in - list_iter do_hpred (Prop.get_sigma prop) in + IList.iter do_hpred (Prop.get_sigma prop) in let find_ret () = let do_hpred = function | Sil.Hpointsto (e1, Sil.Eexp(Sil.Const (Sil.Cexn e2), _), _) when Sil.exp_equal e1 ret_pvar -> find_exn_name e2 | _ -> () in - list_iter do_hpred (Prop.get_sigma prop) in + IList.iter do_hpred (Prop.get_sigma prop) in find_ret (); !exn_name @@ -593,7 +593,7 @@ let prop_set_exn pname prop se_exn = | Sil.Hpointsto (e, _, t) when Sil.exp_equal e ret_pvar -> Sil.Hpointsto(e, se_exn, t) | hpred -> hpred in - let sigma' = list_map map_hpred (Prop.get_sigma prop) in + let sigma' = IList.map map_hpred (Prop.get_sigma prop) in Prop.normalize (Prop.replace_sigma sigma' prop) (** Include a subtrace for a procedure call if the callee is not a model. *) @@ -609,8 +609,8 @@ let combine let new_footprint_pi = Prop.pi_sub split.sub split.missing_pi in let new_footprint_sigma = Prop.sigma_sub split.sub split.missing_sigma in let new_frame_fld = Prop.sigma_sub split.sub split.frame_fld in - let new_frame_typ = list_map (fun (e, te) -> Sil.exp_sub split.sub e, Sil.exp_sub split.sub te) split.frame_typ in - let new_missing_typ = list_map (fun (e, te) -> Sil.exp_sub split.sub e, Sil.exp_sub split.sub te) split.missing_typ in + let new_frame_typ = IList.map (fun (e, te) -> Sil.exp_sub split.sub e, Sil.exp_sub split.sub te) split.frame_typ in + let new_missing_typ = IList.map (fun (e, te) -> Sil.exp_sub split.sub e, Sil.exp_sub split.sub te) split.missing_typ in let new_missing_fld = let sigma = Prop.sigma_sub split.sub split.missing_fld in let filter hpred = @@ -625,7 +625,7 @@ let combine | _ -> L.d_warning "Missing fields in complex pred: "; Sil.d_hpred hpred; L.d_ln (); false in - list_filter filter sigma in + IList.filter filter sigma in let instantiated_frame = Prop.sigma_sub split.sub split.frame in let instantiated_post = let posts' = @@ -634,7 +634,7 @@ let combine (* with updated footprint and inconsistent current *) [(Prop.replace_pi [Sil.Aneq (Sil.exp_zero, Sil.exp_zero)] Prop.prop_emp, path_pre)] else - list_map + IList.map (fun (p, path_post) -> (p, Paths.Path.add_call @@ -643,7 +643,7 @@ let combine callee_pname path_post)) posts in - list_map + IList.map (fun (p, path) -> (post_process_post caller_pname callee_pname loc actual_pre (Prop.prop_sub split.sub p, path))) @@ -655,7 +655,7 @@ let combine L.d_strln "Missing fld:"; Prop.d_sigma new_missing_fld; L.d_ln (); if new_frame_typ <> [] then L.d_strln "Missing typ:"; Prover.d_typings new_missing_typ; L.d_ln (); L.d_strln "Instantiated frame:"; Prop.d_sigma instantiated_frame; L.d_ln (); - L.d_strln "Instantiated post:"; Propgraph.d_proplist Prop.prop_emp (list_map fst instantiated_post); + L.d_strln "Instantiated post:"; Propgraph.d_proplist Prop.prop_emp (IList.map fst instantiated_post); L.d_decrease_indent 1; L.d_ln (); let compute_result post_p = let post_p' = @@ -670,7 +670,7 @@ let combine | Sil.Aeq (Sil.Var id', Sil.Const (Sil.Cint i)) -> Ident.equal id id' && Sil.Int.isnull i | _ -> false in - list_exists filter new_footprint_pi in + IList.exists filter new_footprint_pi in let f (e, inst_opt) = match e, inst_opt with | Sil.Var id, Some inst when id_assigned_to_null id -> let inst' = Sil.inst_set_null_case_flag inst in @@ -700,11 +700,11 @@ let combine | Sil.Hpointsto (e, Sil.Eexp (e', inst), t) when exp_is_exn e' -> (* resuls is an exception: set in caller *) let p = Prop.prop_iter_remove_curr_then_to_prop iter' in prop_set_exn caller_pname p (Sil.Eexp (e', inst)) - | Sil.Hpointsto (e, Sil.Eexp (e', inst), t) when list_length ret_ids = 1 -> + | Sil.Hpointsto (e, Sil.Eexp (e', inst), t) when IList.length ret_ids = 1 -> let p = Prop.prop_iter_remove_curr_then_to_prop iter' in - Prop.conjoin_eq e' (Sil.Var (list_hd ret_ids)) p + Prop.conjoin_eq e' (Sil.Var (IList.hd ret_ids)) p | Sil.Hpointsto (e, Sil.Estruct (ftl, _), t) - when list_length ftl = list_length ret_ids -> + when IList.length ftl = IList.length ret_ids -> let rec do_ftl_ids p = function | [], [] -> p | (f, Sil.Eexp (e', inst')):: ftl', ret_id:: ret_ids' -> @@ -722,12 +722,12 @@ let combine prop_footprint_add_pi_sigma_starfld_sigma post_p3 new_footprint_pi new_footprint_sigma new_missing_fld new_missing_typ else Some post_p3 in post_p4 in - let _results = list_map (fun (p, path) -> (compute_result p, path)) instantiated_post in - if list_exists (fun (x, _) -> x = None) _results then (* at least one combine failed *) + let _results = IList.map (fun (p, path) -> (compute_result p, path)) instantiated_post in + if IList.exists (fun (x, _) -> x = None) _results then (* at least one combine failed *) None else - let results = list_map (function (Some x, path) -> (x, path) | (None, _) -> assert false) _results in - print_results actual_pre (list_map fst results); + let results = IList.map (function (Some x, path) -> (x, path) | (None, _) -> assert false) _results in + print_results actual_pre (IList.map fst results); Some results (** Construct the actual precondition: add to the current state a copy @@ -739,14 +739,14 @@ let mk_actual_precondition prop actual_params formal_params = | f:: fpars', a:: apars' -> (f, a) :: comb fpars' apars' | [], _ -> if apars != [] then - (let str = "more actual pars than formal pars in fun call (" ^ string_of_int (list_length actual_params) ^ " vs " ^ string_of_int (list_length formal_params) ^ ")" in + (let str = "more actual pars than formal pars in fun call (" ^ string_of_int (IList.length actual_params) ^ " vs " ^ string_of_int (IList.length formal_params) ^ ")" in L.d_warning str; L.d_ln ()); [] | _:: _,[] -> raise (Exceptions.Wrong_argument_number (try assert false with Assert_failure x -> x)) in comb formal_params actual_params in let mk_instantiation (formal_var, (actual_e, actual_t)) = Prop.mk_ptsto (Sil.Lvar formal_var) (Sil.Eexp (actual_e, Sil.inst_actual_precondition)) (Sil.Sizeof (actual_t, Sil.Subtype.exact)) in - let instantiated_formals = list_map mk_instantiation formals_actuals in + let instantiated_formals = IList.map mk_instantiation formals_actuals in let actual_pre = Prop.prop_sigma_star prop instantiated_formals in Prop.normalize actual_pre @@ -757,7 +757,7 @@ let inconsistent_actualpre_missing actual_pre split_opt = let norm_missing_pi = Prop.pi_sub split.sub split.missing_pi in let norm_missing_sigma = Prop.sigma_sub split.sub split.missing_sigma in let prop'= Prop.normalize (Prop.prop_sigma_star actual_pre norm_missing_sigma) in - let prop''= list_fold_left Prop.prop_atom_and prop' norm_missing_pi in + let prop''= IList.fold_left Prop.prop_atom_and prop' norm_missing_pi in Prover.check_inconsistency prop'' | None -> false @@ -780,7 +780,7 @@ let do_taint_check caller_pname actual_pre missing_pi missing_sigma sub1 sub2 = let rec intersection_taint_untaint taint untaint = (* note: return the first element in the intersection*) match taint with | [] -> None - | e:: taint' -> if (list_exists (fun e' -> Sil.exp_equal e e') untaint) then (Some e) + | e:: taint' -> if (IList.exists (fun e' -> Sil.exp_equal e e') untaint) then (Some e) else intersection_taint_untaint taint' untaint in let augmented_actual_pre = Prop.replace_pi ((Prop.get_pi actual_pre) @ missing_pi) actual_pre in let augmented_actual_pre = Prop.replace_sigma ((Prop.get_sigma actual_pre) @ missing_sigma) augmented_actual_pre in @@ -819,7 +819,7 @@ let get_check_exn check callee_pname loc ml_location = match check with class_cast_exn (Some callee_pname) texp1 texp2 exp ml_location let check_uninitialize_dangling_deref callee_pname actual_pre sub formal_params props = - list_iter (fun (p, _ ) -> + IList.iter (fun (p, _ ) -> match check_dereferences callee_pname actual_pre sub p formal_params with | Some (Deref_undef_exp, desc) -> raise (Exceptions.Dangling_pointer_dereference (Some Sil.DAuninit, desc, try assert false with Assert_failure x -> x)) @@ -838,7 +838,7 @@ let exe_spec meant to eliminate false NPE warnings from the common "if (get() != null) get().something()" pattern *) let last_call_ret_non_null = - list_exists + IList.exists (fun (exp, attr) -> match attr with | Sil.Aretval pname when Procname.equal callee_pname pname -> @@ -847,13 +847,13 @@ let exe_spec (Prop.get_all_attributes prop) in if last_call_ret_non_null then let returns_null prop = - list_exists + IList.exists (function | Sil.Hpointsto (Sil.Lvar pvar, Sil.Eexp (e, _), _) when Sil.pvar_is_return pvar -> Prover.check_equal (Prop.normalize prop) e Sil.exp_zero | _ -> false) (Prop.get_sigma prop) in - list_filter (fun (prop, _) -> not (returns_null prop)) spec.Specs.posts + IList.filter (fun (prop, _) -> not (returns_null prop)) spec.Specs.posts else spec.Specs.posts | _ -> spec.Specs.posts in let actual_pre = mk_actual_precondition prop actual_params formal_params in @@ -886,7 +886,7 @@ let exe_spec (* After combining we check that we have not added a points-to of initialized variables.*) check_uninitialize_dangling_deref callee_pname actual_pre split.sub formal_params results; let inconsistent_results, consistent_results = - list_partition (fun (p, _) -> Prover.check_inconsistency p) results in + IList.partition (fun (p, _) -> Prover.check_inconsistency p) results in let incons_pre_missing = inconsistent_actualpre_missing actual_pre (Some split) in Valid_res { incons_pre_missing = incons_pre_missing; vr_pi = norm_missing_pi; @@ -894,7 +894,7 @@ let exe_spec vr_cons_res = consistent_results; vr_incons_res = inconsistent_results } in begin - list_iter log_check_exn checks; + IList.iter log_check_exn checks; if (!Config.taint_analysis && !Config.developer_mode) then do_taint_check caller_pname actual_pre missing_pi missing_sigma sub1 sub2; let subbed_pre = (Prop.prop_sub sub1 actual_pre) in @@ -919,7 +919,7 @@ let exe_spec | _ -> false in (* missing fields minus hidden fields *) let missing_fld_nohidden = - list_filter (fun hp -> not (hpred_missing_hidden hp)) missing_fld in + IList.filter (fun hp -> not (hpred_missing_hidden hp)) missing_fld in if !Config.footprint = false && norm_missing_sigma != [] then begin L.d_strln "Implication error: missing_sigma not empty in re-execution"; @@ -937,8 +937,8 @@ let remove_constant_string_class prop = let filter = function | Sil.Hpointsto (Sil.Const (Sil.Cstr _ | Sil.Cclass _), _, _) -> false | _ -> true in - let sigma = list_filter filter (Prop.get_sigma prop) in - let sigmafp = list_filter filter (Prop.get_sigma_footprint prop) in + let sigma = IList.filter filter (Prop.get_sigma prop) in + let sigmafp = IList.filter filter (Prop.get_sigma_footprint prop) in let prop' = Prop.replace_sigma_footprint sigmafp (Prop.replace_sigma sigma prop) in Prop.normalize prop' @@ -957,7 +957,7 @@ let prop_pure_to_footprint (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 = list_filter is_footprint_atom_not_attribute pure in + let new_footprint_atoms = IList.filter is_footprint_atom_not_attribute pure in if new_footprint_atoms == [] then p else (** add pure fact to footprint *) @@ -969,7 +969,7 @@ let sigma_has_null_pointer sigma = | Sil.Hpointsto (e, _, _) -> Sil.exp_equal e Sil.exp_zero | _ -> false in - list_exists hpred_null_pointer sigma + IList.exists hpred_null_pointer sigma (** post-process the raw result of a function call *) let exe_call_postprocess tenv ret_ids trace_call callee_pname loc initial_prop results = @@ -977,16 +977,16 @@ let exe_call_postprocess tenv ret_ids trace_call callee_pname loc initial_prop r | Invalid_res _ -> false | Valid_res _ -> true in let valid_res0, invalid_res0 = - list_partition filter_valid_res results in + IList.partition filter_valid_res results in let valid_res = - list_map (function Valid_res cr -> cr | Invalid_res _ -> assert false) valid_res0 in + IList.map (function Valid_res cr -> cr | Invalid_res _ -> assert false) valid_res0 in let invalid_res = - list_map (function Valid_res cr -> assert false | Invalid_res ir -> ir) invalid_res0 in + IList.map (function Valid_res cr -> assert false | Invalid_res ir -> ir) invalid_res0 in let valid_res_miss_pi, valid_res_no_miss_pi = - list_partition (fun vr -> vr.vr_pi != []) valid_res in + IList.partition (fun vr -> vr.vr_pi != []) valid_res in let valid_res_incons_pre_missing, valid_res_cons_pre_missing = - list_partition (fun vr -> vr.incons_pre_missing) valid_res in - let deref_errors = list_filter (function Dereference_error _ -> true | _ -> false) invalid_res in + 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 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 @@ -1002,7 +1002,7 @@ let exe_call_postprocess tenv ret_ids trace_call callee_pname loc initial_prop r 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 list_hd deref_errors with + 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; @@ -1032,9 +1032,9 @@ let exe_call_postprocess tenv ret_ids trace_call callee_pname loc initial_prop r assert false else (* no dereference error detected *) let desc = - if list_exists (function Cannot_combine -> true | _ -> false) invalid_res then + if IList.exists (function Cannot_combine -> true | _ -> false) invalid_res then call_desc (Some Localise.Pnm_dangling) - else if list_exists (function + else if IList.exists (function | Prover_checks (check :: _) -> trace_call Specs.CallStats.CR_not_met; let exn = get_check_exn check callee_pname loc (try assert false with Assert_failure x -> x) in @@ -1049,36 +1049,36 @@ let exe_call_postprocess tenv ret_ids trace_call callee_pname loc initial_prop r let process_valid_res vr = let save_diverging_states () = if not vr.incons_pre_missing && vr.vr_cons_res = [] then (* no consistent results on one spec: divergence *) - let incons_res = list_map (fun (p, path) -> (prop_pure_to_footprint p, path)) vr.vr_incons_res in + let incons_res = IList.map (fun (p, path) -> (prop_pure_to_footprint p, path)) vr.vr_incons_res in State.add_diverging_states (Paths.PathSet.from_renamed_list incons_res) in save_diverging_states (); vr.vr_cons_res in - list_map (fun (p, path) -> (prop_pure_to_footprint p, path)) (list_flatten (list_map process_valid_res valid_res)) + IList.map (fun (p, path) -> (prop_pure_to_footprint p, path)) (IList.flatten (IList.map process_valid_res valid_res)) end else if valid_res_no_miss_pi != [] then - list_flatten (list_map (fun vr -> vr.vr_cons_res) valid_res_no_miss_pi) + IList.flatten (IList.map (fun vr -> vr.vr_cons_res) valid_res_no_miss_pi) else if valid_res_miss_pi == [] then raise (Exceptions.Precondition_not_met (call_desc None, try assert false with Assert_failure x -> x)) else begin L.d_strln "Missing pure facts for the function call:"; - list_iter print_pi (list_map (fun vr -> vr.vr_pi) valid_res_miss_pi); - match Prover.find_minimum_pure_cover (list_map (fun vr -> (vr.vr_pi, vr.vr_cons_res)) valid_res_miss_pi) with + IList.iter print_pi (IList.map (fun vr -> vr.vr_pi) valid_res_miss_pi); + match Prover.find_minimum_pure_cover (IList.map (fun vr -> (vr.vr_pi, vr.vr_cons_res)) valid_res_miss_pi) with | None -> trace_call Specs.CallStats.CR_not_met; raise (Exceptions.Precondition_not_met (call_desc None, try assert false with Assert_failure x -> x)) | Some cover -> L.d_strln "Found minimum cover"; - list_iter print_pi (list_map fst cover); - list_flatten (list_map snd cover) + IList.iter print_pi (IList.map fst cover); + IList.flatten (IList.map snd cover) end in trace_call Specs.CallStats.CR_success; let res = - list_map + IList.map (fun (p, path) -> (quantify_path_idents_remove_constant_strings p, path)) res_with_path_idents in let should_add_ret_attr _ = - let is_likely_getter pn = list_length (Procname.java_get_parameters pn) = 0 in + let is_likely_getter pn = IList.length (Procname.java_get_parameters pn) = 0 in !Config.idempotent_getters && !Config.curr_language = Config.Java && is_likely_getter callee_pname in @@ -1089,7 +1089,7 @@ let exe_call_postprocess tenv ret_ids trace_call callee_pname loc initial_prop r let mark_id_as_retval (p, path) = let att_retval = Sil.Aretval callee_pname in Prop.set_exp_attribute p ret_var att_retval, path in - list_map mark_id_as_retval res + IList.map mark_id_as_retval res | _ -> res (** Execute the function call and return the list of results with return value *) @@ -1102,10 +1102,10 @@ let exe_function_call tenv cfg ret_ids caller_pdesc callee_pname loc actual_para Specs.CallStats.trace summary.Specs.stats.Specs.call_stats callee_pname loc res !Config.footprint in let spec_list, formal_params = spec_find_rename trace_call callee_pname in - let nspecs = list_length spec_list in + let nspecs = IList.length spec_list in L.d_strln ("Found " ^ string_of_int nspecs ^ " specs for function " ^ Procname.to_string callee_pname); L.d_strln ("START EXECUTING SPECS FOR " ^ Procname.to_string callee_pname ^ " from state"); Prop.d_prop prop; L.d_ln (); let exe_one_spec (n, spec) = exe_spec tenv cfg ret_ids (n, nspecs) caller_pdesc callee_pname loc prop path spec actual_params formal_params in - let results = list_map exe_one_spec spec_list in + let results = IList.map exe_one_spec spec_list in exe_call_postprocess tenv ret_ids trace_call callee_pname loc prop results diff --git a/infer/src/backend/type_prop.ml b/infer/src/backend/type_prop.ml index 7cc3f7320..e11306615 100644 --- a/infer/src/backend/type_prop.ml +++ b/infer/src/backend/type_prop.ml @@ -62,8 +62,8 @@ module Control_flow = let new_set_items' = items @ new_set_items in let todo' = if (TM.save_items_to_set) then - let new_set_items'' = list_map TM.to_t new_set_items' in - list_fold_right add_to_todo new_set_items'' todo + let new_set_items'' = IList.map TM.to_t new_set_items' in + IList.fold_right add_to_todo new_set_items'' todo else todo in let items = if (TM.save_items_to_set) then [] @@ -123,7 +123,7 @@ struct module TypeSet = Set.Make(struct type t = type_signature - let compare = Utils.list_compare pair_compare + let compare = IList.compare pair_compare end) let map_value_to_string set = @@ -177,8 +177,8 @@ struct | VarBasic let path_equal p1 p2 = - if (list_length p1) != (list_length p2) then false - else list_for_all2 (fun el1 el2 -> Ident.fieldname_equal el1 el2) p1 p2 + if (IList.length p1) != (IList.length p2) then false + else IList.for_all2 (fun el1 el2 -> Ident.fieldname_equal el1 el2) p1 p2 let typ_to_var_kind typ = match typ with @@ -279,7 +279,7 @@ struct let varname = Mangled.from_string name in let pvar = Sil.mk_pvar varname pname in add_type pvar typ 0 context in - list_fold_left aux context type_signature + IList.fold_left aux context type_signature (* Returns the top type of a variable in the context *) let get_type pvar context = @@ -432,7 +432,7 @@ struct match ityp with | Sil.Tstruct (fields, sftal, csu, nameo, supers, def_mthds, iann) -> let (_, typ, _) = - try ((list_find (fun (f, t, _) -> Ident.fieldname_equal f field)) fields) + try ((IList.find (fun (f, t, _) -> Ident.fieldname_equal f field)) fields) with Not_found -> assert false in typ | _ -> assert false @@ -486,16 +486,16 @@ struct (* print_endline "backtracking..."; *) let preds = Cfg.Node.get_preds old_node in let pred = - try list_find (fun p -> not (Set.mem p set)) preds + try IList.find (fun p -> not (Set.mem p set)) preds with Not_found -> - try list_hd preds + try IList.hd preds with Failure "hd" -> Set.min_elt set in (aux pred) in if (Set.mem old_node set) then backtrack () else let succs = Cfg.Node.get_succs old_node in let node = - try list_find (fun n -> ( Set.mem n set)) succs + try IList.find (fun n -> ( Set.mem n set)) succs with Not_found -> backtrack () in node in match el with @@ -562,7 +562,7 @@ struct let formals = Cfg.Procdesc.get_formals pdesc in let create_typ_bundle (exp, typ) (name, typ2) = (name, (get_type tenv exp id_context context field_context)) in - let typ_bundle = list_map2 create_typ_bundle actual_params formals in + let typ_bundle = IList.map2 create_typ_bundle actual_params formals in let set = Type_map.find_dyn_types callee_pname map in if Type_map.TypeSet.mem typ_bundle set then id_context, context, field_context, map, list @@ -594,7 +594,7 @@ struct | _ -> id_context, context, field_context, map, list in let instrs = Cfg.Node.get_instrs node in let id_context, context, field_context, map, items = - list_fold_left aux (IdContext.empty, context, field_context, map, []) instrs in + IList.fold_left aux (IdContext.empty, context, field_context, map, []) instrs in context, field_context, map, items end @@ -709,9 +709,9 @@ let arg_desc = let base_arg = let options_to_keep = ["-results_dir"] in let filter arg_desc = - list_filter (fun desc -> + IList.filter (fun desc -> let (option_name, _, _, _) = desc in - list_mem string_equal option_name options_to_keep) + IList.mem string_equal option_name options_to_keep) arg_desc in let desc = (filter Utils.base_arg_desc) in Utils.Arg2.create_options_desc false "Parsing Options" desc in @@ -732,7 +732,7 @@ let initialize_map exe_env methods = initial_methods := Procname.Set.add pname !initial_methods; Type_map.add_to_map pname formals map in let meth_list = Procname.Set.elements methods in - let map' = (list_fold_right (init_method exe_env) meth_list Type_map.Map.empty) in + let map' = (IList.fold_right (init_method exe_env) meth_list Type_map.Map.empty) in map' (* Collects all the methods that are defined in the program. *) @@ -747,8 +747,8 @@ let collect_methods exe_env = if Cg.node_defined global_cg n1 && Cg.node_defined global_cg n2 then Procname.Set.add n2 no_main_methods else no_main_methods in - let defined = list_fold_right do_node nodes Procname.Set.empty in - let no_main_methods = list_fold_right do_edge edges Procname.Set.empty in + let defined = IList.fold_right do_node nodes Procname.Set.empty in + let no_main_methods = IList.fold_right do_edge edges Procname.Set.empty in let main_methods = Procname.Set.diff defined no_main_methods in defined_methods := defined; (* TM.set_to_string main_methods; *) @@ -772,7 +772,7 @@ let load_cg_files _exe_env (source_dirs : DB.source_dir list) = | None -> () | Some cg -> (*L.err "loaded %s@." (DB.source_dir_to_string source_dir) *) () in - list_iter (fun source_dir -> load_cg_file _exe_env source_dir) source_dirs; + IList.iter (fun source_dir -> load_cg_file _exe_env source_dir) source_dirs; let exe_env = Exe_env.freeze _exe_env in exe_env diff --git a/infer/src/backend/utils.ml b/infer/src/backend/utils.ml index 28e15c166..9d6dc9524 100644 --- a/infer/src/backend/utils.ml +++ b/infer/src/backend/utils.ml @@ -12,6 +12,10 @@ module F = Format +(** List police: don't use the list module to avoid non-tail recursive + functions and builtin equality. Use IList instead. *) +module List = struct end + (** initial time of the analysis, i.e. when this module is loaded, gotten from Unix.time *) let initial_analysis_time = Unix.time () @@ -56,185 +60,6 @@ let triple_compare compare compare' compare'' (x1, y1, z1) (x2, y2, z2) = if n <> 0 then n else let n = compare' y1 y2 in if n <> 0 then n else compare'' z1 z2 -let list_exists = List.exists -let list_filter = List.filter -let list_find = List.find -let list_fold_left = List.fold_left -let list_fold_left2 = List.fold_left2 -let list_for_all = List.for_all -let list_for_all2 = List.for_all2 -let list_hd = List.hd -let list_iter = List.iter -let list_iter2 = List.iter2 -let list_length = List.length -let list_nth = List.nth -let list_partition = List.partition -let list_rev = List.rev -let list_rev_append = List.rev_append -let list_rev_map = List.rev_map -let list_sort = List.sort -let list_stable_sort = List.stable_sort -let list_tl = List.tl - - - -(** tail-recursive variant of List.fold_right *) -let list_fold_right f l a = - let g x y = f y x in - list_fold_left g a (list_rev l) - -(** tail-recursive variant of List.combine *) -let list_combine = - let rec combine acc l1 l2 = match l1, l2 with - | [], [] -> acc - | x1:: l1, x2:: l2 -> combine ((x1, x2):: acc) l1 l2 - | [], _:: _ - | _:: _, [] -> raise (Invalid_argument "list_combine") in - fun l1 l2 -> list_rev (combine [] l1 l2) - -(** tail-recursive variant of List.split *) -let list_split = - let rec split acc1 acc2 = function - | [] -> (acc1, acc2) - | (x, y):: l -> split (x:: acc1) (y:: acc2) l in - fun l -> - let acc1, acc2 = split [] [] l in - list_rev acc1, list_rev acc2 - -(** Like List.mem but without builtin equality *) -let list_mem equal x l = list_exists (equal x) l - -(** tail-recursive variant of List.flatten *) -let list_flatten = - let rec flatten acc l = match l with - | [] -> acc - | x:: l' -> flatten (list_rev_append x acc) l' in - fun l -> list_rev (flatten [] l) - -let list_flatten_options list = - list_fold_left (fun list -> function | Some x -> x:: list | None -> list) [] list - |> list_rev - -let rec list_drop_first n = function - | xs when n == 0 -> xs - | x:: xs -> list_drop_first (n - 1) xs - | [] -> [] - -let list_drop_last n list = - list_rev (list_drop_first n (list_rev list)) - -(** List police: don't use the list module to avoid non-tail recursive functions and builtin equality *) -module List = struct end - -(** Generic comparison of lists given a compare function for the elements of the list *) -let rec list_compare compare l1 l2 = - match l1, l2 with - | [],[] -> 0 - | [], _ -> - 1 - | _, [] -> 1 - | x1:: l1', x2:: l2' -> - let n = compare x1 x2 in - if n <> 0 then n else list_compare compare l1' l2' - -(** Generic equality of lists given a compare function for the elements of the list *) -let list_equal compare l1 l2 = - list_compare compare l1 l2 = 0 - -(** Returns (reverse input_list) *) -let rec list_rev_with_acc acc = function - | [] -> acc - | x :: xs -> list_rev_with_acc (x:: acc) xs - -(** tail-recursive variant of List.append *) -let list_append l1 l2 = - list_rev_append (list_rev l1) l2 - -(** tail-recursive variant of List.map *) -let list_map f l = - list_rev (list_rev_map f l) - -(** Remove consecutive equal elements from a list (according to the given comparison functions) *) -let list_remove_duplicates compare l = - let rec remove compare acc = function - | [] -> list_rev acc - | [x] -> list_rev (x:: acc) - | x:: ((y:: l'') as l') -> - if compare x y = 0 then remove compare acc (x:: l'') - else remove compare (x:: acc) l' in - remove compare [] l - -(** Remove consecutive equal irrelevant elements from a list (according to the given comparison and relevance functions) *) -let list_remove_irrelevant_duplicates compare relevant l = - let rec remove compare acc = function - | [] -> list_rev acc - | [x] -> list_rev (x:: acc) - | x:: ((y:: l'') as l') -> - if compare x y = 0 then begin - match relevant x, relevant y with - | false, _ -> remove compare acc l' - | true, false -> remove compare acc (x:: l'') - | true, true -> remove compare (x:: acc) l' - end - else remove compare (x:: acc) l' in - remove compare [] l - -(** The function works on sorted lists without duplicates *) -let rec list_merge_sorted_nodup compare res xs1 xs2 = - match xs1, xs2 with - | [], _ -> - list_rev_with_acc xs2 res - | _, [] -> - list_rev_with_acc xs1 res - | x1 :: xs1', x2 :: xs2' -> - let n = compare x1 x2 in - if n = 0 then - list_merge_sorted_nodup compare (x1 :: res) xs1' xs2' - else if n < 0 then - list_merge_sorted_nodup compare (x1 :: res) xs1' xs2 - else - list_merge_sorted_nodup compare (x2 :: res) xs1 xs2' - -let list_intersect compare l1 l2 = - let l1_sorted = list_sort compare l1 in - let l2_sorted = list_sort compare l2 in - let rec f l1 l2 = match l1, l2 with - | ([], _) | (_,[]) -> false - | (x1:: l1', x2:: l2') -> - let x_comparison = compare x1 x2 in - if x_comparison = 0 then true - else if x_comparison < 0 then f l1' l2 - else f l1 l2' in - f l1_sorted l2_sorted - -exception Fail - -(** Apply [f] to pairs of elements; raise [Fail] if the two lists have different lenghts. *) -let list_map2 f l1 l2 = - let rec go l1 l2 acc = - match l1, l2 with - | [],[] -> list_rev acc - | x1 :: l1', x2 :: l2' -> - let x' = f x1 x2 in - go l1' l2' (x':: acc) - | _ -> raise Fail in - go l1 l2 [] - -let list_to_string f l = - let rec aux l = - match l with - | [] -> "" - | s:: [] -> (f s) - | s:: rest -> (f s)^", "^(aux rest) in - "["^(aux l)^"]" - -(** Like List.mem_assoc but without builtin equality *) -let list_mem_assoc equal a l = - list_exists (fun x -> equal a (fst x)) l - -(** Like List.assoc but without builtin equality *) -let list_assoc equal a l = - snd (list_find (fun x -> equal a (fst x)) l) - (** {2 Useful Modules} *) (** Set of integers *) @@ -614,7 +439,7 @@ let read_file fname = with | End_of_file -> cleanup (); - Some (list_rev !res) + Some (IList.rev !res) | Sys_error _ -> cleanup (); None @@ -663,7 +488,7 @@ struct try Hashtbl.find include_loc_hash fname with Not_found -> let loc = match read_file fname with | None -> 0 - | Some l -> list_length l in + | Some l -> IList.length l in Hashtbl.add include_loc_hash fname loc; loc end @@ -708,7 +533,7 @@ module FileNormalize = struct (* split a file name into a list of strings representing it as a path *) let fname_to_list fname = - list_rev (fname_to_list_rev fname) + IList.rev (fname_to_list_rev fname) (* concatenate a list of strings representing a path into a filename *) let rec list_to_fname base path = match path with @@ -725,12 +550,12 @@ module FileNormalize = struct | x :: dl, y :: tl when y = Filename.parent_dir_name -> (* path/x/.. --> path *) normalize dl tl | _, y :: tl -> normalize (y :: done_l) tl - | _, [] -> list_rev done_l + | _, [] -> IList.rev done_l (* check if the filename contains "." or ".." *) let fname_contains_current_parent fname = let l = fname_to_list fname in - list_exists (fun x -> x = Filename.current_dir_name || x = Filename.parent_dir_name) l + IList.exists (fun x -> x = Filename.current_dir_name || x = Filename.parent_dir_name) l (* convert a filename to absolute path, if necessary, and normalize "." and ".." *) let fname_to_absolute_normalize fname = @@ -791,7 +616,7 @@ let filename_to_relative root fname = type arg_list = (string * Arg.spec * string option * string) list let arg_desc_filter options_to_keep = - list_filter (function (option_name, _, _, _) -> list_mem string_equal option_name options_to_keep) + IList.filter (function (option_name, _, _, _) -> IList.mem string_equal option_name options_to_keep) let base_arg_desc = [ @@ -883,7 +708,7 @@ module Arg2 = struct let make_symlist prefix sep suffix l = match l with | [] -> "" - | h:: t -> (list_fold_left (fun x y -> x ^ sep ^ y) (prefix ^ h) t) ^ suffix + | h:: t -> (IList.fold_left (fun x y -> x ^ sep ^ y) (prefix ^ h) t) ^ suffix let print_spec buf (key, spec, doc) = match spec with @@ -909,7 +734,7 @@ module Arg2 = struct let usage_b buf speclist errmsg = bprintf buf "%s\n" errmsg; - list_iter (print_spec buf) (add_help speclist) + IList.iter (print_spec buf) (add_help speclist) let usage speclist errmsg = let b = Buffer.create 200 in @@ -966,7 +791,7 @@ module Arg2 = struct incr current; | Arg.Symbol (symb, f) when !current + 1 < l -> let arg = argv.(!current + 1) in - if list_mem string_equal arg symb then begin + if IList.mem string_equal arg symb then begin f argv.(!current + 1); incr current; end else begin @@ -1005,7 +830,7 @@ module Arg2 = struct end; incr current; | Arg.Tuple specs -> - list_iter treat_action specs; + IList.iter treat_action specs; | Arg.Rest f -> while !current < l - 1 do f argv.(!current + 1); @@ -1044,7 +869,7 @@ module Arg2 = struct let doc2 = String.sub doc first_space (len - first_space) in if len = 0 then (key, spec, doc) else (key, spec, doc1 ^ "\n " ^ doc2) in - list_map do_arg arg_desc + IList.map do_arg arg_desc type aligned = (key * spec * doc) @@ -1060,10 +885,10 @@ module Arg2 = struct | Some param -> if double_minus then ("-"^opname, spec, "=" ^ param ^ " " ^ text) else (opname, spec, param ^ " " ^ text) in - let unsorted_desc' = list_map handle_double_minus unsorted_desc in + let unsorted_desc' = IList.map handle_double_minus unsorted_desc in let dlist = ("", Arg.Unit (fun () -> ()), " \n " ^ title ^ "\n") :: - list_sort (fun (x, _, _) (y, _, _) -> Pervasives.compare x y) unsorted_desc' in + IList.sort (fun (x, _, _) (y, _, _) -> Pervasives.compare x y) unsorted_desc' in align dlist end (********** END OF MODULE Arg2 **********) @@ -1137,7 +962,7 @@ let proc_flags_find proc_flags key = let join_strings sep = function | [] -> "" | hd:: tl -> - list_fold_left (fun str p -> str ^ sep ^ p) hd tl + IList.fold_left (fun str p -> str ^ sep ^ p) hd tl let next compare = fun x y n -> diff --git a/infer/src/backend/utils.mli b/infer/src/backend/utils.mli index b02123ffe..c53780b86 100644 --- a/infer/src/backend/utils.mli +++ b/infer/src/backend/utils.mli @@ -12,6 +12,10 @@ (** {2 Generic Utility Functions} *) +(** List police: don't use the list module to avoid non-tail recursive + functions and builtin equality. Use IList instead. *) +module List : sig end + (** Compare police: generic compare disabled. *) val compare : unit @@ -36,12 +40,6 @@ val pair_compare : ('a -> 'b -> int) -> ('c -> 'd -> int) -> ('a * 'c) -> ('b * (** Generic comparison of pairs given a compare function for each element of the triple. *) val triple_compare : ('a -> 'b -> int) -> ('c -> 'd -> int) -> ('e -> 'f -> int) -> ('a * 'c * 'e) -> ('b * 'd * 'f) -> int -(** Generic comparison of lists given a compare function for the elements of the list *) -val list_compare : ('a -> 'b -> int) -> 'a list -> 'b list -> int - -(** Generic equality of lists given a compare function for the elements of the list *) -val list_equal : ('a -> 'b -> int) -> 'a list -> 'b list -> bool - (** Comparison for strings *) val string_compare : string -> string -> int @@ -51,91 +49,6 @@ val string_equal : string -> string -> bool (** Comparison for floats *) val float_compare : float -> float -> int -(** tail-recursive variant of List.append *) -val list_append : 'a list -> 'a list -> 'a list - -(** tail-recursive variant of List.combine *) -val list_combine : 'a list -> 'b list -> ('a * 'b) list - -val list_exists : ('a -> bool) -> 'a list -> bool -val list_filter : ('a -> bool) -> 'a list -> 'a list - -(** tail-recursive variant of List.flatten *) -val list_flatten : 'a list list -> 'a list - -(** Remove all None elements from the list. *) -val list_flatten_options : ('a option) list -> 'a list - -val list_find : ('a -> bool) -> 'a list -> 'a -val list_fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a -val list_fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a -val list_for_all : ('a -> bool) -> 'a list -> bool -val list_for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool -val list_hd : 'a list -> 'a -val list_iter : ('a -> unit) -> 'a list -> unit -val list_iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit -val list_length : 'a list -> int - -(** tail-recursive variant of List.fold_right *) -val list_fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b - -(** tail-recursive variant of List.map *) -val list_map : ('a -> 'b) -> 'a list -> 'b list - -(** Like List.mem but without builtin equality *) -val list_mem : ('a -> 'b -> bool) -> 'a -> 'b list -> bool - -val list_nth : 'a list -> int -> 'a -val list_partition : ('a -> bool) -> 'a list -> 'a list * 'a list -val list_rev : 'a list -> 'a list -val list_rev_append : 'a list -> 'a list -> 'a list -val list_rev_map : ('a -> 'b) -> 'a list -> 'b list -val list_sort : ('a -> 'a -> int) -> 'a list -> 'a list - -(** tail-recursive variant of List.split *) -val list_split : ('a * 'b) list -> 'a list * 'b list - -val list_stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list -val list_tl : 'a list -> 'a list - -(* Drops the first n elements from a list. *) -val list_drop_first : int -> 'a list -> 'a list - -(* Drops the last n elements from a list. *) -val list_drop_last : int -> 'a list -> 'a list - -(** List police: don't use the list module to avoid non-tail-recursive functions and builtin equality *) -module List : sig end - -(** Returns (reverse input_list)[@]acc *) -val list_rev_with_acc : 'a list -> 'a list -> 'a list - -(** Remove consecutive equal elements from a list (according to the given comparison functions) *) -val list_remove_duplicates : ('a -> 'a -> int) -> 'a list -> 'a list - -(** Remove consecutive equal irrelevant elements from a list (according to the given comparison and relevance functions) *) -val list_remove_irrelevant_duplicates : ('a -> 'a -> int) -> ('a -> bool) -> 'a list -> 'a list - -(** The function works on sorted lists without duplicates *) -val list_merge_sorted_nodup : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list -> 'a list - -(** Returns whether there is an intersection in the elements of the two lists. - The compare function is required to sort the lists. *) -val list_intersect : ('a -> 'a -> int) -> 'a list -> 'a list -> bool - -(** Like List.mem_assoc but without builtin equality *) -val list_mem_assoc : ('a -> 'a -> bool) -> 'a -> ('a * 'b) list -> bool - -(** Like List.assoc but without builtin equality *) -val list_assoc : ('a -> 'a -> bool) -> 'a -> ('a * 'b) list -> 'b - -exception Fail - -(** Apply [f] to pairs of elements; raise [Fail] if the two lists have different lenghts. *) -val list_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list - -val list_to_string : ('a -> string) -> 'a list -> string - (** {2 Useful Modules} *) (** Set of integers *) diff --git a/infer/src/checkers/annotations.ml b/infer/src/checkers/annotations.ml index 1b0dcb49a..440caf803 100644 --- a/infer/src/checkers/annotations.ml +++ b/infer/src/checkers/annotations.ml @@ -28,7 +28,7 @@ let equal as1 as2 = and ia2, t2 = as2.ret in Sil.item_annotation_compare ia1 ia2 = 0 && Sil.typ_equal t1 t2 && - list_for_all2 param_equal as1.params as2.params + IList.for_all2 param_equal as1.params as2.params let visibleForTesting = "com.google.common.annotations.VisibleForTesting" let javaxNullable = "javax.annotation.Nullable" @@ -40,17 +40,17 @@ let get_field_type_and_annotation fn = function | Sil.Tptr (Sil.Tstruct (ftal, sftal, _, _, _, _, _), _) | Sil.Tstruct (ftal, sftal, _, _, _, _, _) -> (try - let (_, t, a) = list_find (fun (f, t, a) -> Sil.fld_equal f fn) (ftal @ sftal) in + let (_, t, a) = IList.find (fun (f, t, a) -> Sil.fld_equal f fn) (ftal @ sftal) in Some (t, a) with Not_found -> None) | _ -> None let ia_iter f = let ann_iter (a, b) = f a in - list_iter ann_iter + IList.iter ann_iter let ma_iter f ((ia, ial) : Sil.method_annotation) = - list_iter (ia_iter f) (ia:: ial) + IList.iter (ia_iter f) (ia:: ial) let ma_has_annotation_with (ma: Sil.method_annotation) @@ -92,7 +92,7 @@ let ia_get ia ann_name = let ma_contains ma ann_names = let found = ref false in - ma_iter (fun a -> if list_exists (string_equal a.Sil.class_name) ann_names then found := true) ma; + ma_iter (fun a -> if IList.exists (string_equal a.Sil.class_name) ann_names then found := true) ma; !found let initializer_ = "Initializer" @@ -117,7 +117,7 @@ let ia_is_present ia = ia_ends_with ia present let ia_is_nonnull ia = - list_exists + IList.exists (ia_ends_with ia) [nonnull; notnull; camel_nonnull] @@ -131,7 +131,7 @@ let ia_is_initializer ia = ia_ends_with ia initializer_ let ia_is_inject ia = - list_exists + IList.exists (ia_ends_with ia) [inject; inject_view; bind] @@ -172,7 +172,7 @@ let get_annotated_signature proc_attributes : annotated_signature = [] | _ :: _, [] -> assert false in - list_rev (extract (list_rev ial0) (list_rev formals)) in + IList.rev (extract (IList.rev ial0) (IList.rev formals)) in let annotated_signature = { ret = (ia, ret_type); params = natl } in annotated_signature @@ -204,13 +204,13 @@ let annotated_signature_is_anonymous_inner_class_wrapper ann_sig proc_name = PatternMatch.type_is_object t in Procname.java_is_anonymous_inner_class proc_name && check_ret ann_sig.ret - && list_for_all check_param ann_sig.params + && IList.for_all check_param ann_sig.params && !x_param_found (** Check if the given parameter has a Nullable annotation in the given signature *) let param_is_nullable pvar ann_sig = let pvar_str = Mangled.to_string (Sil.pvar_get_name pvar) in - list_exists + IList.exists (fun (param_str, annot, _) -> param_str = pvar_str && ia_is_nullable annot) ann_sig.params diff --git a/infer/src/checkers/callbackChecker.ml b/infer/src/checkers/callbackChecker.ml index 8f313ce2f..96c5df8a6 100644 --- a/infer/src/checkers/callbackChecker.ml +++ b/infer/src/checkers/callbackChecker.ml @@ -43,7 +43,7 @@ let android_lifecycle_typs = ref [] (** resolve the list of android lifecycle type strings in [tenv] *) let get_or_create_lifecycle_typs tenv = match !android_lifecycle_typs with | [] -> - let lifecycle_typs = list_fold_left (fun typs (pkg, clazz, methods) -> + let lifecycle_typs = IList.fold_left (fun typs (pkg, clazz, methods) -> let qualified_name = Mangled.from_package_class pkg clazz in match AndroidFramework.get_lifecycle_for_framework_typ_opt qualified_name methods tenv with @@ -83,7 +83,7 @@ let callback_checker_main all_procs get_procdesc idenv tenv proc_name proc_desc match Sil.get_typ (Mangled.from_string (Procname.java_get_class proc_name)) None tenv with | Some (Sil.Tstruct(_, _, csu, Some class_name, _, methods, _) as typ) -> let lifecycle_typs = get_or_create_lifecycle_typs tenv in - let proc_belongs_to_lifecycle_typ = list_exists + let proc_belongs_to_lifecycle_typ = IList.exists (fun lifecycle_typ -> AndroidFramework.typ_is_lifecycle_typ typ lifecycle_typ tenv) lifecycle_typs in if proc_belongs_to_lifecycle_typ then @@ -91,11 +91,11 @@ let callback_checker_main all_procs get_procdesc idenv tenv proc_name proc_desc let registered_callback_typs = AndroidFramework.get_callbacks_registered_by_proc proc_desc tenv in (* find the callbacks registered by this procedure and update the list *) - let registered_callback_procs' = list_fold_left + let registered_callback_procs' = IList.fold_left (fun callback_procs callback_typ -> match callback_typ with | Sil.Tptr (Sil.Tstruct(_, _, Sil.Class, Some class_name, _, methods, _), _) -> - list_fold_left + IList.fold_left (fun callback_procs callback_proc -> if Procname.is_constructor callback_proc then callback_procs else Procname.Set.add callback_proc callback_procs) @@ -109,6 +109,6 @@ let callback_checker_main all_procs get_procdesc idenv tenv proc_name proc_desc (* compute the set of fields nullified by this procedure *) (* TODO (t4959422): get fields that are nullified in callees of the destroy method *) fields_nullified := FldSet.union (get_fields_nullified proc_desc) !fields_nullified in - if done_checking (list_length methods) then + if done_checking (IList.length methods) then do_eradicate_check all_procs get_procdesc idenv tenv | _ -> () diff --git a/infer/src/checkers/checkDeadCode.ml b/infer/src/checkers/checkDeadCode.ml index c7b9458c0..968a244cc 100644 --- a/infer/src/checkers/checkDeadCode.ml +++ b/infer/src/checkers/checkDeadCode.ml @@ -68,13 +68,13 @@ let report_error description pn pd loc = (** Check the final state at the end of the analysis. *) let check_final_state proc_name proc_desc exit_node final_s = let proc_nodes = Cfg.Procdesc.get_nodes proc_desc in - let tot_nodes = list_length proc_nodes in + let tot_nodes = IList.length proc_nodes in let tot_visited = State.num_visited final_s in if verbose then L.stderr "TOT nodes: %d (visited: %n)@." tot_nodes tot_visited; if tot_nodes <> tot_visited then begin let not_visited = - list_filter (fun n -> not (Cfg.NodeSet.mem n (State.get_visited final_s))) proc_nodes in + IList.filter (fun n -> not (Cfg.NodeSet.mem n (State.get_visited final_s))) proc_nodes in let do_node n = let loc = Cfg.Node.get_loc n in let description = Format.sprintf "Node not visited: %d" (Cfg.Node.get_id n) in @@ -84,7 +84,7 @@ let check_final_state proc_name proc_desc exit_node final_s = | _ -> true in if report then report_error description proc_name proc_desc loc in - list_iter do_node not_visited + IList.iter do_node not_visited end (** Simple check for dead code. *) diff --git a/infer/src/checkers/checkers.ml b/infer/src/checkers/checkers.ml index 77b590ed4..9be249ad4 100644 --- a/infer/src/checkers/checkers.ml +++ b/infer/src/checkers/checkers.ml @@ -96,8 +96,8 @@ module ST = struct string_equal (normalize s1) (normalize s2) in let is_parameter_suppressed = - list_mem string_equal a.Sil.class_name [Annotations.suppressLint] && - list_mem normalized_equal kind a.Sil.parameters in + IList.mem string_equal a.Sil.class_name [Annotations.suppressLint] && + IList.mem normalized_equal kind a.Sil.parameters in let is_annotation_suppressed = string_is_suffix (normalize (drop_prefix kind)) (normalize a.Sil.class_name) in @@ -186,9 +186,9 @@ let callback_check_access all_procs get_proc_desc idenv tenv proc_name proc_desc (** Report all field accesses and method calls of a class. *) let callback_check_cluster_access all_procs get_proc_desc proc_definitions = - list_iter + IList.iter (Option.may (fun d -> Cfg.Procdesc.iter_instrs (report_calls_and_accesses "CLUSTER") d)) - (list_map get_proc_desc all_procs) + (IList.map get_proc_desc all_procs) (** Looks for writeToParcel methods and checks whether read is in reverse *) let callback_check_write_to_parcel all_procs get_proc_desc idenv tenv proc_name proc_desc = @@ -206,7 +206,7 @@ let callback_check_write_to_parcel all_procs get_proc_desc idenv tenv proc_name let parcel_constructors = function | Sil.Tptr (Sil.Tstruct (_, _, _, _, _, methods, _), _) -> - list_filter is_parcel_constructor methods + IList.filter is_parcel_constructor methods | _ -> [] in let check r_name r_desc w_name w_desc = @@ -235,8 +235,8 @@ let callback_check_write_to_parcel all_procs get_proc_desc idenv tenv proc_name | [desc] -> desc | _ -> assert false in - let r_call_descs = list_map node_to_call_desc (list_filter is_serialization_node (Cfg.Procdesc.get_sliced_slope r_desc is_serialization_node)) in - let w_call_descs = list_map node_to_call_desc (list_filter is_serialization_node (Cfg.Procdesc.get_sliced_slope w_desc is_serialization_node)) in + let r_call_descs = IList.map node_to_call_desc (IList.filter is_serialization_node (Cfg.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 (Cfg.Procdesc.get_sliced_slope w_desc is_serialization_node)) in let rec check_match = function | rc:: rcs, wc:: wcs -> @@ -282,8 +282,8 @@ let callback_monitor_nullcheck all_procs get_proc_desc idenv tenv proc_name proc | _, Sil.Tstruct _ -> true | _, Sil.Tptr (Sil.Tstruct _, _) -> true | _ -> false in - list_filter is_class_type formals in - list_map (fun (s, _) -> Mangled.from_string s) class_formals) in + IList.filter is_class_type formals in + IList.map (fun (s, _) -> Mangled.from_string s) class_formals) in let equal_formal_param exp formal_name = match exp with | Sil.Lvar pvar -> let name = Sil.pvar_get_name pvar in @@ -291,7 +291,7 @@ let callback_monitor_nullcheck all_procs get_proc_desc idenv tenv proc_name proc | _ -> false in let is_formal_param exp = - list_exists (equal_formal_param exp) (Lazy.force class_formal_names) in + IList.exists (equal_formal_param exp) (Lazy.force class_formal_names) in let is_nullcheck pn = PatternMatch.java_proc_name_with_class_method @@ -310,12 +310,12 @@ let callback_monitor_nullcheck all_procs get_proc_desc idenv tenv proc_name proc let summary_checks_of_formals () = let formal_names = Lazy.force class_formal_names in let nchecks = Sil.ExpSet.cardinal !checks_to_formals in - let nformals = list_length formal_names in + let nformals = IList.length formal_names in if (nchecks > 0 && nchecks < nformals) then begin let was_not_found formal_name = not (Sil.ExpSet.exists (fun exp -> equal_formal_param exp formal_name) !checks_to_formals) in - let missing = list_filter was_not_found formal_names in + let missing = IList.filter was_not_found formal_names in let loc = Cfg.Procdesc.get_loc proc_desc in let pp_file_loc fmt () = F.fprintf fmt "%s:%d" (DB.source_file_to_string loc.Location.file) loc.Location.line in @@ -359,12 +359,12 @@ let callback_find_deserialization all_procs get_proc_desc idenv tenv proc_name 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(list_find f (Cfg.Node.get_instrs node)); true + try ignore(IList.find f (Cfg.Node.get_instrs node)); true with Not_found -> false in let preds = Cfg.Node.get_generated_slope node (fun n -> Cfg.Node.get_sliced_preds n has_instr) in - let instrs = list_flatten (list_map (fun n -> list_rev (Cfg.Node.get_instrs n)) preds) in + let instrs = IList.flatten (IList.map (fun n -> IList.rev (Cfg.Node.get_instrs n)) preds) in try - Some (list_find f instrs) + Some (IList.find f instrs) with Not_found -> None in let get_return_const proc_name' = @@ -403,7 +403,7 @@ let callback_find_deserialization all_procs get_proc_desc idenv tenv proc_name p | _ -> "?") | _ -> "?" in let arg_name (exp, typ) = find_const exp typ in - Some (list_map arg_name args) + Some (IList.map arg_name args) with _ -> None) | _ -> None in @@ -472,7 +472,7 @@ let callback_check_field_access all_procs get_proc_desc idenv tenv proc_name pro do_read_exp e | Sil.Call (_, e, etl, _, _) -> do_read_exp e; - list_iter (fun (e, _) -> do_read_exp e) etl + IList.iter (fun (e, _) -> do_read_exp e) etl | Sil.Nullify _ | Sil.Abstract _ | Sil.Remove_temps _ diff --git a/infer/src/checkers/codeQuery.ml b/infer/src/checkers/codeQuery.ml index 31d8c3ecd..dba43e131 100644 --- a/infer/src/checkers/codeQuery.ml +++ b/infer/src/checkers/codeQuery.ml @@ -38,7 +38,7 @@ module Err = struct (** Update the summary with stats from the checker. *) let update_summary proc_name proc_desc = let old_summ = Specs.get_summary_unsafe "codeQuery" proc_name in - let nodes = list_map (fun n -> Cfg.Node.get_id n) (Cfg.Procdesc.get_nodes proc_desc) in + let nodes = IList.map (fun n -> Cfg.Node.get_id n) (Cfg.Procdesc.get_nodes proc_desc) in let specs = let spec = { Specs.pre = Specs.Jprop.Prop (1, Prop.prop_emp); @@ -134,7 +134,7 @@ module Match = struct match Cfg.Node.get_succs node with | [node'] -> let instrs = Cfg.Node.get_instrs node in - list_iter (fun instr -> iter (node', instr)) instrs; + IList.iter (fun instr -> iter (node', instr)) instrs; iter_succ_nodes node' iter | [] -> () | _:: _ -> () @@ -167,7 +167,7 @@ module Match = struct | CodeQueryAst.Call _, _ -> false | CodeQueryAst.MethodCall (ae1, ae2, ael_opt), Sil.Call (_, Sil.Const (Sil.Cfun pn), (_e1, t1):: params, loc, { Sil.cf_virtual = true }) -> let e1 = Idenv.expand_expr idenv _e1 in - let vl = list_map (function _e, t -> Vval (Idenv.expand_expr idenv _e)) params in + let vl = IList.map (function _e, t -> Vval (Idenv.expand_expr idenv _e)) params in if exp_match env ae1 (Vval e1) && exp_match env ae2 (Vfun pn) && opt_match exp_list_match env ael_opt vl then begin if show then print_action env action proc_name node loc; diff --git a/infer/src/checkers/constantPropagation.ml b/infer/src/checkers/constantPropagation.ml index b14aca7b6..277318d01 100644 --- a/infer/src/checkers/constantPropagation.ml +++ b/infer/src/checkers/constantPropagation.ml @@ -105,12 +105,12 @@ module ConstantFlow = Dataflow.MakeDF(struct begin L.stdout "Node %i:" (Cfg.Node.get_id node); L.stdout "%a" pp constants; - list_iter + IList.iter (fun instr -> L.stdout "%a@." (Sil.pp_instr pe_text) instr) (Cfg.Node.get_instrs node) end; let constants = - list_fold_left + IList.fold_left do_instr constants (Cfg.Node.get_instrs node) in diff --git a/infer/src/checkers/dataflow.ml b/infer/src/checkers/dataflow.ml index da0cd8626..ad6125c95 100644 --- a/infer/src/checkers/dataflow.ml +++ b/infer/src/checkers/dataflow.ml @@ -70,7 +70,7 @@ let node_throws node (proc_throws : Procname.t -> throws) : throws = | t, DoesNotThrow -> res := t in let do_instr instr = update_res (instr_throws instr) in - list_iter do_instr (Cfg.Node.get_instrs node); + IList.iter do_instr (Cfg.Node.get_instrs node); !res (** Create an instance of the dataflow algorithm given a state parameter. *) @@ -95,7 +95,7 @@ module MakeDF(St: DFStateType) : DF with type state = St.t = struct | Transition of state * state list * state list let join states initial_state = - list_fold_left + IList.fold_left St.join initial_state states @@ -116,12 +116,12 @@ module MakeDF(St: DFStateType) : DF with type state = St.t = struct let succ_nodes = Cfg.Node.get_succs node in let exn_nodes = Cfg.Node.get_exn node in if throws <> Throws then - list_iter - (fun s -> list_iter (propagate_to_dest s) succ_nodes) + IList.iter + (fun s -> IList.iter (propagate_to_dest s) succ_nodes) states_succ; if throws <> DoesNotThrow then - list_iter - (fun s -> list_iter (propagate_to_dest s) exn_nodes) + IList.iter + (fun s -> IList.iter (propagate_to_dest s) exn_nodes) states_exn; H.replace t.post_states node states_succ; @@ -182,4 +182,4 @@ let callback_test_dataflow all_procs get_proc_desc idenv tenv proc_name proc_des match transitions node with | DFCount.Transition (pre_state, _, _) -> () | DFCount.Dead_state -> () in - list_iter do_node (Cfg.Procdesc.get_nodes proc_desc) + IList.iter do_node (Cfg.Procdesc.get_nodes proc_desc) diff --git a/infer/src/checkers/eradicate.ml b/infer/src/checkers/eradicate.ml index 006250964..50c9b29d8 100644 --- a/infer/src/checkers/eradicate.ml +++ b/infer/src/checkers/eradicate.ml @@ -53,7 +53,7 @@ struct let update_summary proc_name proc_desc final_typestate_opt = match Specs.get_summary proc_name with | Some old_summ -> - let nodes = list_map (fun n -> Cfg.Node.get_id n) (Cfg.Procdesc.get_nodes proc_desc) in + let nodes = IList.map (fun n -> Cfg.Node.get_id n) (Cfg.Procdesc.get_nodes proc_desc) in let method_annotation = (Specs.pdesc_resolve_attributes proc_desc).ProcAttributes.method_annotation in let new_summ = @@ -84,7 +84,7 @@ struct TypeState.add_pvar pvar (typ, ta, []) typestate in let get_initial_typestate () = let typestate_empty = TypeState.empty Extension.ext in - list_fold_left add_formal typestate_empty annotated_signature.Annotations.params in + IList.fold_left add_formal typestate_empty annotated_signature.Annotations.params in (** Check the nullable flag computed for the return value and report inconsistencies. *) let check_return find_canonical_duplicate exit_node final_typestate ret_ia ret_type loc : unit = @@ -98,7 +98,7 @@ struct State.set_node exit_node; if checks.TypeCheck.check_ret_type <> [] then - list_iter + IList.iter (fun f -> f curr_pname curr_pdesc ret_type typ_found_opt loc) checks.TypeCheck.check_ret_type; if checks.TypeCheck.eradicate then @@ -128,7 +128,7 @@ struct Extension.ext calls_this checks idenv get_proc_desc curr_pname curr_pdesc find_canonical_duplicate annotated_signature typestate node linereader in if trace then - list_iter (fun typestate_succ -> + IList.iter (fun typestate_succ -> L.stdout "Typestate After Node %a@\n%a@." Cfg.Node.pp node @@ -203,8 +203,8 @@ struct | Some callee_pd -> res := (callee_pn, callee_pd) :: !res | None -> () in - list_iter do_called private_called in - list_iter do_proc initializers; + IList.iter do_called private_called in + IList.iter do_proc initializers; !res in (** Get the initializers recursively called by computing a fixpoint. @@ -215,13 +215,13 @@ struct let res = ref [] in let seen = ref Procname.Set.empty in let mark_seen (initializers : init list) : unit = - list_iter (fun (pn, _) -> seen := Procname.Set.add pn !seen) initializers; + IList.iter (fun (pn, _) -> seen := Procname.Set.add pn !seen) initializers; res := !res @ initializers in let rec fixpoint initializers_old = let initializers_new = get_private_called initializers_old in let initializers_new' = - list_filter (fun (pn, _) -> not (Procname.Set.mem pn !seen)) initializers_new in + IList.filter (fun (pn, _) -> not (Procname.Set.mem pn !seen)) initializers_new in mark_seen initializers_new'; if initializers_new' <> [] then fixpoint initializers_new' in @@ -236,8 +236,8 @@ struct | _, Some final_typestate -> final_typestates := (pname, final_typestate) :: !final_typestates | _, None -> () in - list_iter get_final_typestate initializers_recursive; - list_rev !final_typestates + IList.iter get_final_typestate initializers_recursive; + IList.rev !final_typestates let pname_and_pdescs_with f = let res = ref [] in @@ -250,8 +250,8 @@ struct | Some pdesc -> res := (pname, pdesc) :: !res | None -> () in - list_iter do_proc all_procs; - list_rev !res + IList.iter do_proc all_procs; + IList.rev !res (** Typestates after the current procedure and all initializer procedures. *) let final_initializer_typestates_lazy = lazy diff --git a/infer/src/checkers/eradicateChecks.ml b/infer/src/checkers/eradicateChecks.ml index 42833cdfb..e4c2051e9 100644 --- a/infer/src/checkers/eradicateChecks.ml +++ b/infer/src/checkers/eradicateChecks.ml @@ -140,7 +140,7 @@ let check_condition case_zero find_canonical_duplicate get_proc_desc curr_pname | _ -> () in let do_node n = if Location.equal loc (Cfg.Node.get_loc n) - then list_iter do_instr (Cfg.Node.get_instrs n) in + then IList.iter do_instr (Cfg.Node.get_instrs n) in Cfg.Procdesc.iter_nodes do_node (Cfg.Node.get_proc_desc node); !throwable_found in @@ -262,7 +262,7 @@ let check_constructor_initialization let filter_range_opt = function | Some (_, ta, _) -> f ta | None -> unknown in - list_exists + IList.exists (function pname, typestate -> let pvar = Sil.mk_pvar (Mangled.from_string (Ident.fieldname_to_string fn)) @@ -321,7 +321,7 @@ let check_constructor_initialization curr_pname; end in - list_iter do_fta ftal + IList.iter do_fta ftal | _ -> () end @@ -428,7 +428,7 @@ let check_call_parameters instr_ref typecheck_expr print_current_state : unit = let callee_pname = callee_attributes.ProcAttributes.proc_name in let has_this = is_virtual sig_params in - let tot_param_num = list_length sig_params - (if has_this then 1 else 0) in + let tot_param_num = IList.length sig_params - (if has_this then 1 else 0) in let rec check sparams cparams = match sparams, cparams with | (s1, ia1, t1) :: sparams', ((orig_e2, e2), t2) :: cparams' -> let param_is_this = s1 = "this" in @@ -460,7 +460,7 @@ let check_call_parameters | None -> "formal parameter " ^ s1 in let origin_descr = TypeAnnotation.descr_origin ta2 in - let param_num = list_length sparams' + (if has_this then 0 else 1) in + let param_num = IList.length sparams' + (if has_this then 0 else 1) in let callee_loc = callee_attributes.ProcAttributes.loc in report_error find_canonical_duplicate @@ -487,7 +487,7 @@ let check_call_parameters Specs.get_summary callee_pname <> None in if should_check_parameters then (* left to right to avoid guessing the different lengths *) - check (list_rev sig_params) (list_rev call_params) + check (IList.rev sig_params) (IList.rev call_params) (** Checks if the annotations are consistent with the inherited class or with the implemented interfaces *) @@ -532,8 +532,8 @@ let check_overridden_annotations let current_params = annotated_signature.Annotations.params and overridden_params = overriden_signature.Annotations.params in let initial_pos = if is_virtual current_params then 0 else 1 in - if (list_length current_params) = (list_length overridden_params) then - ignore (list_fold_left2 compare initial_pos current_params overridden_params) in + if (IList.length current_params) = (IList.length overridden_params) then + ignore (IList.fold_left2 compare initial_pos current_params overridden_params) in let check overriden_proc_name = match Specs.proc_resolve_attributes overriden_proc_name with diff --git a/infer/src/checkers/immutableChecker.ml b/infer/src/checkers/immutableChecker.ml index eeb5c9b30..53dfb74c4 100644 --- a/infer/src/checkers/immutableChecker.ml +++ b/infer/src/checkers/immutableChecker.ml @@ -23,7 +23,7 @@ let check_immutable_cast curr_pname curr_pdesc typ_expected typ_found_opt loc : "java.util.Set", "com.google.common.collect.ImmutableSet" ] in let in_casts expected given = - list_exists (fun (x, y) -> Mangled.from_string x = expected && Mangled.from_string y = given) casts in + IList.exists (fun (x, y) -> Mangled.from_string x = expected && Mangled.from_string y = given) casts in match PatternMatch.type_get_class_name typ_expected, PatternMatch.type_get_class_name typ_found with | Some name_expected, Some name_given -> diff --git a/infer/src/checkers/modelTables.ml b/infer/src/checkers/modelTables.ml index 112f851ce..5aef9a0a7 100644 --- a/infer/src/checkers/modelTables.ml +++ b/infer/src/checkers/modelTables.ml @@ -50,7 +50,7 @@ let check_not_null_parameter_list, check_not_null_list = 1, (o, [n]), "com.facebook.infer.annotation.Assertions.assumeNotNull(java.lang.Object):java.lang.Object"; 1, (o, [n; o]), "com.facebook.infer.annotation.Assertions.assumeNotNull(java.lang.Object,java.lang.String):java.lang.Object"; ] in - list_map (fun (x, y, z) -> (x, z)) list, list_map (fun (x, y, z) -> (y, z)) list + IList.map (fun (x, y, z) -> (x, z)) list, IList.map (fun (x, y, z) -> (y, z)) list let check_state_list = [ @@ -223,7 +223,7 @@ type model_table_t = (string, bool * bool list) Hashtbl.t let mk_table list = let map = Hashtbl.create 1 in - list_iter (function (v, pn_id) -> Hashtbl.replace map pn_id v) list; + IList.iter (function (v, pn_id) -> Hashtbl.replace map pn_id v) list; map let annotated_table_nullable = mk_table annotated_list_nullable diff --git a/infer/src/checkers/models.ml b/infer/src/checkers/models.ml index 0ff24e89b..366bb5126 100644 --- a/infer/src/checkers/models.ml +++ b/infer/src/checkers/models.ml @@ -89,7 +89,7 @@ module Inference = struct | Some buf -> let boolvec = ref [] in String.iter (fun c -> boolvec := (c = '1') :: !boolvec) buf; - Some (list_rev !boolvec) + Some (IList.rev !boolvec) end (* Inference *) diff --git a/infer/src/checkers/patternMatch.ml b/infer/src/checkers/patternMatch.ml index fb6c81941..53e9cf289 100644 --- a/infer/src/checkers/patternMatch.ml +++ b/infer/src/checkers/patternMatch.ml @@ -28,7 +28,7 @@ let java_proc_name_with_class_method pn class_with_path method_name = let is_direct_subtype_of this_type super_type_name = match this_type with | Sil.Tptr (Sil.Tstruct (_, _, _, _, supertypes, _, _), _) -> - list_exists (fun (x, y) -> super_type_name = Mangled.to_string y) supertypes + IList.exists (fun (x, y) -> super_type_name = Mangled.to_string y) supertypes | _ -> false (** The type the method is invoked on *) @@ -39,7 +39,7 @@ let get_this_type proc_attributes = match proc_attributes.ProcAttributes.formals let type_get_direct_supertypes = function | Sil.Tptr (Sil.Tstruct (_, _, _, _, supertypes, _, _), _) | Sil.Tstruct (_, _, _, _, supertypes, _, _) -> - list_map (fun (_, m) -> m) supertypes + IList.map (fun (_, m) -> m) supertypes | _ -> [] let type_get_class_name t = match t with @@ -60,7 +60,7 @@ let type_has_class_name t name = type_get_class_name t = Some name let type_has_direct_supertype (t : Sil.typ) (s : Mangled.t) = - list_exists (fun c -> c = s) (type_get_direct_supertypes t) + IList.exists (fun c -> c = s) (type_get_direct_supertypes t) let type_find_supertype (tenv: Sil.tenv) @@ -86,7 +86,7 @@ let type_find_supertype | None -> false in (match_csu () && match_name () (* only and always visit name with expected csu *)) || has_indirect_supertype () in - list_exists match_supertype supertypes + IList.exists match_supertype supertypes | _ -> false end in has_supertype typ Sil.TypSet.empty @@ -108,7 +108,7 @@ let type_get_supertypes res := m :: !res; false in let _ = type_find_supertype tenv typ csu_option filter in - list_rev !res + IList.rev !res let type_is_nested_in_type t n = match t with | Sil.Tptr (Sil.Tstruct (_, _, _, Some m, _, _, _), _) -> @@ -117,11 +117,11 @@ let type_is_nested_in_type t n = match t with let type_is_nested_in_direct_supertype t n = let is_nested_in m2 m1 = string_is_prefix (Mangled.to_string m2 ^ "$") (Mangled.to_string m1) in - list_exists (is_nested_in n) (type_get_direct_supertypes t) + IList.exists (is_nested_in n) (type_get_direct_supertypes t) let type_is_nested_in_supertype tenv t csu_option n = let is_nested_in m2 m1 = string_is_prefix (Mangled.to_string m2 ^ "$") (Mangled.to_string m1) in - list_exists (is_nested_in n) (type_get_supertypes tenv t csu_option) + IList.exists (is_nested_in n) (type_get_supertypes tenv t csu_option) let rec get_type_name = function | Sil.Tstruct (_, _, _, Some mangled, _, _, _) -> Mangled.to_string mangled @@ -136,7 +136,7 @@ let get_field_type_name | Sil.Tstruct (fields, _, _, _, _, _, _) | Sil.Tptr (Sil.Tstruct (fields, _, _, _, _, _, _), _) -> ( try - let _, ft, _ = list_find + let _, ft, _ = IList.find (function | (fn, _, _) -> Ident.fieldname_equal fn fieldname) fields in Some (get_type_name ft) @@ -204,7 +204,7 @@ let get_vararg_type_names | None -> type_names n) | _ -> raise Not_found in - list_rev (type_names call_node) + IList.rev (type_names call_node) let has_type_name typ type_name = get_type_name typ = type_name @@ -212,8 +212,8 @@ let has_type_name typ type_name = let has_formal_proc_argument_type_names proc_desc proc_name argument_type_names = let formals = Cfg.Procdesc.get_formals proc_desc in let equal_formal_arg (_, typ) arg_type_name = get_type_name typ = arg_type_name in - list_length formals = list_length argument_type_names - && list_for_all2 equal_formal_arg formals argument_type_names + IList.length formals = IList.length argument_type_names + && IList.for_all2 equal_formal_arg formals argument_type_names let has_formal_method_argument_type_names cfg proc_name argument_type_names = has_formal_proc_argument_type_names @@ -236,7 +236,7 @@ let get_java_field_access_signature = function let get_java_method_call_formal_signature = function | Sil.Call (ret_ids, Sil.Const (Sil.Cfun pn), (te, tt):: args, loc, cf) -> (try - let arg_names = list_map (function | e, t -> get_type_name t) args in + let arg_names = IList.map (function | e, t -> get_type_name t) args in let rt_name = Procname.java_get_return_type pn in let m_name = Procname.java_get_method pn in Some (get_type_name tt, m_name, arg_names, rt_name) @@ -251,7 +251,7 @@ let type_is_class = function | Sil.Tstruct _ -> true | _ -> false -let initializer_classes = list_map Mangled.from_string [ +let initializer_classes = IList.map Mangled.from_string [ "android.app.Activity"; "android.app.Application"; "android.app.Fragment"; @@ -270,7 +270,7 @@ let type_has_initializer (tenv: Sil.tenv) (t: Sil.typ): bool = let check_candidate cname = type_has_supertype tenv t (Some Sil.Class) cname in - list_exists check_candidate initializer_classes + IList.exists check_candidate initializer_classes (** Check if the method is one of the known initializer methods. *) let method_is_initializer @@ -280,7 +280,7 @@ let method_is_initializer | Some this_type -> if type_has_initializer tenv this_type then let mname = Procname.java_get_method (proc_attributes.ProcAttributes.proc_name) in - list_exists (string_equal mname) initializer_methods + IList.exists (string_equal mname) initializer_methods else false | None -> false @@ -295,7 +295,7 @@ let java_get_vararg_values node pvar idenv pdesc = values := content_exp :: !values | _ -> () in let do_node n = - list_iter do_instr (Cfg.Node.get_instrs n) in + IList.iter do_instr (Cfg.Node.get_instrs n) in let () = match Errdesc.find_program_variable_assignment node pvar with | Some (node', _) -> Cfg.Procdesc.iter_slope_range do_node pdesc node' node @@ -316,10 +316,10 @@ let proc_calls resolve_attributes pname pdesc filter : (Procname.t * ProcAttribu | _ -> () in let do_node node = let instrs = Cfg.Node.get_instrs node in - list_iter (do_instruction node) instrs in + IList.iter (do_instruction node) instrs in let nodes = Cfg.Procdesc.get_nodes pdesc in - list_iter do_node nodes; - list_rev !res + IList.iter do_node nodes; + IList.rev !res (** Iterate over all the methods overridden by the procedure. @@ -334,7 +334,7 @@ let proc_iter_overridden_methods f tenv proc_name = let is_override pname = Procname.equal pname super_proc_name && not (Procname.is_constructor pname) in - list_iter + IList.iter (fun pname -> if is_override pname then f pname) @@ -347,5 +347,5 @@ let proc_iter_overridden_methods f tenv proc_name = Sil.TN_csu (Sil.Class, Mangled.from_string class_name) in match Sil.tenv_lookup tenv type_name with | Some curr_type -> - list_iter (do_super_type tenv) (type_get_direct_supertypes curr_type) + IList.iter (do_super_type tenv) (type_get_direct_supertypes curr_type) | None -> () diff --git a/infer/src/checkers/printfArgs.ml b/infer/src/checkers/printfArgs.ml index d1d1c2825..9bff7c28f 100644 --- a/infer/src/checkers/printfArgs.ml +++ b/infer/src/checkers/printfArgs.ml @@ -24,7 +24,7 @@ let printf_signature_to_string "{%s; %d [%s] %s}" printf.unique_id printf.format_pos - (String.concat "," (list_map string_of_int printf.fixed_pos)) + (String.concat "," (IList.map string_of_int printf.fixed_pos)) (match printf.vararg_pos with | Some i -> string_of_int i | _ -> "-") let printf_like_functions = @@ -56,7 +56,7 @@ let printf_like_function (proc_name: Procname.t): printf_signature option = try Some ( - list_find + IList.find (fun printf -> string_equal printf.unique_id (Procname.to_unique_id proc_name)) !printf_like_functions) with Not_found -> None @@ -77,12 +77,12 @@ let format_type_matches_given_type (given_type: string): bool = match format_type with | "d" | "i" | "u" | "x" | "X" | "o" -> - list_mem + IList.mem string_equal given_type ["java.lang.Integer"; "java.lang.Long"; "java.lang.Short"; "java.lang.Byte"] | "a" | "A" | "f" | "F" | "g" | "G" | "e" | "E" -> - list_mem + IList.mem string_equal given_type ["java.lang.Double"; "java.lang.Float"] @@ -95,15 +95,15 @@ let format_arguments (printf: printf_signature) (args: (Sil.exp * Sil.typ) list): (string option * (Sil.exp list) * (Sil.exp option)) = - let format_string = match list_nth args printf.format_pos with + let format_string = match IList.nth args printf.format_pos with | Sil.Const (Sil.Cstr fmt), _ -> Some fmt | _ -> None in - let fixed_nvars = list_map - (fun i -> fst (list_nth args i)) + let fixed_nvars = IList.map + (fun i -> fst (IList.nth args i)) printf.fixed_pos in let varargs_nvar = match printf.vararg_pos with - | Some pos -> Some (fst (list_nth args pos)) + | Some pos -> Some (fst (IList.nth args pos)) | None -> None in format_string, fixed_nvars, varargs_nvar @@ -194,7 +194,7 @@ let callback_printf_args try let fmt, fixed_nvars, array_nvar = format_arguments printf args in let instrs = Cfg.Node.get_instrs node in - let fixed_nvar_type_names = list_map (fixed_nvar_type_name instrs) fixed_nvars in + let fixed_nvar_type_names = IList.map (fixed_nvar_type_name instrs) fixed_nvars in let vararg_ivar_type_names = match array_nvar with | Some nvar -> ( let ivar = array_ivar instrs nvar in diff --git a/infer/src/checkers/registerCheckers.ml b/infer/src/checkers/registerCheckers.ml index 1f1684466..226582360 100644 --- a/infer/src/checkers/registerCheckers.ml +++ b/infer/src/checkers/registerCheckers.ml @@ -36,14 +36,14 @@ let active_procedure_checkers () = RepeatedCallsChecker.callback_check_repeated_calls, checkers_enabled; PrintfArgs.callback_printf_args, checkers_enabled; ] in - list_map (fun (x, y) -> (x, y, Some Config.Java)) l in + IList.map (fun (x, y) -> (x, y, Some Config.Java)) l in let c_cpp_checkers = let l = [ Checkers.callback_print_c_method_calls, false; CheckDeadCode.callback_check_dead_code, checkers_enabled; ] in - list_map (fun (x, y) -> (x, y, Some Config.C_CPP)) l in + IList.map (fun (x, y) -> (x, y, Some Config.C_CPP)) l in java_checkers @ c_cpp_checkers @@ -53,5 +53,5 @@ let active_cluster_checkers () = let register () = let register registry (callback, active, language_opt) = if active then registry language_opt callback in - list_iter (register Callbacks.register_procedure_callback) (active_procedure_checkers ()); - list_iter (register Callbacks.register_cluster_callback) (active_cluster_checkers ()) + IList.iter (register Callbacks.register_procedure_callback) (active_procedure_checkers ()); + IList.iter (register Callbacks.register_cluster_callback) (active_cluster_checkers ()) diff --git a/infer/src/checkers/repeatedCallsChecker.ml b/infer/src/checkers/repeatedCallsChecker.ml index e2c27f088..c3356d75f 100644 --- a/infer/src/checkers/repeatedCallsChecker.ml +++ b/infer/src/checkers/repeatedCallsChecker.ml @@ -27,7 +27,7 @@ struct | Sil.Call (ret1, e1, etl1, loc1, cf1), Sil.Call (ret2, e2, etl2, loc2, cf2) -> (* ignore return ids and call flags *) let n = Sil.exp_compare e1 e2 in - if n <> 0 then n else let n = list_compare Sil.exp_typ_compare etl1 etl2 in + if n <> 0 then n else let n = IList.compare Sil.exp_typ_compare etl1 etl2 in if n <> 0 then n else Sil.call_flags_compare cf1 cf2 | _ -> Sil.instr_compare i1 i2 end) @@ -75,7 +75,7 @@ struct | Sil.Call (_, Sil.Const (Sil.Cfun pn), _, loc, _) when proc_is_new pn -> found := Some loc | _ -> () in - list_iter do_instr (Cfg.Node.get_instrs node); + IList.iter do_instr (Cfg.Node.get_instrs node); !found in let module DFAllocCheck = Dataflow.MakeDF(struct @@ -114,7 +114,7 @@ struct (* same temporary variable does not imply same value *) not (Errdesc.pvar_is_frontend_tmp pvar) | _ -> true in - list_for_all filter_arg args in + IList.for_all filter_arg args in match instr with | Sil.Call (ret_ids, Sil.Const (Sil.Cfun callee_pname), _, loc, call_flags) diff --git a/infer/src/checkers/sqlChecker.ml b/infer/src/checkers/sqlChecker.ml index 9c72eee4f..7e4be739f 100644 --- a/infer/src/checkers/sqlChecker.ml +++ b/infer/src/checkers/sqlChecker.ml @@ -24,7 +24,7 @@ let callback_sql all_procs get_proc_desc idenv tenv proc_name proc_desc = "update .* set.*"; "delete .* from.*"; ] in - list_map Str.regexp_case_fold _sql_start in + IList.map Str.regexp_case_fold _sql_start in (* Check for SQL string concatenations *) let do_instr const_map node = function @@ -37,7 +37,7 @@ let callback_sql all_procs get_proc_desc idenv tenv proc_name proc_desc = let matches s r = Str.string_match r s 0 in match const_map node rvar1, const_map node rvar2 with | Some (Sil.Cstr ""), Some (Sil.Cstr s2) -> - if list_exists (matches s2) sql_start then + if IList.exists (matches s2) sql_start then begin L.stdout "%s%s@." diff --git a/infer/src/checkers/typeCheck.ml b/infer/src/checkers/typeCheck.ml index 0171ad944..2930db493 100644 --- a/infer/src/checkers/typeCheck.ml +++ b/infer/src/checkers/typeCheck.ml @@ -347,7 +347,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc let is_parameter_field pvar = (* parameter.field *) let name = Sil.pvar_to_string pvar in let filter (s, ia, typ) = string_equal s name in - list_exists filter annotated_signature.Annotations.params in + IList.exists filter annotated_signature.Annotations.params in let is_static_field pvar = (* static field *) Sil.pvar_is_global pvar in @@ -405,11 +405,11 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc | fp:: tail when is_hidden_parameter fp -> 1 + drop_n_args tail | _ -> 0 in let n = drop_n_args proc_attributes.ProcAttributes.formals in - let visible_params = list_drop_first n params in + let visible_params = IList.drop_first n params in (* Drop the trailing hidden parameter if the constructor is synthetic. *) if proc_attributes.ProcAttributes.is_synthetic_method then - list_drop_last 1 visible_params + IList.drop_last 1 visible_params else visible_params end @@ -421,7 +421,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc let drop_unchecked_signature_params proc_attributes annotated_signature = if Procname.is_constructor (proc_attributes.ProcAttributes.proc_name) && proc_attributes.ProcAttributes.is_synthetic_method then - list_drop_last 1 annotated_signature.Annotations.params + IList.drop_last 1 annotated_signature.Annotations.params else annotated_signature.Annotations.params in @@ -465,7 +465,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc match instr with | Sil.Remove_temps (idl, loc) -> - if remove_temps then list_fold_right TypeState.remove_id idl typestate + if remove_temps then IList.fold_right TypeState.remove_id idl typestate else typestate | Sil.Declare_locals _ | Sil.Abstract _ @@ -571,7 +571,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc typecheck_expr_for_errors typestate e1 loc; let e2, typestate2 = convert_complex_exp_to_pvar node false e1 typestate1 loc in (((e1, e2), t1) :: etl1), typestate2 in - list_fold_right handle_et etl ([], typestate) in + IList.fold_right handle_et etl ([], typestate) in let annotated_signature = Models.get_modelled_annotated_signature callee_attributes in @@ -640,7 +640,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc pvar_apply loc clear_nullable_flag ts pvar1 | _ -> ts in let vararg_values = PatternMatch.java_get_vararg_values node pvar idenv curr_pdesc in - Utils.list_fold_right do_vararg_value vararg_values typestate' + IList.fold_right do_vararg_value vararg_values typestate' else pvar_apply loc clear_nullable_flag typestate' pvar | None -> typestate' in @@ -676,7 +676,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc | _ -> () end | _ -> () in - list_iter do_instr (Cfg.Node.get_instrs cond_node) in + IList.iter do_instr (Cfg.Node.get_instrs cond_node) in let handle_optional_isPresent node' e = match convert_complex_exp_to_pvar node' false e typestate' loc with | Sil.Lvar pvar', _ -> @@ -692,7 +692,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc (* In foo(cond1 && cond2), the node that sets the result to false has all the negated conditions as parents. *) | Some boolean_assignment_node -> - list_iter handle_negated_condition (Cfg.Node.get_preds boolean_assignment_node); + IList.iter handle_negated_condition (Cfg.Node.get_preds boolean_assignment_node); !res_typestate | None -> begin @@ -751,7 +751,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc print_current_state; let typestate2 = if checks.check_extension then - let etl' = list_map (fun ((_, e), t) -> (e, t)) call_params in + let etl' = IList.map (fun ((_, e), t) -> (e, t)) call_params in let extension = TypeState.get_extension typestate1 in let extension' = ext.TypeState.check_instr @@ -768,7 +768,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc if Procname.java_get_method callee_pname = "checkNotNull" && Procname.java_is_vararg callee_pname then - let last_parameter = list_length call_params in + let last_parameter = IList.length call_params in do_preconditions_check_not_null last_parameter true (* is_vararg *) @@ -956,7 +956,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc when Sil.exp_equal (Sil.Lvar pvar) (Idenv.expand_expr idenv e') -> found := Some e | _ -> () in - list_iter do_instr (Cfg.Node.get_instrs prev_node); + IList.iter do_instr (Cfg.Node.get_instrs prev_node); !found | _ -> None in @@ -1031,7 +1031,7 @@ let typecheck_node (* This is used to track if it is set to true for all visit to the node. *) TypeErr.node_reset_forall canonical_node; - let typestate_succ = list_fold_left (do_instruction ext) typestate instrs in + let typestate_succ = IList.fold_left (do_instruction ext) typestate instrs in if Cfg.Node.get_kind node = Cfg.Node.exn_sink_kind then [], [] (* don't propagate exceptions to exit node *) else [typestate_succ], !typestates_exn diff --git a/infer/src/checkers/typeState.ml b/infer/src/checkers/typeState.ml index f50f15c64..61988e526 100644 --- a/infer/src/checkers/typeState.ml +++ b/infer/src/checkers/typeState.ml @@ -49,7 +49,7 @@ let empty ext = extension = ext.empty; } -let locs_compare = list_compare Location.compare +let locs_compare = IList.compare Location.compare let locs_equal locs1 locs2 = locs_compare locs1 locs2 = 0 let range_equal (typ1, ta1, locs1) (typ2, ta2, locs2) = @@ -78,7 +78,7 @@ exception JoinFail let type_join typ1 typ2 = if PatternMatch.type_is_object typ1 then typ2 else typ1 let locs_join locs1 locs2 = - list_merge_sorted_nodup Location.compare [] locs1 locs2 + IList.merge_sorted_nodup Location.compare [] locs1 locs2 (** Add a list of locations to a range. *) let range_add_locs (typ, ta, locs1) locs2 = diff --git a/infer/src/clang/ast_expressions.ml b/infer/src/clang/ast_expressions.ml index a3706194f..0bd480c9c 100644 --- a/infer/src/clang/ast_expressions.ml +++ b/infer/src/clang/ast_expressions.ml @@ -372,7 +372,7 @@ let make_next_object_exp stmt_info item items = (* void (^block_var)()=block_def; block_var() *) let translate_dispatch_function block_name stmt_info stmt_list ei n = let block_expr = - try Utils.list_nth stmt_list (n + 1) + try IList.nth stmt_list (n + 1) with Not_found -> assert false in let block_name_info = { Clang_ast_t.ni_name = block_name; diff --git a/infer/src/clang/cAstProcessor.ml b/infer/src/clang/cAstProcessor.ml index e6bf1e11d..f30fd8e8f 100644 --- a/infer/src/clang/cAstProcessor.ml +++ b/infer/src/clang/cAstProcessor.ml @@ -98,8 +98,8 @@ let pp_ast_decl fmt ast_decl = prefix stmt_str pp_source_range stmt_info.Clang_ast_t.si_source_range; - list_iter (dump_stmt prefix1) stmt_list; - list_iter (dump_decl prefix1) decl_list + IList.iter (dump_stmt prefix1) stmt_list; + IList.iter (dump_decl prefix1) decl_list and dump_decl prefix decl = let prefix1 = prefix ^ " " in let open Clang_ast_t in @@ -109,8 +109,8 @@ let pp_ast_decl fmt ast_decl = prefix name.Clang_ast_t.ni_name pp_source_range decl_info.di_source_range; - list_iter (dump_decl prefix1) fdecl_info.fdi_decls_in_prototype_scope; - list_iter (dump_decl prefix1) fdecl_info.fdi_parameters; + IList.iter (dump_decl prefix1) fdecl_info.fdi_decls_in_prototype_scope; + IList.iter (dump_decl prefix1) fdecl_info.fdi_parameters; Option.may (dump_stmt prefix1) fdecl_info.fdi_body | ObjCMethodDecl (decl_info, name, obj_c_method_decl_info) -> F.fprintf fmt "%sObjCMethodDecl %s %a@\n" @@ -131,13 +131,13 @@ let pp_ast_decl fmt ast_decl = prefix decl_kind_str pp_source_range decl_info.di_source_range; - list_iter (dump_decl prefix1) decl_list in + IList.iter (dump_decl prefix1) decl_list in let decl_str = Clang_ast_proj.get_decl_kind_string ast_decl in match ast_decl with | Clang_ast_t.TranslationUnitDecl (_, decl_list, _, _) -> - F.fprintf fmt "%s (%d declarations)@\n" decl_str (list_length decl_list); - list_iter (dump_decl "") decl_list + F.fprintf fmt "%s (%d declarations)@\n" decl_str (IList.length decl_list); + IList.iter (dump_decl "") decl_list | _ -> assert false @@ -229,12 +229,12 @@ let rec stmt_process_locs loc_composer stmt = let stmt_info' = { stmt_info with Clang_ast_t.si_source_range = range' } in - let stmt_list' = list_map (stmt_process_locs loc_composer) stmt_list in + let stmt_list' = IList.map (stmt_process_locs loc_composer) stmt_list in (stmt_info', stmt_list') in let open Clang_ast_t in match Clang_ast_proj.update_stmt_tuple update stmt with | DeclStmt (stmt_info, stmt_list, decl_list) -> - let decl_list' = list_map (decl_process_locs loc_composer) decl_list in + let decl_list' = IList.map (decl_process_locs loc_composer) decl_list in DeclStmt (stmt_info, stmt_list, decl_list') | stmt' -> stmt' @@ -248,14 +248,14 @@ and decl_process_locs loc_composer decl = Clang_ast_t.di_source_range = range' } in let decl_list = decl_get_sub_decls decl in let decl1 = Clang_ast_proj.update_decl_tuple update decl in - let decl_list' = list_map (decl_process_locs loc_composer) decl_list in + let decl_list' = IList.map (decl_process_locs loc_composer) decl_list in decl_set_sub_decls decl1 decl_list' in let open Clang_ast_t in let get_updated_fun_decl (decl_info', name, tp, fdecl_info) = let fdi_decls_in_prototype_scope' = - list_map (decl_process_locs loc_composer) fdecl_info.fdi_decls_in_prototype_scope in + IList.map (decl_process_locs loc_composer) fdecl_info.fdi_decls_in_prototype_scope in let fdi_parameters' = - list_map (decl_process_locs loc_composer) fdecl_info.fdi_parameters in + IList.map (decl_process_locs loc_composer) fdecl_info.fdi_parameters in let body' = Option.map (stmt_process_locs loc_composer) fdecl_info.fdi_body in let fdecl_info' = { fdecl_info with @@ -297,7 +297,7 @@ let ast_decl_process_locs loc_composer ast_decl = match ast_decl with | Clang_ast_t.TranslationUnitDecl (decl_info, decl_list, decl_context_info, type_list) -> - let decl_list' = list_map toplevel_decl_process_locs decl_list in + let decl_list' = IList.map toplevel_decl_process_locs decl_list in Clang_ast_t.TranslationUnitDecl (decl_info, decl_list', decl_context_info, type_list) | _ -> assert false diff --git a/infer/src/clang/cContext.ml b/infer/src/clang/cContext.ml index bc97eca9e..0bc5801fd 100644 --- a/infer/src/clang/cContext.ml +++ b/infer/src/clang/cContext.ml @@ -86,7 +86,7 @@ let curr_class_to_string curr_class = match curr_class with | ContextCls (name, superclass, protocols) -> ("class " ^ name ^ ", superclass: " ^ (Option.default "" superclass) ^ - ", protocols: " ^ (Utils.list_to_string (fun x -> x) protocols)) + ", protocols: " ^ (IList.to_string (fun x -> x) protocols)) | ContextCategory (name, cls) -> ("category " ^ name ^ " of class " ^ cls) | ContextProtocol name -> ("protocol " ^ name) | ContextNoCls -> "no class" @@ -121,7 +121,7 @@ let create_curr_class tenv class_name = let class_tn_name = Sil.TN_csu (Sil.Class, (Mangled.from_string class_name)) in match Sil.tenv_lookup tenv class_tn_name with | Some Sil.Tstruct(intf_fields, _, _, _, superclasses, methods, annotation) -> - (let superclasses_names = list_map (fun (_, name) -> Mangled.to_string name) superclasses in + (let superclasses_names = IList.map (fun (_, name) -> Mangled.to_string name) superclasses in match superclasses_names with | superclass:: protocols -> ContextCls (class_name, Some superclass, protocols) diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index 1ff672917..2f6795d30 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -83,7 +83,7 @@ let build_sil_field_property curr_class tenv field_name type_ptr prop_attributes match prop_attributes_opt with | Some prop_attributes -> prop_attributes | None -> ivar_property curr_class field_name in - let atts_str = list_map Clang_ast_j.string_of_property_attribute prop_attributes in + let atts_str = IList.map Clang_ast_j.string_of_property_attribute prop_attributes in build_sil_field tenv field_name type_ptr atts_str (* Given a list of declarations in an interface returns a list of fields *) @@ -98,8 +98,8 @@ let rec get_fields tenv curr_class decl_list = Printing.log_out " ...Adding Instance Variable '%s' @." name_info.Clang_ast_t.ni_name; let (fname, typ, ia) = build_sil_field_property curr_class tenv name_info type_ptr None in Printing.log_out " ...Resulting sil field: (%s) with attributes:@." ((Ident.fieldname_to_string fname) ^":"^(Sil.typ_to_string typ)); - list_iter (fun (ia', _) -> - list_iter (fun a -> Printing.log_out " '%s'@." a) ia'.Sil.parameters) ia; + IList.iter (fun (ia', _) -> + IList.iter (fun a -> Printing.log_out " '%s'@." a) ia'.Sil.parameters) ia; (fname, typ, ia):: fields | ObjCPropertyImplDecl (decl_info, property_impl_decl_info):: decl_list' -> let property_fields_decl = diff --git a/infer/src/clang/cFrontend.ml b/infer/src/clang/cFrontend.ml index b61a30bf3..a240f2c51 100644 --- a/infer/src/clang/cFrontend.ml +++ b/infer/src/clang/cFrontend.ml @@ -42,7 +42,7 @@ let rec translate_one_declaration tenv cg cfg namespace parent_dec dec = let method_decls = CTypes_decl.get_method_decls dec decl_list in let tranlate_method (parent, decl) = translate_one_declaration tenv cg cfg namespace parent decl in - list_iter tranlate_method method_decls + IList.iter tranlate_method method_decls | VarDecl(decl_info, name_info, t, _) -> Printing.log_out "Nothing to do for global variable %s " name_info.Clang_ast_t.ni_name @@ -97,10 +97,10 @@ let rec translate_one_declaration tenv cg cfg namespace parent_dec dec = | LinkageSpecDecl(decl_info, decl_list, decl_context_info) -> Printing.log_out "ADDING: LinkageSpecDecl decl list\n"; - list_iter (translate_one_declaration tenv cg cfg namespace dec) decl_list + IList.iter (translate_one_declaration tenv cg cfg namespace dec) decl_list | NamespaceDecl(decl_info, name_info, decl_list, decl_context_info, _) -> let name = ns_suffix^name_info.Clang_ast_t.ni_name in - list_iter (translate_one_declaration tenv cg cfg (Some name) dec) decl_list + IList.iter (translate_one_declaration tenv cg cfg (Some name) dec) decl_list | EmptyDecl _ -> Printing.log_out "Passing from EmptyDecl. Treated as skip\n"; | dec -> @@ -114,7 +114,7 @@ let compute_icfg tenv source_file ast = Printing.log_out "\n Start creating icfg\n"; let cg = Cg.create () in let cfg = Cfg.Node.create_cfg () in - list_iter (translate_one_declaration tenv cg cfg None ast) decl_list; + IList.iter (translate_one_declaration tenv cg cfg None ast) decl_list; Printing.log_out "\n Finished creating icfg\n"; (cg, cfg) | _ -> assert false (* NOTE: Assumes that an AST alsways starts with a TranslationUnitDecl *) diff --git a/infer/src/clang/cFrontend_utils.ml b/infer/src/clang/cFrontend_utils.ml index 7b4ba2390..1c16b8b1c 100644 --- a/infer/src/clang/cFrontend_utils.ml +++ b/infer/src/clang/cFrontend_utils.ml @@ -38,14 +38,14 @@ struct (match typ with (Sil.Tstruct (fields, static_fields, _, cls, super_classes, methods, iann)) -> (print_endline ( (Sil.typename_to_string typname)^"\n"^ - "---> superclass and protocols "^(list_to_string (fun (csu, x) -> + "---> superclass and protocols "^(IList.to_string (fun (csu, x) -> let nsu = Sil.TN_csu (csu, x) in "\t"^(Sil.typename_to_string nsu)^"\n") super_classes)^ - "---> methods "^(list_to_string (fun x ->"\t"^(Procname.to_string x)^"\n") methods)^" "^ - "\t---> static fields "^(list_to_string (fun (fieldname, typ, _) -> + "---> methods "^(IList.to_string (fun x ->"\t"^(Procname.to_string x)^"\n") methods)^" "^ + "\t---> static fields "^(IList.to_string (fun (fieldname, typ, _) -> "\t "^(Ident.fieldname_to_string fieldname)^" "^ (Sil.typ_to_string typ)^"\n") static_fields)^ - "\t---> fields "^(list_to_string (fun (fieldname, typ, _) -> + "\t---> fields "^(IList.to_string (fun (fieldname, typ, _) -> "\t "^(Ident.fieldname_to_string fieldname)^" "^ (Sil.typ_to_string typ)^"\n") fields ) @@ -63,7 +63,7 @@ struct | (Sil.Tstruct (fields, static_fields, _, cls, super_classes, methods, iann)) -> (print_endline ( (Sil.typename_to_string typname)^"\n"^ - "\t---> fields "^(list_to_string (fun (fieldname, typ, _) -> + "\t---> fields "^(IList.to_string (fun (fieldname, typ, _) -> match typ with | Sil.Tvar tname -> "tvar"^(Sil.typename_to_string tname) | Sil.Tstruct (_, _, _, _, _, _, _) | _ -> @@ -81,7 +81,7 @@ struct let print_procedures cfg = let procs = Cfg.get_all_procs cfg in print_endline - (list_to_string (fun pdesc -> + (IList.to_string (fun pdesc -> let pname = Cfg.Procdesc.get_proc_name pdesc in "name> "^ (Procname.to_string pname) ^ @@ -92,7 +92,7 @@ struct L.err "AST Element> %s IN FILE> %s @.@." pointer !CFrontend_config.json let print_nodes nodes = - list_iter (fun node -> print_endline (Cfg.Node.get_description Utils.pe_text node)) nodes + IList.iter (fun node -> print_endline (Cfg.Node.get_description Utils.pe_text node)) nodes let instrs_to_string instrs = let pp fmt () = Format.fprintf fmt "%a" (Sil.pp_instr_list Utils.pe_text) instrs in @@ -151,7 +151,7 @@ struct match name_info.Clang_ast_t.ni_qual_name with | [] -> "" | name :: qualifiers -> - list_fold_right (fun el res -> res ^ el ^ "::") qualifiers "" + IList.fold_right (fun el res -> res ^ el ^ "::") qualifiers "" let make_name_decl name = { Clang_ast_t.ni_name = name; @@ -364,7 +364,7 @@ struct let rec append_no_duplicates eq list1 list2 = match list2 with | el:: rest2 -> - if (list_mem eq el list1) then + if (IList.mem eq el list1) then (append_no_duplicates eq list1 rest2) else (append_no_duplicates eq list1 rest2)@[el] | [] -> list1 @@ -393,7 +393,7 @@ struct let sort_fields fields = let compare (name1, _, _) (name2, _, _) = Ident.fieldname_compare name1 name2 in - list_sort compare fields + IList.sort compare fields let rec collect_list_tuples l (a, a1, b, c, d) = match l with @@ -447,7 +447,7 @@ struct if n < i then acc else aux (n -1) (n :: acc) in aux j [] ;; - let replicate n el = list_map (fun i -> el) (list_range 0 (n -1)) + let replicate n el = IList.map (fun i -> el) (list_range 0 (n -1)) let mk_class_field_name field_qual_name = let field_name = field_qual_name.Clang_ast_t.ni_name in diff --git a/infer/src/clang/cLocation.ml b/infer/src/clang/cLocation.ml index ae8d13d8d..870970a72 100644 --- a/infer/src/clang/cLocation.ml +++ b/infer/src/clang/cLocation.ml @@ -125,9 +125,9 @@ let get_line stmt_info line_number = let check_source_file source_file = let extensions_allowed = [".m"; ".mm"; ".c"; ".cc"; ".cpp"; ".h"] in - let allowed = list_exists (fun ext -> Filename.check_suffix source_file ext) extensions_allowed in + let allowed = IList.exists (fun ext -> Filename.check_suffix source_file ext) extensions_allowed in if not allowed then (Printing.log_stats "%s" ("\nThe source file "^source_file^ - " should end with "^(Utils.list_to_string (fun x -> x) extensions_allowed)^"\n\n"); + " should end with "^(IList.to_string (fun x -> x) extensions_allowed)^"\n\n"); assert false) diff --git a/infer/src/clang/cMethod_decl.ml b/infer/src/clang/cMethod_decl.ml index 6c03be0df..1630cedad 100644 --- a/infer/src/clang/cMethod_decl.ml +++ b/infer/src/clang/cMethod_decl.ml @@ -112,7 +112,7 @@ struct Printing.log_out "ADDING: ObjCPropertyImplDecl for property '%s' " pname.Clang_ast_t.ni_name; let getter_setter = ObjcProperty_decl.make_getter_setter curr_class decl_info pname in - list_iter (process_one_method_decl tenv cg cfg curr_class namespace) getter_setter + IList.iter (process_one_method_decl tenv cg cfg curr_class namespace) getter_setter | EmptyDecl _ | ObjCIvarDecl _ | ObjCPropertyDecl _ -> () | _ -> Printing.log_stats @@ -120,7 +120,7 @@ struct () let process_methods tenv cg cfg curr_class namespace decl_list = - list_iter (process_one_method_decl tenv cg cfg curr_class namespace) decl_list + IList.iter (process_one_method_decl tenv cg cfg curr_class namespace) decl_list let process_getter_setter context procname = (*If there is already a spec for the method we want to generate (in incremental analysis) *) @@ -142,7 +142,7 @@ struct if is_getter then ObjcProperty_decl.make_getter cls property_name property_type else ObjcProperty_decl.make_setter cls property_name property_type in - list_iter (process_one_method_decl context.tenv context.cg context.cfg cls context.namespace) accessor; + IList.iter (process_one_method_decl context.tenv context.cg context.cfg cls context.namespace) accessor; true) | _ -> false diff --git a/infer/src/clang/cMethod_signature.ml b/infer/src/clang/cMethod_signature.ml index d0219cfd5..391dc0dcf 100644 --- a/infer/src/clang/cMethod_signature.ml +++ b/infer/src/clang/cMethod_signature.ml @@ -64,7 +64,7 @@ let replace_name_ms ms name = let ms_to_string ms = let gen = if ms._is_generated then " (generated)" else "" in "Method " ^ (Procname.to_string ms._name) ^ gen ^ " " ^ - Utils.list_to_string + IList.to_string (fun (s1, s2, _) -> s1 ^ ", " ^ (Clang_ast_j.string_of_type_ptr s2)) ms._args ^ "->" ^ (Clang_ast_j.string_of_type_ptr ms._ret_type) ^ " " ^ diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index dace4f18c..6ee176408 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -74,7 +74,7 @@ let get_parameters function_method_decl_info = (name, type_ptr, var_decl_info.Clang_ast_t.vdi_init_expr) | _ -> assert false in - let pars = list_map par_to_ms_par (get_param_decls function_method_decl_info) in + let pars = IList.map par_to_ms_par (get_param_decls function_method_decl_info) in get_class_param function_method_decl_info @ pars let get_return_type function_method_decl_info = @@ -102,7 +102,7 @@ let get_assume_not_null_calls ms param_decls = let assume_call = Ast_expressions.create_assume_not_null_call decl_info name tp in [(`ClangStmt assume_call)] | _ -> [] in - list_flatten (list_map do_one_param param_decls) + IList.flatten (IList.map do_one_param param_decls) let method_signature_of_decl class_name_opt meth_decl block_data_opt = let open Clang_ast_t in @@ -214,7 +214,7 @@ let get_return_type tenv ms = let sil_func_attributes_of_attributes attrs = let rec do_translation acc al = match al with - | [] -> list_rev acc + | [] -> IList.rev acc | Clang_ast_t.SentinelAttr attribute_info:: tl -> let (sentinel, null_pos) = match attribute_info.Clang_ast_t.ai_parameters with | a:: b::[] -> (int_of_string a, int_of_string b) @@ -239,14 +239,14 @@ let should_create_procdesc cfg procname defined generated = (** Creates a procedure description. *) let create_local_procdesc cfg tenv ms fbody captured is_objc_inst_method = - let defined = not ((list_length fbody) == 0) in + let defined = not ((IList.length fbody) == 0) in let proc_name = CMethod_signature.ms_get_name ms in let pname = Procname.to_string proc_name in let attributes = sil_func_attributes_of_attributes (CMethod_signature.ms_get_attributes ms) in let is_generated = CMethod_signature.ms_is_generated ms in let create_new_procdesc () = let formals = get_formal_parameters tenv ms in - let captured_str = list_map (fun (s, t, _) -> (Mangled.to_string s, t)) captured in + let captured_str = IList.map (fun (s, t, _) -> (Mangled.to_string s, t)) captured in (* Captured variables for blocks are treated as parameters *) let formals = captured_str @formals in let source_range = CMethod_signature.ms_get_loc ms in @@ -254,7 +254,7 @@ let create_local_procdesc cfg tenv ms fbody captured is_objc_inst_method = let loc_start = CLocation.get_sil_location_from_range source_range true in let loc_exit = CLocation.get_sil_location_from_range source_range false in let ret_type = get_return_type tenv ms in - let captured' = list_map (fun (s, t, _) -> (s, t)) captured in + let captured' = IList.map (fun (s, t, _) -> (s, t)) captured in let procdesc = let proc_attributes = { (ProcAttributes.default proc_name Config.C_CPP) with @@ -293,7 +293,7 @@ let create_external_procdesc cfg proc_name is_objc_inst_method type_opt = let ret_type, formals = (match type_opt with | Some (ret_type, arg_types) -> - ret_type, list_map (fun typ -> ("x", typ)) arg_types + ret_type, IList.map (fun typ -> ("x", typ)) arg_types | None -> Sil.Tvoid, []) in let loc = Location.dummy in let _ = diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index 252f33ba5..4dc6580ac 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -103,10 +103,10 @@ struct let fname = General_utils.mk_class_field_name qual_name in let item_annot = Sil.item_annotation_empty in fname, typ, item_annot in - let fields = list_map mk_field_from_captured_var captured_vars in + let fields = IList.map mk_field_from_captured_var captured_vars in let fields = CFrontend_utils.General_utils.sort_fields fields in Printing.log_out "Block %s field:\n" block_name; - list_iter (fun (fn, ft, _) -> + IList.iter (fun (fn, ft, _) -> Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; let mblock = Mangled.from_string block_name in let block_type = Sil.Tstruct(fields, [], Sil.Class, Some mblock, [], [], []) in @@ -124,16 +124,16 @@ struct let block_nullify_instr = if pred_exit = [] then [Sil.Nullify(block_var, loc, true)] - else (list_iter (fun n -> let loc = Cfg.Node.get_loc n in + else (IList.iter (fun n -> let loc = Cfg.Node.get_loc n in Cfg.Node.append_instrs_temps n [Sil.Nullify(block_var, loc, true)] []) pred_exit; []) in let set_instr = Sil.Set(Sil.Lvar block_var, block_type, Sil.Var id_block, loc) in - let ids, captured_instrs = list_split (list_map (fun (vname, typ, _) -> + let ids, captured_instrs = IList.split (IList.map (fun (vname, typ, _) -> let id = Ident.create_fresh Ident.knormal in id, Sil.Letderef(id, Sil.Lvar (Sil.mk_pvar vname procname), typ, loc) ) captured_vars) in - let fields_ids = list_combine fields ids in - let set_fields = list_map (fun ((f, t, _), id) -> + let fields_ids = IList.combine fields ids in + let set_fields = IList.map (fun ((f, t, _), id) -> Sil.Set(Sil.Lfield(Sil.Var id_block, f, block_type), t, Sil.Var id, loc)) fields_ids in (declare_block_local :: trans_res.instrs) @ [set_instr] @ captured_instrs @ set_fields @ block_nullify_instr, id_block :: ids @@ -154,7 +154,7 @@ struct insts := Sil.Letderef (id, block, t, loc) :: !insts; [(Sil.Var id, t)] | _ -> [(e, t)] in - let get_function_name t el = list_flatten(list_map (is_function_name t) el) in + let get_function_name t el = IList.flatten(IList.map (is_function_name t) el) in let rec f es = match es with | [] -> [] @@ -436,7 +436,7 @@ struct if res_trans_idx.root_nodes <> [] then - list_iter + IList.iter (fun n -> Cfg.Node.set_succs_exn n res_trans_idx.root_nodes []) res_trans_a.leaf_nodes; @@ -491,7 +491,7 @@ struct (* Create a node if the priority if free and there are instructions *) let creating_node = (PriorityNode.own_priority_node trans_state_pri.priority stmt_info) && - (list_length instrs >0) in + (IList.length instrs >0) in let instrs_after_assign, assign_ids, exp_to_parent = if (is_binary_assign_op binary_operator_info) @@ -524,7 +524,7 @@ struct (* if we are translating a condition or not *) let ids_parent = ids_to_parent trans_state.continuation assign_ids in let ids_node = ids_to_node trans_state.continuation assign_ids in - list_iter (fun n -> Cfg.Node.append_instrs_temps n instrs_after_assign ids_node) succ_nodes''; + IList.iter (fun n -> Cfg.Node.append_instrs_temps n instrs_after_assign ids_node) succ_nodes''; [], ids_parent, succ_nodes'' ) else ( instrs_after_assign, assign_ids, succ_nodes) in @@ -534,8 +534,8 @@ struct let e1_succ_nodes = if e2_has_nodes then res_trans_e2.root_nodes else succ_nodes' in - list_iter (fun n -> Cfg.Node.set_succs_exn n e1_succ_nodes []) res_trans_e1.leaf_nodes; - list_iter (fun n -> Cfg.Node.set_succs_exn n succ_nodes' []) res_trans_e2.leaf_nodes; + IList.iter (fun n -> Cfg.Node.set_succs_exn n e1_succ_nodes []) res_trans_e1.leaf_nodes; + IList.iter (fun n -> Cfg.Node.set_succs_exn n succ_nodes' []) res_trans_e2.leaf_nodes; let root_nodes_to_ancestor = match e1_has_nodes, e2_has_nodes with | false, false -> succ_nodes' @@ -549,12 +549,12 @@ struct Printing.log_out "....BinaryOperator '%s' " bok; Printing.log_out "has ids_to_ancestor |ids_to_ancestor|=%s " - (string_of_int (list_length ids_to_ancestor)); + (string_of_int (IList.length ids_to_ancestor)); Printing.log_out " |nodes_e1|=%s .\n" - (string_of_int (list_length res_trans_e1.root_nodes)); + (string_of_int (IList.length res_trans_e1.root_nodes)); Printing.log_out " |nodes_e2|=%s .\n" - (string_of_int (list_length res_trans_e2.root_nodes)); - list_iter (fun id -> Printing.log_out " ... '%s'\n" + (string_of_int (IList.length res_trans_e2.root_nodes)); + IList.iter (fun id -> Printing.log_out " ... '%s'\n" (Ident.to_string id)) ids_to_ancestor; { root_nodes = root_nodes_to_ancestor; leaf_nodes = leaf_nodes_to_ancestor; @@ -604,9 +604,9 @@ struct else [] in let res_trans_par = let instruction' = exec_with_self_exception (exec_with_lvalue_as_reference instruction) in - let l = list_map (instruction' trans_state_param) params_stmt in + let l = IList.map (instruction' trans_state_param) params_stmt in let rt = collect_res_trans (res_trans_callee :: l) in - { rt with exps = list_tl rt.exps } in + { rt with exps = IList.tl rt.exps } in let sil_fe, is_cf_retain_release = CTrans_models.builtin_predefined_model fun_exp_stmt sil_fe in if CTrans_models.is_assert_log sil_fe then if Config.report_assertion_failure then @@ -614,7 +614,7 @@ struct else CTrans_utils.trans_assume_false sil_loc context trans_state.succ_nodes else - let act_params = if list_length res_trans_par.exps = list_length params_stmt then + let act_params = if IList.length res_trans_par.exps = IList.length params_stmt then res_trans_par.exps else (Printing.log_err "WARNING: stmt_list and res_trans_par.exps must have same size. NEED TO BE FIXED\n\n"; @@ -673,8 +673,8 @@ struct let result_trans_callee = instruction trans_state_callee fun_exp_stmt in (* first for method address, second for 'this' expression *) - assert ((list_length result_trans_callee.exps) = 2); - let (sil_method, typ_method) = list_hd result_trans_callee.exps in + assert ((IList.length result_trans_callee.exps) = 2); + let (sil_method, typ_method) = IList.hd result_trans_callee.exps in let callee_pname = match sil_method with | Sil.Const (Sil.Cfun pn) -> pn | _ -> assert false (* method pointer not implemented, this shouldn't happen *) in @@ -687,10 +687,10 @@ struct { trans_state_pri with parent_line_number = line_number; succ_nodes = [] } in let result_trans_params = let instruction' = exec_with_lvalue_as_reference instruction in - let l = list_map (exec_with_self_exception instruction' trans_state_param) params_stmt in + let l = IList.map (exec_with_self_exception instruction' trans_state_param) params_stmt in (* this function will automatically merge 'this' argument with rest of arguments in 'l'*) let rt = collect_res_trans (result_trans_callee :: l) in - { rt with exps = list_tl rt.exps } in + { rt with exps = IList.tl rt.exps } in let actual_params = result_trans_params.exps in let ret_id = if (Sil.typ_equal function_type Sil.Tvoid) then [] @@ -743,7 +743,7 @@ struct obj_c_message_expr_info, empty_res_trans) in let instruction' = exec_with_self_exception (exec_with_lvalue_as_reference instruction) in - let l = list_map (instruction' trans_state_param) rest in + let l = IList.map (instruction' trans_state_param) rest in obj_c_message_expr_info, collect_res_trans (fst_res_trans :: l) | [] -> obj_c_message_expr_info, empty_res_trans) in let (class_type, _, _, _) = CMethod_trans.get_class_selector_instance context obj_c_message_expr_info res_trans_par.exps in @@ -790,36 +790,36 @@ struct let loc = CLocation.get_sil_location stmt_info trans_state.parent_line_number trans_state.context in let res_state = instruction trans_state transformed_stmt in (* Add declare locals to the first node *) - list_iter (fun n -> Cfg.Node.prepend_instrs_temps n [Sil.Declare_locals([(pvar, typ)], loc)] []) res_state.root_nodes; - let preds = list_flatten (list_map (fun n -> Cfg.Node.get_preds n) trans_state.succ_nodes) in + IList.iter (fun n -> Cfg.Node.prepend_instrs_temps n [Sil.Declare_locals([(pvar, typ)], loc)] []) res_state.root_nodes; + let preds = IList.flatten (IList.map (fun n -> Cfg.Node.get_preds n) trans_state.succ_nodes) in (* Add nullify of the temp block var to the last node (predecessor or the successor nodes)*) - list_iter (fun n -> Cfg.Node.append_instrs_temps n [Sil.Nullify(pvar, loc, true)] []) preds; + IList.iter (fun n -> Cfg.Node.append_instrs_temps n [Sil.Nullify(pvar, loc, true)] []) preds; res_state and block_enumeration_trans trans_state stmt_info stmt_list ei = let declare_nullify_vars loc res_state roots preds (pvar, typ) = (* Add nullify of the temp block var to the last node (predecessor or the successor nodes)*) - list_iter (fun n -> Cfg.Node.append_instrs_temps n [Sil.Nullify(pvar, loc, true)] []) preds in + IList.iter (fun n -> Cfg.Node.append_instrs_temps n [Sil.Nullify(pvar, loc, true)] []) preds in Printing.log_out "\n Call to a block enumeration function treated as special case...\n@."; let procname = Cfg.Procdesc.get_proc_name trans_state.context.CContext.procdesc in let pvar = CFrontend_utils.General_utils.get_next_block_pvar procname in let transformed_stmt, vars_to_register = Ast_expressions.translate_block_enumerate (Sil.pvar_to_string pvar) stmt_info stmt_list ei in - let pvars_types = list_map (fun (v, pointer, tp) -> + let pvars_types = IList.map (fun (v, pointer, tp) -> let pvar = Sil.mk_pvar (Mangled.from_string v) procname in let typ = CTypes_decl.type_ptr_to_sil_type trans_state.context.CContext.tenv tp in (pvar, typ)) vars_to_register in let loc = CLocation.get_sil_location stmt_info trans_state.parent_line_number trans_state.context in let res_state = instruction trans_state transformed_stmt in - let preds = list_flatten (list_map (fun n -> Cfg.Node.get_preds n) trans_state.succ_nodes) in - list_iter (declare_nullify_vars loc res_state res_state.root_nodes preds) pvars_types; + let preds = IList.flatten (IList.map (fun n -> Cfg.Node.get_preds n) trans_state.succ_nodes) in + IList.iter (declare_nullify_vars loc res_state res_state.root_nodes preds) pvars_types; res_state and compoundStmt_trans trans_state stmt_info stmt_list = let line_number = CLocation.get_line stmt_info trans_state.parent_line_number in let trans_state' = { trans_state with parent_line_number = line_number } in - instructions trans_state' (list_rev stmt_list) + instructions trans_state' (IList.rev stmt_list) and conditionalOperator_trans trans_state stmt_info stmt_list expr_info = let context = trans_state.context in @@ -870,7 +870,7 @@ struct Cfg.Node.set_succs_exn n [join_node] []; [n] | _, true -> - list_iter + IList.iter (fun n' -> (* If there is a node with instructions we need to only *) (* add the set of the temp variable *) @@ -881,9 +881,9 @@ struct ) node_b; node_b | _, false -> node_b) in - let prune_nodes_t, prune_nodes_f = list_partition is_true_prune_node prune_nodes in + let prune_nodes_t, prune_nodes_f = IList.partition is_true_prune_node prune_nodes in let prune_nodes' = if branch then prune_nodes_t else prune_nodes_f in - list_iter (fun n -> Cfg.Node.set_succs_exn n nodes_branch []) prune_nodes' in + IList.iter (fun n -> Cfg.Node.set_succs_exn n nodes_branch []) prune_nodes' in (match stmt_list with | [cond; exp1; exp2] -> let typ = @@ -932,8 +932,8 @@ struct let e', instrs' = define_condition_side_effects context res_trans_cond.exps res_trans_cond.instrs sil_loc in let prune_t = mk_prune_node true e' res_trans_cond.ids instrs' in let prune_f = mk_prune_node false e' res_trans_cond.ids instrs' in - list_iter (fun n' -> Cfg.Node.set_succs_exn n' [prune_t; prune_f] []) res_trans_cond.leaf_nodes; - let rnodes = if (list_length res_trans_cond.root_nodes) = 0 then + IList.iter (fun n' -> Cfg.Node.set_succs_exn n' [prune_t; prune_f] []) res_trans_cond.leaf_nodes; + let rnodes = if (IList.length res_trans_cond.root_nodes) = 0 then [prune_t; prune_f] else res_trans_cond.root_nodes in { root_nodes = rnodes; leaf_nodes =[prune_t; prune_f]; ids = res_trans_cond.ids; instrs = instrs'; exps = e' } in @@ -947,7 +947,7 @@ struct (* the condition to decide its truth value). *) let short_circuit binop s1 s2 = let res_trans_s1 = cond_trans trans_state s1 in - let prune_nodes_t, prune_nodes_f = list_partition is_true_prune_node res_trans_s1.leaf_nodes in + let prune_nodes_t, prune_nodes_f = IList.partition is_true_prune_node res_trans_s1.leaf_nodes in let res_trans_s2 = cond_trans trans_state s2 in (* prune_to_s2 is the prune node that is connected with the root node of the *) (* translation of s2.*) @@ -957,9 +957,9 @@ struct | Sil.LAnd -> prune_nodes_t, prune_nodes_f | Sil.LOr -> prune_nodes_f, prune_nodes_t | _ -> assert false) in - list_iter (fun n -> Cfg.Node.set_succs_exn n res_trans_s2.root_nodes []) prune_to_s2; + IList.iter (fun n -> Cfg.Node.set_succs_exn n res_trans_s2.root_nodes []) prune_to_s2; let root_nodes_to_parent = - if (list_length res_trans_s1.root_nodes) = 0 then res_trans_s1.leaf_nodes else res_trans_s1.root_nodes in + if (IList.length res_trans_s1.root_nodes) = 0 then res_trans_s1.leaf_nodes else res_trans_s1.root_nodes in let (exp1, typ1) = extract_exp res_trans_s1.exps in let (exp2, typ2) = extract_exp res_trans_s2.exps in let e_cond = Sil.BinOp (binop, exp1, exp2) in @@ -995,9 +995,9 @@ struct let nodes_branch = (match res_trans_b.root_nodes with | [] -> [create_node (Cfg.Node.Stmt_node "IfStmt Branch" ) res_trans_b.ids res_trans_b.instrs sil_loc context] | _ -> res_trans_b.root_nodes) in - let prune_nodes_t, prune_nodes_f = list_partition is_true_prune_node prune_nodes in + let prune_nodes_t, prune_nodes_f = IList.partition is_true_prune_node prune_nodes in let prune_nodes' = if branch then prune_nodes_t else prune_nodes_f in - list_iter (fun n -> Cfg.Node.set_succs_exn n nodes_branch []) prune_nodes'; + IList.iter (fun n -> Cfg.Node.set_succs_exn n nodes_branch []) prune_nodes'; res_trans_b.ids in (match stmt_list with | [null_stmt; cond; stmt1; stmt2] -> (* Note: for the moment we don't do anything with the null_stmt/decl*) @@ -1065,7 +1065,7 @@ struct aux rest (x :: acc) cases | [] -> cases, acc) in - aux (list_rev stmt_list) [] [] in + aux (IList.rev stmt_list) [] [] in let list_of_cases, pre_case_stmts = merge_into_cases stmt_list in let rec connected_instruction rev_instr_list successor_nodes = (* returns the entry point of the translated set of instr *) @@ -1104,7 +1104,7 @@ struct | [] -> next_nodes, next_prune_nodes | CaseStmt(stmt_info, _ :: _ :: case_content) as case :: rest -> let last_nodes, last_prune_nodes = translate_and_connect_cases rest next_nodes next_prune_nodes in - let case_entry_point = connected_instruction (list_rev case_content) last_nodes in + let case_entry_point = connected_instruction (IList.rev case_content) last_nodes in (* connects between cases, then continuation has priority about breaks *) let prune_node_t, prune_node_f = create_prune_nodes_for_case case in Cfg.Node.set_succs_exn prune_node_t case_entry_point []; @@ -1115,21 +1115,21 @@ struct let placeholder_entry_point = create_node (Cfg.Node.Stmt_node "DefaultStmt_placeholder") [] [] sil_loc context in let last_nodes, last_prune_nodes = translate_and_connect_cases rest next_nodes [placeholder_entry_point] in - let default_entry_point = connected_instruction (list_rev default_content) last_nodes in + let default_entry_point = connected_instruction (IList.rev default_content) last_nodes in Cfg.Node.set_succs_exn placeholder_entry_point default_entry_point []; default_entry_point, last_prune_nodes | _ -> assert false in let top_entry_point, top_prune_nodes = translate_and_connect_cases list_of_cases succ_nodes succ_nodes in - let _ = connected_instruction (list_rev pre_case_stmts) top_entry_point in + let _ = connected_instruction (IList.rev pre_case_stmts) top_entry_point in Cfg.Node.set_succs_exn switch_special_cond_node top_prune_nodes []; let top_nodes = match res_trans_cond.root_nodes with | [] -> (* here if no root or if the translation of cond needed priority *) [switch_special_cond_node] | _ -> - list_iter (fun n' -> Cfg.Node.set_succs_exn n' [switch_special_cond_node] []) res_trans_cond.leaf_nodes; + IList.iter (fun n' -> Cfg.Node.set_succs_exn n' [switch_special_cond_node] []) res_trans_cond.leaf_nodes; res_trans_cond.root_nodes in - list_iter (fun n' -> Cfg.Node.append_instrs_temps n' [] res_trans_cond.ids) succ_nodes; (* succ_nodes will remove the temps *) + IList.iter (fun n' -> Cfg.Node.append_instrs_temps n' [] res_trans_cond.ids) succ_nodes; (* succ_nodes will remove the temps *) { root_nodes = top_nodes; leaf_nodes = succ_nodes; ids = []; instrs = []; exps =[]} | _ -> assert false @@ -1138,7 +1138,7 @@ struct let stmt = extract_stmt_from_singleton stmt_list "ERROR: StmtExpr should have only one statement.\n" in let res_trans_stmt = instruction trans_state stmt in let idl = res_trans_stmt.ids in - let exps' = list_rev res_trans_stmt.exps in + let exps' = IList.rev res_trans_stmt.exps in match exps' with | (last, typ) :: _ -> (* The StmtExpr contains a single CompoundStmt node, which it evaluates and *) @@ -1210,14 +1210,14 @@ struct | Loops.For _ | Loops.While _ -> res_trans_cond.root_nodes | Loops.DoWhile _ -> res_trans_body.root_nodes in (* Note: prune nodes are by contruction the res_trans_cond.leaf_nodes *) - let prune_nodes_t, prune_nodes_f = list_partition is_true_prune_node res_trans_cond.leaf_nodes in + let prune_nodes_t, prune_nodes_f = IList.partition is_true_prune_node res_trans_cond.leaf_nodes in let prune_t_succ_nodes = match loop_kind with | Loops.For _ | Loops.While _ -> res_trans_body.root_nodes | Loops.DoWhile _ -> [join_node] in Cfg.Node.set_succs_exn join_node join_succ_nodes []; - list_iter (fun n -> Cfg.Node.set_succs_exn n prune_t_succ_nodes []) prune_nodes_t; - list_iter (fun n -> Cfg.Node.set_succs_exn n succ_nodes []) prune_nodes_f; + IList.iter (fun n -> Cfg.Node.set_succs_exn n prune_t_succ_nodes []) prune_nodes_t; + IList.iter (fun n -> Cfg.Node.set_succs_exn n succ_nodes []) prune_nodes_f; let root_nodes = match loop_kind with | Loops.For _ -> @@ -1282,7 +1282,7 @@ struct if res_trans_to_parent.root_nodes <> [] then res_trans_to_parent.root_nodes else trans_state_pri.succ_nodes in - list_iter + IList.iter (fun n -> Cfg.Node.set_succs_exn n trans_s1_succs []) res_trans_s1.leaf_nodes; @@ -1306,7 +1306,7 @@ struct let succ_nodes = trans_state.succ_nodes in let rec collect_right_hand_exprs ts stmt = match stmt with | Clang_ast_t.InitListExpr (_ , stmts , _) -> - list_flatten (list_map (collect_right_hand_exprs ts) stmts) + IList.flatten (IList.map (collect_right_hand_exprs ts) stmts) | _ -> let trans_state' = { ts with succ_nodes = []} in let res_trans_stmt = instruction trans_state' stmt in @@ -1326,35 +1326,35 @@ struct else (collect_left_hand_exprs e tvar (StringSet.add (Sil.typename_to_string typename) tns)); | _ -> [[(e, typ)]] (*This case is an error, shouldn't happen.*)) | Sil.Tstruct (struct_fields, _, _, _, _, _, _) as type_struct -> - let lh_exprs = list_map ( fun (fieldname, fieldtype, _) -> + let lh_exprs = IList.map ( fun (fieldname, fieldtype, _) -> Sil.Lfield (e, fieldname, type_struct) ) struct_fields in - let lh_types = list_map ( fun (fieldname, fieldtype, _) -> fieldtype) + let lh_types = IList.map ( fun (fieldname, fieldtype, _) -> fieldtype) struct_fields in - list_map (fun (e, t) -> list_flatten (collect_left_hand_exprs e t tns)) (zip lh_exprs lh_types) + IList.map (fun (e, t) -> IList.flatten (collect_left_hand_exprs e t tns)) (zip lh_exprs lh_types) | Sil.Tarray (arrtyp, Sil.Const(Sil.Cint(n))) -> let size = Sil.Int.to_int n in let indices = list_range 0 (size - 1) in - let index_constants = list_map + let index_constants = IList.map (fun i -> (Sil.Const (Sil.Cint (Sil.Int.of_int i)))) indices in - let lh_exprs = list_map + let lh_exprs = IList.map (fun index_expr -> Sil.Lindex (e, index_expr)) index_constants in let lh_types = replicate size arrtyp in - list_map (fun (e, t) -> list_flatten (collect_left_hand_exprs e t tns)) (zip lh_exprs lh_types) + IList.map (fun (e, t) -> IList.flatten (collect_left_hand_exprs e t tns)) (zip lh_exprs lh_types) | _ -> [ [(e, typ)] ] in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let var_type = CTypes_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in - let lh = list_flatten (collect_left_hand_exprs (Sil.Lvar pvar) var_type Utils.StringSet.empty) in - let rh = list_flatten (list_map (collect_right_hand_exprs trans_state_pri) stmts ) in - if (list_length rh != list_length lh) then ( + let lh = IList.flatten (collect_left_hand_exprs (Sil.Lvar pvar) var_type Utils.StringSet.empty) in + let rh = IList.flatten (IList.map (collect_right_hand_exprs trans_state_pri) stmts ) in + if (IList.length rh != IList.length lh) then ( (* If the right hand expressions are not as many as the left hand expressions something's wrong *) { empty_res_trans with root_nodes = succ_nodes } ) else ( (* Creating new instructions by assigning right hand side to left hand side expressions *) let sil_loc = CLocation.get_sil_location stmt_info trans_state_pri.parent_line_number context in - let big_zip = list_map + let big_zip = IList.map (fun ( (lh_exp, lh_t), (_, _, rh_exp, is_method_call, rhs_owning_method, rh_t) ) -> let is_pointer_object = ObjcInterface_decl.is_pointer_to_objc_class context.CContext.tenv rh_t in if !Config.arc_mode && (is_method_call || is_pointer_object) then @@ -1366,12 +1366,12 @@ struct else ([], [Sil.Set (lh_exp, lh_t, rh_exp, sil_loc)], [])) (General_utils.zip lh rh) in - let rh_instrs = list_flatten ( list_map (fun (_, instrs, _, _, _, _) -> instrs) rh) in - let assign_instrs = list_flatten(list_map (fun (_, instrs, _) -> instrs) big_zip) in - let assign_ids = list_flatten(list_map (fun (_, _, ids) -> ids) big_zip) in - let instructions = list_append (rh_instrs) assign_instrs in - let rh_ids = list_flatten ( list_map (fun (ids, _, _, _, _, _) -> ids) rh) in - let ids = list_append (rh_ids) assign_ids in + let rh_instrs = IList.flatten ( IList.map (fun (_, instrs, _, _, _, _) -> instrs) rh) in + let assign_instrs = IList.flatten(IList.map (fun (_, instrs, _) -> instrs) big_zip) in + let assign_ids = IList.flatten(IList.map (fun (_, _, ids) -> ids) big_zip) in + let instructions = IList.append (rh_instrs) assign_instrs in + let rh_ids = IList.flatten ( IList.map (fun (ids, _, _, _, _, _) -> ids) rh) in + let ids = IList.append (rh_ids) assign_ids in if PriorityNode.own_priority_node trans_state_pri.priority stmt_info then ( let node_kind = Cfg.Node.Stmt_node "InitListExp" in let node = create_node node_kind (ids) (instructions) sil_loc context in @@ -1449,10 +1449,10 @@ struct let ids = res_trans_ie.ids@ids_assign in let instrs = res_trans_ie.instrs@instrs_assign in if PriorityNode.own_priority_node trans_state_pri.priority stmt_info then ( - let node = list_hd next_node in + let node = IList.hd next_node in Cfg.Node.append_instrs_temps node instrs ids; - list_iter (fun n -> Cfg.Node.set_succs_exn n [node] []) leaf_nodes; - let root_nodes = if (list_length root_nodes) = 0 then next_node else root_nodes in + IList.iter (fun n -> Cfg.Node.set_succs_exn n [node] []) leaf_nodes; + let root_nodes = if (IList.length root_nodes) = 0 then next_node else root_nodes in { root_nodes = root_nodes; leaf_nodes = []; @@ -1639,7 +1639,7 @@ struct let node = create_node node_kind ids_node instrs sil_loc context in Cfg.Node.set_succs_exn node trans_state_pri.succ_nodes []; - list_iter (fun n -> Cfg.Node.set_succs_exn n [node] []) res_trans_stmt.leaf_nodes; + IList.iter (fun n -> Cfg.Node.set_succs_exn n [node] []) res_trans_stmt.leaf_nodes; let root_nodes = if res_trans_stmt.root_nodes <> [] then res_trans_stmt.root_nodes @@ -1678,9 +1678,9 @@ struct let instrs = res_trans_stmt.instrs @ [ret_instr] @ autorelease_instrs in let ids = res_trans_stmt.ids@autorelease_ids in Cfg.Node.append_instrs_temps ret_node instrs ids; - list_iter (fun n -> Cfg.Node.set_succs_exn n [ret_node] []) res_trans_stmt.leaf_nodes; + IList.iter (fun n -> Cfg.Node.set_succs_exn n [ret_node] []) res_trans_stmt.leaf_nodes; let root_nodes_to_parent = - if list_length res_trans_stmt.root_nodes >0 then res_trans_stmt.root_nodes else [ret_node] in + if IList.length res_trans_stmt.root_nodes >0 then res_trans_stmt.root_nodes else [ret_node] in { root_nodes = root_nodes_to_parent; leaf_nodes =[ret_node]; ids = ids; instrs = instrs; exps =[]} | [] -> (* return; *) { empty_res_trans with root_nodes =[ret_node]; leaf_nodes =[ret_node]} @@ -1779,7 +1779,7 @@ struct (* otherwise it's a static variable defined among the locals *) (* and therefore we need the full mangled name *) let cvar''= - if (list_exists(fun (s, t) -> Mangled.from_string s = cvar') formals) then cvar' + if (IList.exists(fun (s, t) -> Mangled.from_string s = cvar') formals) then cvar' else cvar in (cvar'', typ)) in let id = Ident.create_fresh Ident.knormal in @@ -1796,13 +1796,13 @@ struct Cg.add_edge context.cg procname block_pname; let captured_block_vars = block_decl_info.Clang_ast_t.bdi_captured_variables in let captured_vars = CVar_decl.captured_vars_from_block_info context captured_block_vars in - let ids_instrs = list_map assign_captured_var captured_vars in - let ids, instrs = list_split ids_instrs in + let ids_instrs = IList.map assign_captured_var captured_vars in + let ids, instrs = IList.split ids_instrs in let block_data = (context, type_ptr, block_pname, captured_vars) in CContext.add_block context block_pname; M.function_decl context.tenv context.cfg context.cg context.namespace decl (Some block_data); Cfg.set_procname_priority context.cfg block_pname; - let captured_exps = list_map (fun id -> Sil.Var id) ids in + let captured_exps = IList.map (fun id -> Sil.Var id) ids in let tu = Sil.Ctuple ((Sil.Const (Sil.Cfun block_pname)) :: captured_exps) in let block_name = Procname.to_string block_pname in let alloc_block_instr, ids_block = @@ -2073,12 +2073,12 @@ struct and get_clang_stmt_trans stmt_list = let instruction' = fun stmt -> fun trans_state -> instruction trans_state stmt in - list_map instruction' stmt_list + IList.map instruction' stmt_list and get_custom_stmt_trans custom_stmts = let do_one_stmt stmt = match stmt with | `ClangStmt stmt -> get_clang_stmt_trans [stmt] in - list_flatten (list_map do_one_stmt custom_stmts) + IList.flatten (IList.map do_one_stmt custom_stmts) (** Given a translation state, this function translates a list of clang statements. *) and instructions trans_state stmt_list = diff --git a/infer/src/clang/cTrans_utils.ml b/infer/src/clang/cTrans_utils.ml index b819f3116..6df45141f 100644 --- a/infer/src/clang/cTrans_utils.ml +++ b/infer/src/clang/cTrans_utils.ml @@ -164,7 +164,7 @@ let collect_res_trans l = if rt'.leaf_nodes <> [] then rt'.leaf_nodes else rt.leaf_nodes in if rt'.root_nodes <> [] then - list_iter (fun n -> Cfg.Node.set_succs_exn n rt'.root_nodes []) rt.leaf_nodes; + IList.iter (fun n -> Cfg.Node.set_succs_exn n rt'.root_nodes []) rt.leaf_nodes; collect l' { root_nodes = root_nodes; leaf_nodes = leaf_nodes; @@ -237,7 +237,7 @@ struct let node' = mk_node () in Cfg.Node.set_succs_exn node' trans_state.succ_nodes []; let ids_parent = ids_to_parent trans_state.continuation res_state_param.ids in - list_iter (fun n' -> Cfg.Node.set_succs_exn n' [node'] []) res_state_param.leaf_nodes; + IList.iter (fun n' -> Cfg.Node.set_succs_exn n' [node'] []) res_state_param.leaf_nodes; { root_nodes = res_state_param.root_nodes; leaf_nodes = [node']; ids = ids_parent; @@ -455,7 +455,7 @@ let compute_instr_ids_exp_to_parent stmt_info instr ids e lhs typ loc pri = instr@res_instr, ids @ [id], [(Sil.Var id, typ)]) let fix_param_exps_mismatch params_stmt exps_param = - let diff = list_length params_stmt - list_length exps_param in + let diff = IList.length params_stmt - IList.length exps_param in let args = if diff >0 then Array.make diff dummy_exp else assert false in let exps'= exps_param @ (Array.to_list args) in @@ -497,7 +497,7 @@ let get_value_enum_constant tenv enum_type stmt = | Some (Sil.Tenum enum_constants) -> Printing.log_out ">>>Found enum with typename TN_typename('%s')\n" (Sil.typename_to_string typename); let _, v = try - list_find (fun (c, _) -> Mangled.equal c (Mangled.from_string constant)) enum_constants + IList.find (fun (c, _) -> Mangled.equal c (Mangled.from_string constant)) enum_constants with _ -> (Printing.log_err "Enumeration constant '%s' not found. Cannot continue...\n" constant; assert false) in v @@ -687,7 +687,7 @@ let is_dispatch_function stmt_list = | None -> None | Some (dispatch_function, block_arg_pos) -> try - (match list_nth stmts block_arg_pos with + (match IList.nth stmts block_arg_pos with | BlockExpr _ -> Some block_arg_pos | _ -> None) with Not_found -> None @@ -722,10 +722,10 @@ let assign_default_params params_stmt class_name_opt stmt ~is_cxx_method = default_instr | instr, _ -> instr in try - let params_args = list_combine params_stmt args in - list_map replace_default_arg params_args + let params_args = IList.combine params_stmt args in + IList.map replace_default_arg params_args with Invalid_argument _ -> - (* list_combine failed because of different list lengths *) + (* IList.combine failed because of different list lengths *) Printing.log_err "Param count doesn't match %s\n" (Procname.to_string (CMethod_signature.ms_get_name callee_ms)); params_stmt) diff --git a/infer/src/clang/cTypes.ml b/infer/src/clang/cTypes.ml index 63b8382d3..9ed23a22e 100644 --- a/infer/src/clang/cTypes.ml +++ b/infer/src/clang/cTypes.ml @@ -60,7 +60,7 @@ let search_enum_type_by_name tenv name = let f tn typ = match typ with | Sil.Tenum enum_constants -> - list_iter (fun (c, v) -> if Mangled.equal c mname then found:= Some v else ()) enum_constants + IList.iter (fun (c, v) -> if Mangled.equal c mname then found:= Some v else ()) enum_constants | _ -> () in Sil.tenv_iter f tenv; !found diff --git a/infer/src/clang/cTypes_decl.ml b/infer/src/clang/cTypes_decl.ml index 277941fcd..ea7e9d2fa 100644 --- a/infer/src/clang/cTypes_decl.ml +++ b/infer/src/clang/cTypes_decl.ml @@ -104,7 +104,7 @@ let get_method_decls parent decl_list = | CXXRecordDecl (_, _, _, _, decl_list', _, _, _) | RecordDecl (_, _, _, _, decl_list', _, _) -> traverse_decl_list decl decl_list' | _ -> [] - and traverse_decl_list parent decl_list = list_flatten (list_map (traverse_decl parent) decl_list) in + and traverse_decl_list parent decl_list = IList.flatten (IList.map (traverse_decl parent) decl_list) in traverse_decl_list parent decl_list let get_class_methods tenv class_name namespace decl_list = @@ -116,7 +116,7 @@ let get_class_methods tenv class_name namespace decl_list = Some method_proc | _ -> None in (* poor mans list_filter_map *) - list_flatten_options (list_map process_method_decl decl_list) + IList.flatten_options (IList.map process_method_decl decl_list) (** fetches list of superclasses for C++ classes *) let get_superclass_list decl = @@ -124,10 +124,10 @@ let get_superclass_list decl = | Clang_ast_t.CXXRecordDecl (_, _, _, _, _, _, _, cxx_rec_info) -> (* there is no concept of virtual inheritance in the backend right now *) let base_ptr = cxx_rec_info.Clang_ast_t.xrdi_bases @ cxx_rec_info.Clang_ast_t.xrdi_vbases in - let base_decls = list_map Ast_utils.get_decl_from_typ_ptr base_ptr in + let base_decls = IList.map Ast_utils.get_decl_from_typ_ptr base_ptr in let decl_to_mangled_name decl = Mangled.from_string (get_record_name decl) in let get_super_field super_decl = (Sil.Class, decl_to_mangled_name super_decl) in - list_map get_super_field base_decls + IList.map get_super_field base_decls | _ -> [] let add_struct_to_tenv tenv typ = @@ -152,7 +152,7 @@ let rec get_struct_fields tenv record_name namespace decl_list = if not decl_info.Clang_ast_t.di_is_implicit then ignore (add_types_from_decl_to_tenv tenv namespace decl); [] | _ -> [] in - list_flatten (list_map do_one_decl decl_list) + IList.flatten (IList.map do_one_decl decl_list) (* For a record declaration it returns/constructs the type *) and get_declaration_type tenv namespace decl = diff --git a/infer/src/clang/cVar_decl.ml b/infer/src/clang/cVar_decl.ml index f3fbe7443..a2f403e0e 100644 --- a/infer/src/clang/cVar_decl.ml +++ b/infer/src/clang/cVar_decl.ml @@ -100,4 +100,4 @@ let captured_vars_from_block_info context cvl = (Sil.pvar_get_name pvar, typ, false) :: vars | _ -> assert false) | _ -> assert false in - list_fold_right sil_var_of_captured_var cvl [] + IList.fold_right sil_var_of_captured_var cvl [] diff --git a/infer/src/clang/objcInterface_decl.ml b/infer/src/clang/objcInterface_decl.ml index 427497c25..2876a9ff7 100644 --- a/infer/src/clang/objcInterface_decl.ml +++ b/infer/src/clang/objcInterface_decl.ml @@ -45,7 +45,7 @@ let get_super_interface_decl otdi_super = | _ -> None let get_protocols protocols = - let protocol_names = list_map ( + let protocol_names = IList.map ( fun decl -> match decl.Clang_ast_t.dr_name with | Some name -> name.Clang_ast_t.ni_name | None -> assert false @@ -59,7 +59,7 @@ let get_interface_superclasses super_opt protocols = match super_opt with | None -> [] | Some super -> [(Sil.Class, Mangled.from_string super)] in - let protocol_names = list_map ( + let protocol_names = IList.map ( fun name -> (Sil.Protocol, Mangled.from_string name) ) protocols in let super_classes = super_class@protocol_names in @@ -74,7 +74,7 @@ let create_curr_class_and_superclasses_fields tenv decl_list class_name otdi_sup curr_class, superclasses, fields let update_curr_class curr_class superclasses = - let get_protocols protocols = list_fold_right ( + let get_protocols protocols = IList.fold_right ( fun protocol converted_protocols -> match protocol with | (Sil.Protocol, name) -> (Mangled.to_string name):: converted_protocols @@ -99,7 +99,7 @@ let add_class_to_tenv tenv decl_info class_name decl_list obj_c_interface_decl_i obj_c_interface_decl_info.Clang_ast_t.otdi_protocols in let methods = ObjcProperty_decl.get_methods curr_class decl_list in let fields_sc = CField_decl.fields_superclass tenv obj_c_interface_decl_info in - list_iter (fun (fn, ft, _) -> + IList.iter (fun (fn, ft, _) -> Printing.log_out "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn); Printing.log_out "type: '%s'\n" (Sil.typ_to_string ft)) fields_sc; (*In case we found categories, or partial definition of this class earlier and they are already in the tenv *) @@ -115,7 +115,7 @@ let add_class_to_tenv tenv decl_info class_name decl_list obj_c_interface_decl_i let fields = General_utils.append_no_duplicates_fields [Sil.objc_ref_counter_field] fields in let fields = General_utils.sort_fields fields in Printing.log_out "Class %s field:\n" class_name; - list_iter (fun (fn, ft, _) -> + IList.iter (fun (fn, ft, _) -> Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; let interface_type_info = Sil.Tstruct(fields, [], Sil.Class, Some (Mangled.from_string class_name), diff --git a/infer/src/clang/objcProperty_decl.ml b/infer/src/clang/objcProperty_decl.ml index e53510155..b63fec6e8 100644 --- a/infer/src/clang/objcProperty_decl.ml +++ b/infer/src/clang/objcProperty_decl.ml @@ -95,7 +95,7 @@ struct with Not_found -> match curr_class with | ContextCls (name, _, protocols) -> - let res_opt = list_fold_right + let res_opt = IList.fold_right (fun protocol found_procname_opt -> match found_procname_opt with | Some found_procname -> Some found_procname @@ -204,7 +204,7 @@ let check_for_property curr_class method_name meth_decl body = (Property.property_key_to_string (curr_class, property_name)); upgrade_property_accessor (curr_class, property_name) property_type meth_decl defined is_getter) in - list_iter method_is_getter properties_class in + IList.iter method_is_getter properties_class in check_property_accessor curr_class method_name true; check_property_accessor curr_class method_name false @@ -218,7 +218,7 @@ let method_is_property_accesor cls method_name = if method_name = getter_name then Some (property_name, property_type, true) else if method_name = setter_name then Some (property_name, property_type, false) else None in - list_fold_right method_is_getter properties_class None + IList.fold_right method_is_getter properties_class None let prepare_dynamic_property curr_class decl_info property_impl_decl_info = let pname = Ast_utils.property_name property_impl_decl_info in @@ -249,12 +249,12 @@ let prepare_dynamic_property curr_class decl_info property_impl_decl_info = [] let is_property_read_only attributes = - list_mem (Ast_utils.property_attribute_eq) `Readonly attributes + IList.mem (Ast_utils.property_attribute_eq) `Readonly attributes let get_memory_management_attribute attributes = let memory_management_attributes = Ast_utils.get_memory_management_attributes () in - try Some (list_find ( - fun att -> list_mem (Ast_utils.property_attribute_eq) + try Some (IList.find ( + fun att -> IList.mem (Ast_utils.property_attribute_eq) att memory_management_attributes) attributes) with Not_found -> None @@ -365,7 +365,7 @@ let add_properties_to_table curr_class decl_list = Property.add_property (curr_class, name_info) pdi.Clang_ast_t.opdi_type_ptr pdi.Clang_ast_t.opdi_property_attributes decl_info; | _ -> () in - list_iter add_property_to_table decl_list + IList.iter add_property_to_table decl_list (* Given a list of declarations in an interface returns list of methods)*) let get_methods curr_class decl_list = @@ -382,4 +382,4 @@ let get_methods curr_class decl_list = let meth_name = General_utils.mk_procname_from_objc_method class_name method_name method_kind in meth_name:: list_methods | _ -> list_methods in - list_fold_right get_method decl_list [] + IList.fold_right get_method decl_list [] diff --git a/infer/src/harness/androidFramework.ml b/infer/src/harness/androidFramework.ml index f6669679d..58c51658a 100644 --- a/infer/src/harness/androidFramework.ml +++ b/infer/src/harness/androidFramework.ml @@ -18,7 +18,7 @@ open Utils (** work-in-progress list of known callback-registering method names *) let callback_register_methods = let method_list = ["addCallback"; "register"; "setOnClickListener"] in - list_fold_left (fun set str -> StringSet.add str set) StringSet.empty method_list + IList.fold_left (fun set str -> StringSet.add str set) StringSet.empty method_list let is_known_callback_register_method proc_str = StringSet.mem proc_str callback_register_methods @@ -245,7 +245,7 @@ let android_callbacks = ("android.widget", "TimePicker$OnTimeChangedListener"); ("android.widget", "ZoomButtonsController$OnZoomListener"); ] in - list_fold_left (fun cbSet (pkg, clazz) -> + IList.fold_left (fun cbSet (pkg, clazz) -> let qualified_name = Mangled.from_string (pkg ^ "." ^ clazz) in Mangled.MangledSet.add qualified_name cbSet) Mangled.MangledSet.empty cb_strs @@ -260,7 +260,7 @@ let get_all_supertypes typ tenv = | None -> typs and get_supers_rec typ tenv all_supers = let direct_supers = get_direct_supers typ in - list_fold_left (fun typs (_, name) -> add_typ name typs) all_supers direct_supers in + IList.fold_left (fun typs (_, name) -> add_typ name typs) all_supers direct_supers in get_supers_rec typ tenv TypSet.empty (** return true if [typ0] <: [typ1] *) @@ -303,7 +303,7 @@ let get_callback_registered_by procname args tenv = (* for now, we assume a method is a callback registration method if it is a setter and has a * callback class as a non - receiver argument *) let is_callback_register_like = - let has_non_this_callback_arg args = list_length args > 1 in + let has_non_this_callback_arg args = IList.length args > 1 in let has_registery_name procname = Procname.is_java procname && (PatternMatch.is_setter procname || is_known_callback_register_method (Procname.java_get_method procname)) in @@ -314,9 +314,9 @@ let get_callback_registered_by procname args tenv = if is_callback_register_like then (* we don't want to check if the receiver is a callback class; it's one of the method arguments * that's being registered as a callback *) - let get_non_this_args args = list_tl args in + let get_non_this_args args = IList.tl args in try - Some (list_find (fun (_, typ) -> is_ptr_to_callback_class typ tenv) (get_non_this_args args)) + Some (IList.find (fun (_, typ) -> is_ptr_to_callback_class typ tenv) (get_non_this_args args)) with Not_found -> None else None @@ -345,12 +345,12 @@ let get_lifecycle_for_framework_typ_opt lifecycle_typ lifecycle_proc_strs tenv = | Some (Sil.Tstruct(_, _, Sil.Class, Some class_name, _, decl_procs, _) as lifecycle_typ) -> (* TODO (t4645631): collect the procedures for which is_java is returning false *) let lookup_proc lifecycle_proc = - list_find (fun decl_proc -> + IList.find (fun decl_proc -> Procname.is_java decl_proc && lifecycle_proc = Procname.java_get_method decl_proc ) decl_procs in (* convert each of the framework lifecycle proc strings to a lifecycle method procname *) let lifecycle_procs = - list_fold_left (fun lifecycle_procs lifecycle_proc_str -> + IList.fold_left (fun lifecycle_procs lifecycle_proc_str -> try (lookup_proc lifecycle_proc_str) :: lifecycle_procs with Not_found -> lifecycle_procs) [] lifecycle_proc_strs in @@ -380,4 +380,4 @@ let is_runtime_exception tenv exn = let non_stub_android_jar () = let root_dir = Filename.dirname (Filename.dirname Sys.executable_name) in - list_fold_left Filename.concat root_dir ["lib"; "java"; "android"; "android-19.jar"] + IList.fold_left Filename.concat root_dir ["lib"; "java"; "android"; "android-19.jar"] diff --git a/infer/src/harness/harness.ml b/infer/src/harness/harness.ml index 624d26cf2..02eeb5a78 100644 --- a/infer/src/harness/harness.ml +++ b/infer/src/harness/harness.ml @@ -22,7 +22,7 @@ let insert_after lst test to_insert = | instr :: to_process -> let processed' = instr :: processed in if test instr then - list_append (list_rev processed') (list_append to_insert to_process) + IList.append (IList.rev processed') (IList.append to_insert to_process) else insert_rec to_process processed' | [] -> lst in @@ -53,7 +53,7 @@ let extract_callbacks procdesc cfg_file cfg tenv harness_name harness_lvar callb | l -> (* choose to describe this anonymous inner class with one of the interfaces that it * implements. translation always places interfaces at the end of the supertypes list *) - Mangled.get_mangled (list_hd (list_rev l)) + Mangled.get_mangled (IList.hd (IList.rev l)) else typ_str in Mangled.from_string (pretty_typ_str ^ "[line " ^ Location.to_string loc ^ "]") in let create_instrumentation_fields created_flds node instr = match instr with @@ -98,7 +98,7 @@ let find_registered_callbacks lifecycle_trace harness_name proc_file_map tenv = (* TODO (t4793988): do something more principled here *) let harness_lvar = Sil.Lvar (Sil.mk_pvar_global harness_name) in let lifecycle_cfg_files = - list_fold_left (fun lifecycle_files (lifecycle_proc, _) -> + IList.fold_left (fun lifecycle_files (lifecycle_proc, _) -> try let cfg_fname = let source_dir = Inhabit.source_dir_from_name lifecycle_proc proc_file_map in @@ -109,7 +109,7 @@ let find_registered_callbacks lifecycle_trace harness_name proc_file_map tenv = DB.FilenameSet.fold (fun cfg_file registered_callbacks -> match Cfg.load_cfg_from_file cfg_file with | Some cfg -> - list_fold_left (fun registered_callbacks procdesc -> + IList.fold_left (fun registered_callbacks procdesc -> extract_callbacks procdesc cfg_file cfg tenv harness_name harness_lvar registered_callbacks ) registered_callbacks (Cfg.get_all_procs cfg) | None -> registered_callbacks @@ -122,7 +122,7 @@ let try_create_lifecycle_trace typ lifecycle_typ lifecycle_procs proc_file_map t when AndroidFramework.typ_is_lifecycle_typ typ lifecycle_typ tenv && not (AndroidFramework.is_android_lib_class class_name) -> let ptr_to_typ = Some (Sil.Tptr (typ, Sil.Pk_pointer)) in - list_fold_left (fun trace lifecycle_proc -> + IList.fold_left (fun trace lifecycle_proc -> (* given a lifecycle subclass T, resolve the call T.lifecycle_proc() to the procname * that will actually be called at runtime *) let resolved_proc = SymExec.resolve_method tenv class_name lifecycle_proc in @@ -137,7 +137,7 @@ let extract_callbacks lifecycle_trace harness_procname proc_file_map tenv = let harness_name = Mangled.from_string (Procname.to_string harness_procname) in let registered_cbs = find_registered_callbacks lifecycle_trace harness_name proc_file_map tenv in - let fields = list_map (fun (fld, typ, _) -> (fld, typ, [])) registered_cbs in + let fields = IList.map (fun (fld, typ, _) -> (fld, typ, [])) registered_cbs in (* create a new typ for the harness containing all of the cb extraction vars as static fields *) let harness_typ = Sil.Tstruct (fields, [], Sil.Class, Some harness_name, [], [harness_procname], []) in @@ -146,7 +146,7 @@ let extract_callbacks lifecycle_trace harness_procname proc_file_map tenv = let harness_class = Sil.TN_csu (Sil.Class, harness_name) in Sil.tenv_add tenv harness_class harness_typ; let cfgs_to_save = - list_fold_left (fun cfgs_to_save (_, _, instrument_sil_f) -> + IList.fold_left (fun cfgs_to_save (_, _, instrument_sil_f) -> (* instrument the cfg's with callback extraction code *) let (cfg_file, cfg) = instrument_sil_f harness_typ in DB.FilenameMap.add cfg_file cfg cfgs_to_save @@ -156,11 +156,11 @@ let extract_callbacks lifecycle_trace harness_procname proc_file_map tenv = (fun cfg_file cfg -> Cfg.store_cfg_to_file cfg_file false cfg) cfgs_to_save; (* these are all the static fields holding callbacks that should be invoked by the harness *) let harness_global = Sil.Lvar (Sil.mk_pvar_global harness_name) in - list_map (fun (fld, typ, _) -> (Sil.Lfield (harness_global, fld, harness_typ), typ)) fields + IList.map (fun (fld, typ, _) -> (Sil.Lfield (harness_global, fld, harness_typ), typ)) fields (** generate a harness for each lifecycle type in an Android application *) let create_android_harness proc_file_map tenv = - list_iter (fun (pkg, clazz, lifecycle_methods) -> + IList.iter (fun (pkg, clazz, lifecycle_methods) -> let typ_name = Mangled.from_package_class pkg clazz in match AndroidFramework.get_lifecycle_for_framework_typ_opt typ_name lifecycle_methods tenv with | Some (framework_typ, framework_procs) -> diff --git a/infer/src/harness/inhabit.ml b/infer/src/harness/inhabit.ml index d147574a5..c0c3c035c 100644 --- a/infer/src/harness/inhabit.ml +++ b/infer/src/harness/inhabit.ml @@ -74,8 +74,8 @@ let create_fresh_local_name () = incr local_name_cntr; "dummy_local" ^ string_of_int !local_name_cntr -(** more forgiving variation of list_tl that won't raise an exception on the empty list *) -let tl_or_empty l = if l = [] then l else list_tl l +(** more forgiving variation of IList.tl that won't raise an exception on the empty list *) +let tl_or_empty l = if l = [] then l else IList.tl l let get_non_receiver_formals formals = tl_or_empty formals @@ -113,9 +113,9 @@ let rec inhabit_typ typ proc_file_map env = let try_get_non_receiver_formals p = try get_non_receiver_formals (formals_from_name p proc_file_map) with Not_found -> [] in - Procname.is_constructor p && list_for_all (fun (_, typ) -> + Procname.is_constructor p && IList.for_all (fun (_, typ) -> not (TypSet.mem typ env.cur_inhabiting)) (try_get_non_receiver_formals p) in - list_filter (fun p -> is_suitable_constructor p) methods + IList.filter (fun p -> is_suitable_constructor p) methods | _ -> [] in let (env, typ_class_name) = match get_all_suitable_constructors typ with | constructor :: _ -> @@ -155,7 +155,7 @@ and inhabit_args formals proc_file_map env = let inhabit_arg (formal_name, formal_typ) (args, env) = let (exp, env) = inhabit_typ formal_typ proc_file_map env in ((exp, formal_typ) :: args, env) in - list_fold_right inhabit_arg formals ([], env) + IList.fold_right inhabit_arg formals ([], env) (** create Sil that calls the constructor in constr_name on allocated_obj and inhabits the * remaining arguments *) @@ -219,12 +219,12 @@ let inhabit_fld_trace flds proc_file_map env = with Not_found -> (* TODO (t4645631): investigate why this failure occurs *) env in - list_fold_left (fun env procname -> + IList.fold_left (fun env procname -> if not (Procname.is_constructor procname) && not (Procname.java_is_access_method procname) then inhabit_cb_call procname env else env) env procs | _ -> assert false in - list_fold_left (fun env fld -> invoke_cb fld env) env flds + IList.fold_left (fun env fld -> invoke_cb fld env) env flds (** create a dummy file for the harness and associate them in the exe_env *) let create_dummy_harness_file harness_name harness_cfg tenv = @@ -244,7 +244,7 @@ let write_harness_to_file harness_instrs harness_file = let harness_file = let harness_file_name = DB.source_file_to_string harness_file in ref (create_outfile harness_file_name) in - let pp_harness fmt = list_iter (fun instr -> + let pp_harness fmt = IList.iter (fun instr -> Format.fprintf fmt "%a\n" (Sil.pp_instr pe_text) instr) harness_instrs in do_outf harness_file (fun outf -> pp_harness outf.fmt; @@ -277,7 +277,7 @@ let add_harness_to_cg harness_name harness_cfg harness_node loc cg tenv = let ret_type = lookup_typ (Procname.java_get_return_type proc_name) in let formals = let param_strs = Procname.java_get_parameters proc_name in - list_fold_right (fun typ_str params -> ("", lookup_typ typ_str) :: params) param_strs [] in + IList.fold_right (fun typ_str params -> ("", lookup_typ typ_str) :: params) param_strs [] in let proc_attributes = { (ProcAttributes.default proc_name Config.Java) with ProcAttributes.formals; @@ -288,7 +288,7 @@ let add_harness_to_cg harness_name harness_cfg harness_node loc cg tenv = Cfg.Procdesc.cfg = harness_cfg; proc_attributes = proc_attributes; } in - list_iter (fun p -> + IList.iter (fun p -> (* add harness -> callee edge to the call graph *) Cg.add_edge cg harness_name p; (* create dummy procdescs for callees not in the module. hopefully t4583729 will remove the @@ -323,7 +323,7 @@ let setup_harness_cfg harness_name harness_cfg env source_dir cg tenv = } in let harness_node = (* important to reverse the list or there will be scoping issues! *) - let instrs = (list_rev env.instrs) in + let instrs = (IList.rev env.instrs) in let nodekind = Cfg.Node.Stmt_node "method_body" in Cfg.Node.create harness_cfg env.pc nodekind instrs procdesc env.tmp_vars in let (start_node, exit_node) = @@ -346,7 +346,7 @@ let setup_harness_cfg harness_name harness_cfg env source_dir cg tenv = (** create a procedure named harness_name that calls each of the methods in trace in the specified * order with the specified receiver and add it to the execution environment *) let inhabit_trace trace cb_flds harness_name proc_file_map tenv = - if list_length trace > 0 then + if IList.length trace > 0 then (* pick an arbitrary cg and cfg to piggyback the harness code onto *) let (source_dir, source_file, cg) = let (proc_name, source_file) = Procname.Map.choose proc_file_map in @@ -368,10 +368,10 @@ let inhabit_trace trace cb_flds harness_name proc_file_map tenv = let env'' = (* invoke lifecycle methods *) let env' = - list_fold_left (fun env to_call -> inhabit_call to_call proc_file_map env) empty_env trace in + IList.fold_left (fun env to_call -> inhabit_call to_call proc_file_map env) empty_env trace in (* invoke callbacks *) inhabit_fld_trace cb_flds proc_file_map env' in try setup_harness_cfg harness_name harness_cfg env'' source_dir cg tenv; - write_harness_to_file (list_rev env''.instrs) harness_file + write_harness_to_file (IList.rev env''.instrs) harness_file with Not_found -> () diff --git a/infer/src/harness/stacktrace.ml b/infer/src/harness/stacktrace.ml index dd00f40f0..6f238372c 100644 --- a/infer/src/harness/stacktrace.ml +++ b/infer/src/harness/stacktrace.ml @@ -45,13 +45,13 @@ let try_resolve_frame str_frame exe_env tenv = match Sil.tenv_lookup tenv (Sil.TN_csu (Sil.Class, class_name)) with | Some Sil.Tstruct (_, _, Sil.Class, _, _, decl_procs, _) -> let possible_calls = - list_filter + IList.filter (fun proc -> Procname.java_get_method proc = str_frame.method_str) decl_procs in - if list_length possible_calls > 0 then - (* using list_hd here assumes that all of the possible calls are declared in the + if IList.length possible_calls > 0 then + (* using IList.hd here assumes that all of the possible calls are declared in the * same file, which will be true in Java but not necessarily in other languages *) - let file_name = Exe_env.get_source exe_env (list_hd possible_calls) in + let file_name = Exe_env.get_source exe_env (IList.hd possible_calls) in Resolved { possible_calls = possible_calls; file_name = file_name; line_num = str_frame.line_num; } else Unresolved str_frame @@ -79,9 +79,9 @@ let parse_frame frame_str exe_env tenv = (** create an Infer-readable representation of a stack trace given its raw text *) let parse_stack_trace trace_str exe_env = - let tenv = Exe_env.get_tenv exe_env (list_hd (Cg.get_defined_nodes (Exe_env.get_cg exe_env))) in + let tenv = Exe_env.get_tenv exe_env (IList.hd (Cg.get_defined_nodes (Exe_env.get_cg exe_env))) in let trace_list = Str.split (Str.regexp "\n") trace_str in - list_map (fun frame_str -> parse_frame frame_str exe_env tenv) trace_list + IList.map (fun frame_str -> parse_frame frame_str exe_env tenv) trace_list let pp_str_frame fmt = function | Resolved f -> diff --git a/infer/src/java/jAnnotation.ml b/infer/src/java/jAnnotation.ml index 529ede6cb..5565bdc8e 100644 --- a/infer/src/java/jAnnotation.ml +++ b/infer/src/java/jAnnotation.ml @@ -23,7 +23,7 @@ let translate a : Sil.annotation = | _ -> "?" in let element_value_pairs = a.JBasics.element_value_pairs in { Sil.class_name = class_name; - Sil.parameters = list_map translate_value_pair element_value_pairs } + Sil.parameters = IList.map translate_value_pair element_value_pairs } (** Translate an item annotation. *) @@ -32,7 +32,7 @@ let translate_item avlist : Sil.item_annotation = | Javalib.RTVisible -> true | Javalib.RTInvisible -> false in let trans (a, v) = translate a, trans_vis v in - list_map trans avlist + IList.map trans avlist (** Translate a method annotation. *) @@ -40,5 +40,5 @@ let translate_method ann : Sil.method_annotation = let global_ann = ann.Javalib.ma_global in let param_ann = ann.Javalib.ma_parameters in let ret_item = translate_item global_ann in - let param_items = list_map translate_item param_ann in + let param_items = IList.map translate_item param_ann in ret_item, param_items diff --git a/infer/src/java/jClasspath.ml b/infer/src/java/jClasspath.ml index 792f4debd..d997f2a43 100644 --- a/infer/src/java/jClasspath.ml +++ b/infer/src/java/jClasspath.ml @@ -39,7 +39,7 @@ let collect_specs_filenames jar_filename = else let proc_filename = (Filename.chop_extension (Filename.basename filename)) in StringSet.add proc_filename set in - models_specs_filenames := list_fold_left collect !models_specs_filenames (Zip.entries file_in); + models_specs_filenames := IList.fold_left collect !models_specs_filenames (Zip.entries file_in); Zip.close_in file_in @@ -102,7 +102,7 @@ let load_sources_and_classes () = let cn, root_info = Javalib.extract_class_name_from_file fname in let root_dir = if root_info = "" then Filename.current_dir_name else root_info in let updated_roots = - if list_exists (fun p -> p = root_dir) roots then roots + if IList.exists (fun p -> p = root_dir) roots then roots else root_dir:: roots in loop paths updated_roots sources (JBasics.ClassSet.add cn classes) | JVerbose.Classpath parsed_paths -> @@ -114,7 +114,7 @@ let load_sources_and_classes () = | Failure "lexing: empty token" -> loop paths roots sources classes | End_of_file -> close_in file_in; - let classpath = list_fold_left append_path "" (roots @ (add_android_jar paths)) in + let classpath = IList.fold_left append_path "" (roots @ (add_android_jar paths)) in (classpath, sources, classes) in loop [] [] StringMap.empty JBasics.ClassSet.empty @@ -162,10 +162,10 @@ let lookup_node cn (program: program) = let classname_of_class_filename class_filename = let parts = Str.split (Str.regexp "/") class_filename in let classname_str = - if list_length parts > 1 then - list_fold_left (fun s p -> s^"."^p) (list_hd parts) (list_tl parts) + if IList.length parts > 1 then + IList.fold_left (fun s p -> s^"."^p) (IList.hd parts) (IList.tl parts) else - list_hd parts in + IList.hd parts in JBasics.make_cn classname_str @@ -177,7 +177,7 @@ let extract_classnames classnames jar_filename = let () = ignore (Str.search_forward (Str.regexp "class") class_filename 0) in (classname_of_class_filename (Filename.chop_extension class_filename):: classes) with Not_found -> classes in - let classnames_after = list_fold_left collect classnames (Zip.entries file_in) in + let classnames_after = IList.fold_left collect classnames (Zip.entries file_in) in Zip.close_in file_in; classnames_after @@ -186,13 +186,13 @@ let collect_classes classmap jar_filename = let classpath = Javalib.class_path jar_filename in let collect classmap cn = JBasics.ClassMap.add cn (Javalib.get_class classpath cn) classmap in - list_fold_left collect classmap (extract_classnames [] jar_filename) + IList.fold_left collect classmap (extract_classnames [] jar_filename) let classmap_of_classpath classpath = let jar_filenames = - list_filter (fun p -> not (Sys.is_directory p)) (split_classpath classpath) in - list_fold_left collect_classes JBasics.ClassMap.empty jar_filenames + IList.filter (fun p -> not (Sys.is_directory p)) (split_classpath classpath) in + IList.fold_left collect_classes JBasics.ClassMap.empty jar_filenames let load_program classpath classes arg_source_files = diff --git a/infer/src/java/jFrontend.ml b/infer/src/java/jFrontend.ml index 9b3fdb5dd..4afc71e57 100644 --- a/infer/src/java/jFrontend.ml +++ b/infer/src/java/jFrontend.ml @@ -121,7 +121,7 @@ let add_amethod program icfg node am is_static = let path_of_cached_classname cn = let root_path = Filename.concat !Config.results_dir "classnames" in - let package_path = list_fold_left Filename.concat root_path (JBasics.cn_package cn) in + let package_path = IList.fold_left Filename.concat root_path (JBasics.cn_package cn) in Filename.concat package_path ((JBasics.cn_simple_name cn)^".java") @@ -186,7 +186,7 @@ let should_capture classes source_basename node = let classname = Javalib.get_name node in let temporary_skip = (* TODO (#6341744): remove this *) - list_exists + IList.exists (fun part -> part = "graphschema") (JBasics.cn_package classname) in if JBasics.ClassSet.mem classname classes && not temporary_skip then diff --git a/infer/src/java/jMain.ml b/infer/src/java/jMain.ml index a0f6f7612..b13b87e1a 100644 --- a/infer/src/java/jMain.ml +++ b/infer/src/java/jMain.ml @@ -87,7 +87,7 @@ let do_source_file never_null_matcher linereader classes program tenv source_basename source_file in store_icfg tenv call_graph cfg source_file; if JConfig.create_harness then - list_fold_left + IList.fold_left (fun proc_file_map pdesc -> Procname.Map.add (Cfg.Procdesc.get_proc_name pdesc) source_file proc_file_map) proc_file_map (Cfg.get_all_procs cfg) diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index 46cd0514b..a13387957 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -98,10 +98,10 @@ let get_undefined_method_call ovt = let retrieve_fieldname fieldname = try let subs = Str.split (Str.regexp (Str.quote ".")) (Ident.fieldname_to_string fieldname) in - if list_length subs = 0 then + if IList.length subs = 0 then assert false else - list_hd (list_rev subs) + IList.hd (IList.rev subs) with hd -> assert false @@ -110,7 +110,7 @@ let get_field_name program static tenv cn fs context = | Sil.Tstruct (fields, sfields, Sil.Class, _, _, _, _) -> let fieldname, _, _ = try - list_find + IList.find (fun (fieldname, _, _) -> retrieve_fieldname fieldname = JBasics.fs_name fs) (if static then sfields else fields) with Not_found -> @@ -135,14 +135,14 @@ let formals_from_signature program tenv cn ms kind = let init_arg_list = match kind with | Procname.Static -> [] | Procname.Non_Static -> [(JConfig.this, JTransType.get_class_type program tenv cn)] in - list_rev (list_fold_left collect init_arg_list (JBasics.ms_args ms)) + IList.rev (IList.fold_left collect init_arg_list (JBasics.ms_args ms)) let formals program tenv cn impl = let collect l (vt, var) = let name = JBir.var_name_g var in let typ = JTransType.param_type program tenv cn var vt in (name, typ):: l in - list_rev (list_fold_left collect [] (JBir.params impl)) + IList.rev (IList.fold_left collect [] (JBir.params impl)) (** Creates the local and formal variables from a procedure based on the impl argument. If the meth_kind is Init, we add a parameter field to @@ -155,16 +155,16 @@ let locals_formals program tenv cn impl meth_kind = else formals program tenv cn impl in let is_formal v = let v = Mangled.to_string v in - list_exists (fun (v', _) -> Utils.string_equal v v') form_list in + IList.exists (fun (v', _) -> Utils.string_equal v v') form_list in let collect l var = let vname = Mangled.from_string (JBir.var_name_g var) in - let names = (fst (list_split l)) in - if not (is_formal vname) && (not (list_mem Mangled.equal vname names)) then + let names = (fst (IList.split l)) in + if not (is_formal vname) && (not (IList.mem Mangled.equal vname names)) then (vname, Sil.Tvoid):: l else l in let vars = JBir.vars impl in - let loc_list = list_rev (Array.fold_left collect [] vars) in + let loc_list = IList.rev (Array.fold_left collect [] vars) in (loc_list, form_list) let get_constant (c : JBir.const) = @@ -289,7 +289,7 @@ let create_local_procdesc program linereader cfg tenv node m = let proc_attributes = { (ProcAttributes.default proc_name Config.Java) with ProcAttributes.access = trans_access am.Javalib.am_access; - exceptions = list_map JBasics.cn_name am.Javalib.am_exceptions; + exceptions = IList.map JBasics.cn_name am.Javalib.am_exceptions; formals; is_abstract = true; is_bridge_method = am.Javalib.am_bridge; @@ -316,7 +316,7 @@ let create_local_procdesc program linereader cfg tenv node m = let proc_attributes = { (ProcAttributes.default proc_name Config.Java) with ProcAttributes.access = trans_access cm.Javalib.cm_access; - exceptions = list_map JBasics.cn_name cm.Javalib.cm_exceptions; + exceptions = IList.map JBasics.cn_name cm.Javalib.cm_exceptions; formals; is_bridge_method = cm.Javalib.cm_bridge; is_synthetic_method = cm.Javalib.cm_synthetic; @@ -342,7 +342,7 @@ let create_local_procdesc program linereader cfg tenv node m = let proc_attributes = { (ProcAttributes.default proc_name Config.Java) with ProcAttributes.access = trans_access cm.Javalib.cm_access; - exceptions = list_map JBasics.cn_name cm.Javalib.cm_exceptions; + exceptions = IList.map JBasics.cn_name cm.Javalib.cm_exceptions; formals; is_bridge_method = cm.Javalib.cm_bridge; is_defined = true; @@ -585,7 +585,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_ | _ -> [], [] in (ids, instrs, [(sil_obj_expr, sil_obj_type)]) in let (idl, instrs, call_args) = - list_fold_left + IList.fold_left (fun (idl_accu, instrs_accu, args_accu) expr -> let (idl, instrs, sil_expr) = expression context pc expr in let sil_expr_type = JTransType.expr_type context expr in @@ -645,10 +645,10 @@ let get_array_size context pc expr_list content_type = match other_instrs with | (other_idl, other_instrs, other_exprs) -> (idl@other_idl, instrs@other_instrs, sil_size_expr:: other_exprs) in - let (idl, instrs, sil_size_exprs) = (list_fold_right get_expr_instr expr_list ([],[],[])) in + let (idl, instrs, sil_size_exprs) = (IList.fold_right get_expr_instr expr_list ([],[],[])) in let get_array_type sil_size_expr content_type = Sil.Tarray (content_type, sil_size_expr) in - let array_type = (list_fold_right get_array_type sil_size_exprs content_type) in + let array_type = (IList.fold_right get_array_type sil_size_exprs content_type) in let array_size = Sil.Sizeof (array_type, Sil.Subtype.exact) in (idl, instrs, array_size) @@ -722,7 +722,7 @@ let extends context node1 node2 = let is_matching cn = JBasics.cn_equal cn (Javalib.get_name node2) in let rec check cn_list = - if list_exists is_matching cn_list then true + if IList.exists is_matching cn_list then true else iterate cn_list and iterate cn_list = @@ -744,7 +744,7 @@ let extends context node1 node2 = match super_cn_list with | [] -> false | l -> check l in - list_exists per_classname cn_list in + IList.exists per_classname cn_list in check [Javalib.get_name node1] let instruction_array_call ms obj_type obj args var_opt vt = @@ -808,7 +808,7 @@ let rec instruction context pc instr : translation = cfg (get_location (JContext.get_impl context) pc meth_kind cn) node_kind sil_instrs (JContext.get_procdesc context) temps in let return_not_null () = (match_never_null loc.Location.file proc_name - || list_exists (fun p -> Procname.equal p proc_name) JTransType.never_returning_null) in + || IList.exists (fun p -> Procname.equal p proc_name) JTransType.never_returning_null) in try match instr with | JBir.AffectVar (var, expr) -> @@ -934,7 +934,7 @@ let rec instruction context pc instr : translation = | JBir.NewArray (var, vt, expr_list) -> let builtin_new_array = Sil.Const (Sil.Cfun SymExec.ModelBuiltins.__new_array) in let content_type = JTransType.value_type program tenv vt in - let array_type = JTransType.create_array_type content_type (list_length expr_list) in + let array_type = JTransType.create_array_type content_type (IList.length expr_list) in let array_name = JContext.set_pvar context var array_type in let (idl, instrs, array_size) = get_array_size context pc expr_list content_type in let call_args = [(array_size, array_type)] in diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 2985fa94d..89e9d9b8d 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -246,11 +246,11 @@ let get_all_fields program static cn = | Some super_classname -> loop super_classname in let current_fields = Javalib.cf_fold (collect_class_field static classname) (Javalib.JClass jclass) [] in - (list_sort compare current_fields) @ super_fields + (IList.sort compare current_fields) @ super_fields | Some (Javalib.JInterface jinterface) when static -> let current_fields = Javalib.if_fold (collect_interface_field classname) (Javalib.JInterface jinterface) [] in - list_sort compare current_fields + IList.sort compare current_fields | _ -> [] in loop cn @@ -279,7 +279,7 @@ let collect_models_class_fields classpath_field_map static cn cf l = let add_model_fields program (static_fields, nonstatic_fields) cn = let collect_fields = - list_fold_left (fun map (fn, ft, _) -> Ident.FieldMap.add fn ft map) Ident.FieldMap.empty in + IList.fold_left (fun map (fn, ft, _) -> Ident.FieldMap.add fn ft map) Ident.FieldMap.empty in try match JBasics.ClassMap.find cn (JClasspath.get_models program) with | Javalib.JClass _ as jclass -> @@ -303,12 +303,12 @@ let rec create_sil_type program tenv cn = | None -> dummy_type cn | Some node -> let create_super_list interface_names = - (list_map (fun i -> Mangled.from_string (JBasics.cn_name i)) interface_names) in + (IList.map (fun i -> Mangled.from_string (JBasics.cn_name i)) interface_names) in let (super_list, nonstatic_fields, static_fields, item_annotation) = match node with | Javalib.JInterface jinterface -> let static_fields = get_all_fields program true cn in - let sil_interface_list = list_map (fun c -> (Sil.Class, c)) (create_super_list jinterface.Javalib.i_interfaces) in + let sil_interface_list = IList.map (fun c -> (Sil.Class, c)) (create_super_list jinterface.Javalib.i_interfaces) in let item_annotation = JAnnotation.translate_item jinterface.Javalib.i_annotations in (sil_interface_list, [], static_fields, item_annotation) | Javalib.JClass jclass -> @@ -329,7 +329,7 @@ let rec create_sil_type program tenv cn = | _ -> assert false in super_classname :: interface_list in let super_sil_classname_list = - list_map (fun c -> (Sil.Class, c)) super_classname_list in + IList.map (fun c -> (Sil.Class, c)) super_classname_list in (super_sil_classname_list, nonstatic_fields, static_fields, item_annotation) in let classname = Mangled.from_string (JBasics.cn_name cn) in let method_procnames = get_class_procnames cn node in @@ -400,7 +400,7 @@ let get_var_type_from_sig context var = try let tenv = JContext.get_tenv context in let vt', var' = - list_find + IList.find (fun (vt', var') -> JBir.var_equal var var') (JBir.params (JContext.get_impl context)) in Some (param_type program tenv (JContext.get_cn context) var' vt') @@ -498,4 +498,4 @@ let never_returning_null = JBasics.make_ms method_name arg_types (Some (JBasics.TObject (JBasics.TClass return_cn))) in get_method_procname cn ms kind in - list_map make_procname never_null_method_sigs + IList.map make_procname never_null_method_sigs diff --git a/infer/src/llvm/lParser.mly b/infer/src/llvm/lParser.mly index 2ebd5e074..dc391c82b 100644 --- a/infer/src/llvm/lParser.mly +++ b/infer/src/llvm/lParser.mly @@ -158,9 +158,9 @@ program: | targets func_defs = function_def* opt_mappings = metadata_def* EOF { - let mappings = list_flatten_options opt_mappings in + let mappings = IList.flatten_options opt_mappings in let add_mapping map (metadata_id, aggregate) = MetadataMap.add metadata_id aggregate map in - let metadata_map = list_fold_left add_mapping MetadataMap.empty mappings in + let metadata_map = IList.fold_left add_mapping MetadataMap.empty mappings in Program (func_defs, metadata_map) } targets: @@ -254,7 +254,7 @@ ptr_typ: | tp = typ STAR { tp } block: - | LBRACE annotated_instrs = annotated_instruction* RBRACE { list_flatten_options annotated_instrs } + | LBRACE annotated_instrs = annotated_instruction* RBRACE { IList.flatten_options annotated_instrs } annotated_instruction: | instr = real_instruction anno = annotation? { Some (instr, anno) } diff --git a/infer/src/llvm/lTrans.ml b/infer/src/llvm/lTrans.ml index 04d536221..26499df0a 100644 --- a/infer/src/llvm/lTrans.ml +++ b/infer/src/llvm/lTrans.ml @@ -94,7 +94,7 @@ let rec trans_annotated_instructions let new_sil_instr = Sil.Call ( [ident_of_variable ret_var], Sil.Const (Sil.Cfun (procname_of_function_variable func_var)), - list_map (fun (tp, arg) -> (trans_operand arg, trans_typ tp)) typed_args, + IList.map (fun (tp, arg) -> (trans_operand arg, trans_typ tp)) typed_args, location, Sil.cf_default) in (new_sil_instr :: sil_instrs, locals) | _ -> raise (Unimplemented "Need to translate instruction to SIL.") @@ -106,8 +106,8 @@ let callees_of_function_def : LAst.function_def -> Procname.t list = function | Call (_, func_var, _) -> Some (procname_of_function_variable func_var) | _ -> None end in - list_flatten_options ( - list_map + IList.flatten_options ( + IList.map (fun annotated_instr -> callee_of_instruction (fst annotated_instr)) annotated_instrs) @@ -128,7 +128,7 @@ let trans_function_def (cfg : Cfg.cfg) (cg: Cg.t) (metadata : LAst.metadata_map) let (proc_attrs : ProcAttributes.t) = let open Sil in { (ProcAttributes.default proc_name Config.C_CPP) with - ProcAttributes.formals = list_map (fun (tp, name) -> (name, trans_typ tp)) params; + ProcAttributes.formals = IList.map (fun (tp, name) -> (name, trans_typ tp)) params; is_defined = true; (** is defined and not just declared *) loc = source_only_location (); locals = []; (* TODO *) @@ -151,18 +151,18 @@ let trans_function_def (cfg : Cfg.cfg) (cg: Cg.t) (metadata : LAst.metadata_map) | [] -> Cfg.Node.set_succs_exn start_node [exit_node] [exit_node] | nd :: nds -> Cfg.Node.set_succs_exn start_node [nd] [exit_node]; link_nodes nd nds in let (sil_instrs, locals) = trans_annotated_instructions cfg procdesc metadata annotated_instrs in - let nodes = list_map (node_of_sil_instr cfg procdesc) sil_instrs in + let nodes = IList.map (node_of_sil_instr cfg procdesc) sil_instrs in Cfg.Procdesc.set_start_node procdesc start_node; Cfg.Procdesc.set_exit_node procdesc exit_node; link_nodes start_node nodes; Cfg.Node.add_locals_ret_declaration start_node locals; Cg.add_defined_node cg proc_name; - list_iter (Cg.add_edge cg proc_name) (callees_of_function_def func_def) + IList.iter (Cg.add_edge cg proc_name) (callees_of_function_def func_def) let trans_program : LAst.program -> Cfg.cfg * Cg.t * Sil.tenv = function Program (func_defs, metadata) -> let cfg = Cfg.Node.create_cfg () in let cg = Cg.create () in let tenv = Sil.create_tenv () in - list_iter (trans_function_def cfg cg metadata) func_defs; + IList.iter (trans_function_def cfg cg metadata) func_defs; (cfg, cg, tenv) diff --git a/infer/src/scripts/checkCopyright.ml b/infer/src/scripts/checkCopyright.ml index b83657724..cac2a4fef 100644 --- a/infer/src/scripts/checkCopyright.ml +++ b/infer/src/scripts/checkCopyright.ml @@ -56,14 +56,14 @@ let rec find_copyright_line lines n = match lines with let find_comment_start_and_style lines_arr n = (* are we in a line comment? *) let cur_line_comment = try - Some (list_find (function + Some (IList.find (function | Line (s) when string_is_prefix s lines_arr.(n) -> true | _ -> false) comment_styles) with Not_found -> None in let is_start line = match cur_line_comment with | Some (Line (s)) -> if string_is_prefix s line then None else Some (Line (s)) | _ -> try - Some (list_find (function + Some (IList.find (function | Block(s, _, _) -> string_contains s line | _ -> false) comment_styles) with Not_found -> None in @@ -194,7 +194,7 @@ let com_style_of_lang = [ ] let file_should_have_copyright fname lines = - list_mem_assoc Filename.check_suffix fname com_style_of_lang + IList.mem_assoc Filename.check_suffix fname com_style_of_lang let get_filename_extension fname = try @@ -225,7 +225,7 @@ let check_copyright fname = match read_file fname with begin let year = 1900 + (Unix.localtime (Unix.time ())).Unix.tm_year in let ext = get_filename_extension fname in - let com_style = list_assoc string_equal ext com_style_of_lang in + let com_style = IList.assoc string_equal ext com_style_of_lang in let prefix = if com_style = comment_style_ocaml then " " else "" in let start = default_start_line_of_com_style com_style in output_diff fname (Array.of_list []) start (-1) (-1) 0 false year com_style prefix; @@ -270,5 +270,5 @@ let () = let add_file_to_check fname = to_check := fname :: !to_check in Arg.parse speclist add_file_to_check usage_msg; - list_iter check_copyright (list_rev !to_check); + IList.iter check_copyright (IList.rev !to_check); exit 0