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