pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Deprecate IList part 3.

Browse Source 
Reviewed By: jberdine

Differential Revision: D4597907

fbshipit-source-id: 4c888a5
master
Cristiano Calcagno 8 years ago committed by Facebook Github Bot
parent 14862d0aca
commit 9a06a859e2
74 changed files with 325 additions and 410 deletions
Show Stats Download Patch File Download Diff File

10
infer/src/IR/Cfg.re
Unescape View File

@ -58,7 +58,7 @@ let iter_all_nodes sorted::sorted=false f cfg => {
) )
cfg.proc_desc_table cfg.proc_desc_table
[] |> [] |>
IList.sort [%compare : (Procdesc.t, Procdesc.Node.t)] |> List.sort cmp::[%compare : (Procdesc.t, Procdesc.Node.t)] |>
List.iter f::(fun (d, n) => f d n) List.iter f::(fun (d, n) => f d n)
} }
}; };
@ -191,9 +191,9 @@ let inline_synthetic_method ret_id etl pdesc loc_call :option Sil.instr => {
Bool.equal (is_none ret_id) (is_none ret_id') && Bool.equal (is_none ret_id) (is_none ret_id') &&
Int.equal (List.length etl' + 1) (List.length etl) => Int.equal (List.length etl' + 1) (List.length etl) =>
let etl1 = let etl1 =
switch (IList.rev etl) { switch (List.rev etl) {
/* remove last element */ /* remove last element */
| [_, ...l] => IList.rev l | [_, ...l] => List.rev l
| [] => assert false | [] => assert false
}; };
let instr' = Sil.Call ret_id (Exp.Const (Const.Cfun pn)) etl1 loc_call cf; let instr' = Sil.Call ret_id (Exp.Const (Const.Cfun pn)) etl1 loc_call cf;
@ -434,7 +434,7 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => {
let rec convert_node node => { let rec convert_node node => {
let loc = Procdesc.Node.get_loc node let loc = Procdesc.Node.get_loc node
and kind = convert_node_kind (Procdesc.Node.get_kind node) and kind = convert_node_kind (Procdesc.Node.get_kind node)
and instrs = List.fold f::convert_instr init::[] (Procdesc.Node.get_instrs node) |> IList.rev; and instrs = List.fold f::convert_instr init::[] (Procdesc.Node.get_instrs node) |> List.rev;
Procdesc.create_node resolved_pdesc loc kind instrs Procdesc.create_node resolved_pdesc loc kind instrs
} }
and loop callee_nodes => and loop callee_nodes =>
@ -486,7 +486,7 @@ let specialize_types callee_pdesc resolved_pname args => {
args; args;
let resolved_attributes = { let resolved_attributes = {
...callee_attributes, ...callee_attributes,
formals: IList.rev resolved_params, formals: List.rev resolved_params,
proc_name: resolved_pname proc_name: resolved_pname
}; };
AttributesTable.store_attributes resolved_attributes; AttributesTable.store_attributes resolved_attributes;

2
infer/src/IR/Cg.re
Unescape View File

@ -190,7 +190,7 @@ let node_map_iter f g => {
let table = ref []; let table = ref [];
Procname.Hash.iter (fun node info => table := [(node, info), ...!table]) g.node_map; 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; let cmp (n1: Procname.t, _) (n2: Procname.t, _) => Procname.compare n1 n2;
List.iter f::(fun (n, info) => f n info) (IList.sort cmp !table) List.iter f::(fun (n, info) => f n info) (List.sort cmp::cmp !table)
}; };
let get_nodes (g: t) => { let get_nodes (g: t) => {

8
infer/src/IR/Io_infer.ml
Unescape View File

@ -19,9 +19,9 @@ module Html =
struct struct
(** Create a new html file *) (** Create a new html file *)
let create pk path = let create pk path =
let fname, dir_path = match IList.rev path with let fname, dir_path = match List.rev path with
| fname :: path_rev -> | fname :: path_rev ->
fname, IList.rev ((fname ^ ".html") :: path_rev) fname, List.rev ((fname ^ ".html") :: path_rev)
| [] -> | [] ->
raise (Failure "Html.create") in raise (Failure "Html.create") in
let fd = DB.Results_dir.create_file pk dir_path in let fd = DB.Results_dir.create_file pk dir_path in
@ -127,9 +127,9 @@ struct
(** Get the full html filename from a path *) (** Get the full html filename from a path *)
let get_full_fname source path = let get_full_fname source path =
let dir_path = match IList.rev path with let dir_path = match List.rev path with
| fname :: path_rev -> | fname :: path_rev ->
IList.rev ((fname ^ ".html") :: path_rev) List.rev ((fname ^ ".html") :: path_rev)
| [] -> | [] ->
raise (Failure "Html.open_out") in raise (Failure "Html.open_out") in
DB.Results_dir.path_to_filename (DB.Results_dir.Abs_source_dir source) dir_path DB.Results_dir.path_to_filename (DB.Results_dir.Abs_source_dir source) dir_path

6
infer/src/IR/Procdesc.re
Unescape View File

@ -166,7 +166,7 @@ let module Node = {
/** Get the source location of the last instruction in the node */ /** Get the source location of the last instruction in the node */
let get_last_loc n => let get_last_loc n =>
switch (IList.rev (get_instrs n)) { switch (List.rev (get_instrs n)) {
| [instr, ..._] => Sil.instr_get_loc instr | [instr, ..._] => Sil.instr_get_loc instr
| [] => n.loc | [] => n.loc
}; };
@ -395,7 +395,7 @@ let is_body_empty pdesc => List.is_empty (Node.get_succs (get_start_node pdesc))
let is_java_synchronized pdesc => pdesc.attributes.is_java_synchronized_method; let is_java_synchronized pdesc => pdesc.attributes.is_java_synchronized_method;
let iter_nodes f pdesc => List.iter f::f (IList.rev (get_nodes pdesc)); let iter_nodes f pdesc => List.iter f::f (List.rev (get_nodes pdesc));
let fold_calls f acc pdesc => { let fold_calls f acc pdesc => {
let do_node a node => let do_node a node =>
@ -415,7 +415,7 @@ let iter_instrs f pdesc => {
iter_nodes do_node pdesc iter_nodes do_node pdesc
}; };
let fold_nodes f acc pdesc => List.fold f::f init::acc (IList.rev (get_nodes pdesc)); let fold_nodes f acc pdesc => List.fold f::f init::acc (List.rev (get_nodes pdesc));
let fold_instrs f acc pdesc => { let fold_instrs f acc pdesc => {
let fold_node acc node => let fold_node acc node =>

6
infer/src/IR/Procname.re
Unescape View File

@ -343,10 +343,10 @@ let java_is_anonymous_inner_class =
let java_remove_hidden_inner_class_parameter = let java_remove_hidden_inner_class_parameter =
fun fun
| Java js => | Java js =>
switch (IList.rev js.parameters) { switch (List.rev js.parameters) {
| [(_, s), ...par'] => | [(_, s), ...par'] =>
if (is_anonymous_inner_class_name s) { if (is_anonymous_inner_class_name s) {
Some (Java {...js, parameters: IList.rev par'}) Some (Java {...js, parameters: List.rev par'})
} else { } else {
None None
} }
@ -397,7 +397,7 @@ let java_is_autogen_method =
let java_is_vararg = let java_is_vararg =
fun fun
| Java js => | Java js =>
switch (IList.rev js.parameters) { switch (List.rev js.parameters) {
| [(_, "java.lang.Object[]"), ..._] => true | [(_, "java.lang.Object[]"), ..._] => true
| _ => false | _ => false
} }

12
infer/src/IR/Sil.re
Unescape View File

@ -1256,7 +1256,7 @@ let atom_fpv =
| Aeq e1 e2 => exp_fpv e1 @ exp_fpv e2 | Aeq e1 e2 => exp_fpv e1 @ exp_fpv e2
| Aneq e1 e2 => exp_fpv e1 @ exp_fpv e2 | Aneq e1 e2 => exp_fpv e1 @ exp_fpv e2
| Apred _ es | Apred _ es
| Anpred _ es => List.fold f::(fun fpv e => IList.rev_append (exp_fpv e) fpv) init::[] es; | Anpred _ es => List.fold f::(fun fpv e => List.rev_append (exp_fpv e) fpv) init::[] es;
let rec strexp_fpv = let rec strexp_fpv =
fun fun
@ -1374,7 +1374,7 @@ let rec remove_duplicates_from_sorted special_equal =>
/** Convert a [fav] to a list of identifiers while preserving the order /** Convert a [fav] to a list of identifiers while preserving the order
that the identifiers were added to [fav]. */ that the identifiers were added to [fav]. */
let fav_to_list fav => IList.rev !fav; let fav_to_list fav => List.rev !fav;
/** Pretty print a fav. */ /** Pretty print a fav. */
@ -1657,7 +1657,7 @@ let sub_check_duplicated_ids sub => {
For all (id1, e1), (id2, e2) in the input list, For all (id1, e1), (id2, e2) in the input list,
if id1 = id2, then e1 = e2. */ if id1 = id2, then e1 = e2. */
let sub_of_list sub => { let sub_of_list sub => {
let sub' = IList.sort compare_ident_exp sub; let sub' = List.sort cmp::compare_ident_exp sub;
let sub'' = remove_duplicates_from_sorted equal_ident_exp sub'; let sub'' = remove_duplicates_from_sorted equal_ident_exp sub';
if (sub_check_duplicated_ids sub'') { if (sub_check_duplicated_ids sub'') {
assert false assert false
@ -1668,7 +1668,7 @@ let sub_of_list sub => {
/** like sub_of_list, but allow duplicate ids and only keep the first occurrence */ /** like sub_of_list, but allow duplicate ids and only keep the first occurrence */
let sub_of_list_duplicates sub => { let sub_of_list_duplicates sub => {
let sub' = IList.sort compare_ident_exp sub; let sub' = List.sort cmp::compare_ident_exp sub;
let rec remove_duplicate_ids = let rec remove_duplicate_ids =
fun fun
| [(id1, e1), (id2, e2), ...l] => | [(id1, e1), (id2, e2), ...l] =>
@ -1748,12 +1748,12 @@ let sub_filter_pair = List.filter;
/** [sub_range_partition filter sub] partitions [sub] according to /** [sub_range_partition filter sub] partitions [sub] according to
whether range expressions satisfy [filter]. */ whether range expressions satisfy [filter]. */
let sub_range_partition filter (sub: subst) => IList.partition (fun (_, e) => filter e) sub; let sub_range_partition filter (sub: subst) => List.partition_tf f::(fun (_, e) => filter e) sub;
/** [sub_domain_partition filter sub] partitions [sub] according to /** [sub_domain_partition filter sub] partitions [sub] according to
whether domain identifiers satisfy [filter]. */ whether domain identifiers satisfy [filter]. */
let sub_domain_partition filter (sub: subst) => IList.partition (fun (i, _) => filter i) sub; let sub_domain_partition filter (sub: subst) => List.partition_tf f::(fun (i, _) => filter i) sub;
/** Return the list of identifiers in the domain of the substitution. */ /** Return the list of identifiers in the domain of the substitution. */

2
infer/src/IR/StructTyp.re
Unescape View File

@ -95,7 +95,7 @@ let rec get_extensible_array_element_typ lookup::lookup (typ: Typ.t) =>
| Tstruct name => | Tstruct name =>
switch (lookup name) { switch (lookup name) {
| Some {fields} => | Some {fields} =>
switch (IList.last fields) { switch (List.last fields) {
| Some (_, fld_typ, _) => get_extensible_array_element_typ lookup::lookup fld_typ | Some (_, fld_typ, _) => get_extensible_array_element_typ lookup::lookup fld_typ
| None => None | None => None
} }

2
infer/src/IR/Subtype.re
Unescape View File

@ -205,7 +205,7 @@ let normalize_subtypes t_opt c1 c2 flag1 flag2 => {
| Some t => | Some t =>
switch t { switch t {
| Exact => Some (t, new_flag) | Exact => Some (t, new_flag)
| Subtypes l => Some (Subtypes (IList.sort Typename.compare l), new_flag) | Subtypes l => Some (Subtypes (List.sort cmp::Typename.compare l), new_flag)
} }
| None => None | None => None
} }

4
infer/src/backend/Attribute.ml
Unescape View File

@ -65,7 +65,7 @@ let get_all (prop: 'a Prop.t) =
let res = ref [] in let res = ref [] in
let do_atom a = if is_pred a then res := a :: !res in let do_atom a = if is_pred a then res := a :: !res in
List.iter ~f:do_atom prop.pi; List.iter ~f:do_atom prop.pi;
IList.rev !res List.rev !res
(** Get all the attributes of the prop *) (** Get all the attributes of the prop *)
let get_for_symb prop att = let get_for_symb prop att =
@ -263,7 +263,7 @@ let deallocate_stack_vars tenv (p: 'a Prop.t) pvars =
| Sil.Hpointsto (Exp.Lvar v, _, _) -> | Sil.Hpointsto (Exp.Lvar v, _, _) ->
List.exists ~f:(Pvar.equal v) pvars List.exists ~f:(Pvar.equal v) pvars
| _ -> false in | _ -> false in
let sigma_stack, sigma_other = IList.partition filter p.sigma in let sigma_stack, sigma_other = List.partition_tf ~f:filter p.sigma in
let fresh_address_vars = ref [] in (* fresh vars substituted for the address of stack vars *) let fresh_address_vars = ref [] in (* fresh vars substituted for the address of stack vars *)
let stack_vars_address_in_post = ref [] in (* stack vars whose address is still present *) let stack_vars_address_in_post = ref [] in (* stack vars whose address is still present *)
let exp_replace = List.map ~f:(function let exp_replace = List.map ~f:(function

6
infer/src/backend/BuiltinDefn.ml
Unescape View File

@ -116,7 +116,7 @@ let execute___set_array_length { Builtin.tenv; pdesc; prop_; path; ret_id; args;
let pname = Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop__ = check_arith_norm_exp tenv pname lexp prop_a in let n_lexp, prop__ = check_arith_norm_exp tenv pname lexp prop_a in
let n_len, prop = check_arith_norm_exp tenv pname len prop__ in let n_len, prop = check_arith_norm_exp tenv pname len prop__ in
let hpred, sigma' = IList.partition (function let hpred, sigma' = List.partition_tf ~f:(function
| Sil.Hpointsto(e, _, _) -> Exp.equal e n_lexp | Sil.Hpointsto(e, _, _) -> Exp.equal e n_lexp
| _ -> false) prop.Prop.sigma in | _ -> false) prop.Prop.sigma in
(match hpred with (match hpred with
@ -216,7 +216,7 @@ let execute___get_type_of { Builtin.pdesc; tenv; prop_; path; ret_id; args; }
let replace_ptsto_texp tenv prop root_e texp = let replace_ptsto_texp tenv prop root_e texp =
let process_sigma sigma = let process_sigma sigma =
let sigma1, sigma2 = let sigma1, sigma2 =
IList.partition (function List.partition_tf ~f:(function
| Sil.Hpointsto(e, _, _) -> Exp.equal e root_e | Sil.Hpointsto(e, _, _) -> Exp.equal e root_e
| _ -> false) sigma in | _ -> false) sigma in
match sigma1 with match sigma1 with
@ -705,7 +705,7 @@ let _execute_free_nonzero mk pdesc tenv instr prop lexp typ loc =
let prop_list = let prop_list =
List.fold ~f:(_execute_free tenv mk loc) ~init:[] List.fold ~f:(_execute_free tenv mk loc) ~init:[]
(Rearrange.rearrange pdesc tenv lexp typ prop loc) in (Rearrange.rearrange pdesc tenv lexp typ prop loc) in
IList.rev prop_list List.rev prop_list
end end
with Rearrange.ARRAY_ACCESS -> with Rearrange.ARRAY_ACCESS ->
if (Int.equal Config.array_level 0) then assert false if (Int.equal Config.array_level 0) then assert false

16
infer/src/backend/InferPrint.re
Unescape View File

@ -113,7 +113,7 @@ let loc_trace_to_jsonbug_record trace_list ekind =>
description: trace_item.Errlog.lt_description, description: trace_item.Errlog.lt_description,
node_tags: node_tags_to_records trace_item.Errlog.lt_node_tags node_tags: node_tags_to_records trace_item.Errlog.lt_node_tags
}; };
let record_list = IList.rev (List.rev_map f::trace_item_to_record trace_list); let record_list = List.rev (List.rev_map f::trace_item_to_record trace_list);
record_list record_list
}; };
@ -630,7 +630,7 @@ let module IssuesXml = {
node_tags_to_xml lt.Errlog.lt_node_tags node_tags_to_xml lt.Errlog.lt_node_tags
] ]
}; };
IList.rev (List.rev_map f::loc_to_xml ltr) List.rev (List.rev_map f::loc_to_xml ltr)
}; };
/** print issues from summary in xml */ /** print issues from summary in xml */
@ -772,7 +772,7 @@ let module Stats = {
res := [line, "", ...!res] res := [line, "", ...!res]
}; };
List.iter f::loc_to_string ltr; List.iter f::loc_to_string ltr;
IList.rev !res List.rev !res
}; };
let process_err_log error_filter linereader err_log stats => { let process_err_log error_filter linereader err_log stats => {
let found_errors = ref false; let found_errors = ref false;
@ -791,7 +791,7 @@ let module Stats = {
[F.asprintf "%t" pp1, F.asprintf "%t" pp2, F.asprintf "%t" pp3] [F.asprintf "%t" pp1, F.asprintf "%t" pp2, F.asprintf "%t" pp3]
}; };
let trace = loc_trace_to_string_list linereader 1 ltr; let trace = loc_trace_to_string_list linereader 1 ltr;
stats.saved_errors = IList.rev_append (error_strs @ trace @ [""]) stats.saved_errors stats.saved_errors = List.rev_append (error_strs @ trace @ [""]) stats.saved_errors
| Exceptions.Kwarning => stats.nwarnings = stats.nwarnings + 1 | Exceptions.Kwarning => stats.nwarnings = stats.nwarnings + 1
| Exceptions.Kinfo => stats.ninfos = stats.ninfos + 1 | Exceptions.Kinfo => stats.ninfos = stats.ninfos + 1
| Exceptions.Kadvice => stats.nadvice = stats.nadvice + 1 | Exceptions.Kadvice => stats.nadvice = stats.nadvice + 1
@ -845,7 +845,7 @@ let module Stats = {
F.fprintf fmt "Infos: %d@\n" stats.ninfos; F.fprintf fmt "Infos: %d@\n" stats.ninfos;
F.fprintf fmt "@\n -------------------@\n"; F.fprintf fmt "@\n -------------------@\n";
F.fprintf fmt "@\nDetailed Errors@\n@\n"; F.fprintf fmt "@\nDetailed Errors@\n@\n";
List.iter f::(fun s => F.fprintf fmt "%s@\n" s) (IList.rev stats.saved_errors) List.iter f::(fun s => F.fprintf fmt "%s@\n" s) (List.rev stats.saved_errors)
}; };
}; };
@ -1124,7 +1124,7 @@ let pp_json_report_by_report_kind formats_by_report_kind fname =>
}; };
let sorted_report = { let sorted_report = {
let report = Jsonbug_j.report_of_string (String.concat sep::"\n" report_lines); let report = Jsonbug_j.report_of_string (String.concat sep::"\n" report_lines);
IList.sort tests_jsonbug_compare report List.sort cmp::tests_jsonbug_compare report
}; };
let pp_report_by_report_kind (report_kind, format_list) => let pp_report_by_report_kind (report_kind, format_list) =>
switch (report_kind, format_list) { switch (report_kind, format_list) {
@ -1229,12 +1229,12 @@ let module AnalysisResults = {
summ2.Specs.attributes.ProcAttributes.loc.Location.line summ2.Specs.attributes.ProcAttributes.loc.Location.line
} }
}; };
IList.sort summ_cmp !summaries List.sort cmp::summ_cmp !summaries
}; };
/** Create an iterator which loads spec files one at a time */ /** Create an iterator which loads spec files one at a time */
let iterator_of_spec_files () => { let iterator_of_spec_files () => {
let sorted_spec_files = IList.sort String.compare (spec_files_from_cmdline ()); let sorted_spec_files = List.sort cmp::String.compare (spec_files_from_cmdline ());
let do_spec f fname => let do_spec f fname =>
switch (Specs.load_summary (DB.filename_from_string fname)) { switch (Specs.load_summary (DB.filename_from_string fname)) {
| None => | None =>

2
infer/src/backend/PerfStats.ml
Unescape View File

@ -73,7 +73,7 @@ let from_json json =
} }
let aggregate s = let aggregate s =
let mk_stats f = StatisticsToolbox.compute_statistics (List.map ~f:f s) in let mk_stats f = StatisticsToolbox.compute_statistics (List.map ~f s) in
let aggr_rtime = mk_stats (fun stats -> stats.rtime) in let aggr_rtime = mk_stats (fun stats -> stats.rtime) in
let aggr_utime = mk_stats (fun stats -> stats.utime) in let aggr_utime = mk_stats (fun stats -> stats.utime) in
let aggr_stime = mk_stats (fun stats -> stats.stime) in let aggr_stime = mk_stats (fun stats -> stats.stime) in

28
infer/src/backend/abs.ml
Unescape View File

@ -242,7 +242,7 @@ let mk_rule_ptspts_dll tenv impl_ok1 impl_ok2 para =
let ids_shared = let ids_shared =
let svars = para.Sil.svars_dll in let svars = para.Sil.svars_dll in
let f _ = Ident.create_fresh Ident.kprimed in let f _ = Ident.create_fresh Ident.kprimed in
List.map ~f:f svars in List.map ~f svars in
let exp_iF = Exp.Var id_iF in let exp_iF = Exp.Var id_iF in
let exp_iF' = Exp.Var id_iF' in let exp_iF' = Exp.Var id_iF' in
let exp_oB = Exp.Var id_oB in let exp_oB = Exp.Var id_oB in
@ -290,7 +290,7 @@ let mk_rule_ptsdll_dll tenv k2 impl_ok1 impl_ok2 para =
let ids_shared = let ids_shared =
let svars = para.Sil.svars_dll in let svars = para.Sil.svars_dll in
let f _ = Ident.create_fresh Ident.kprimed in let f _ = Ident.create_fresh Ident.kprimed in
List.map ~f:f svars in List.map ~f svars in
let exp_iF = Exp.Var id_iF in let exp_iF = Exp.Var id_iF in
let exp_iF' = Exp.Var id_iF' in let exp_iF' = Exp.Var id_iF' in
let exp_oB = Exp.Var id_oB in let exp_oB = Exp.Var id_oB in
@ -326,7 +326,7 @@ let mk_rule_dllpts_dll tenv k1 impl_ok1 impl_ok2 para =
let ids_shared = let ids_shared =
let svars = para.Sil.svars_dll in let svars = para.Sil.svars_dll in
let f _ = Ident.create_fresh Ident.kprimed in let f _ = Ident.create_fresh Ident.kprimed in
List.map ~f:f svars in List.map ~f svars in
let exp_iF = Exp.Var id_iF in let exp_iF = Exp.Var id_iF in
let exp_iF' = Exp.Var id_iF' in let exp_iF' = Exp.Var id_iF' in
let exp_oB = Exp.Var id_oB in let exp_oB = Exp.Var id_oB in
@ -360,7 +360,7 @@ let mk_rule_dlldll_dll tenv k1 k2 impl_ok1 impl_ok2 para =
let ids_shared = let ids_shared =
let svars = para.Sil.svars_dll in let svars = para.Sil.svars_dll in
let f _ = Ident.create_fresh Ident.kprimed in let f _ = Ident.create_fresh Ident.kprimed in
List.map ~f:f svars in List.map ~f svars in
let exp_iF = Exp.Var id_iF in let exp_iF = Exp.Var id_iF in
let exp_iF' = Exp.Var id_iF' in let exp_iF' = Exp.Var id_iF' in
let exp_oB = Exp.Var id_oB in let exp_oB = Exp.Var id_oB in
@ -488,9 +488,9 @@ let discover_para_candidates tenv p =
get_edges_strexp rec_flds root se; get_edges_strexp rec_flds root se;
get_edges_sigma sigma_rest in get_edges_sigma sigma_rest in
let rec find_all_consecutive_edges found edges_seen = function let rec find_all_consecutive_edges found edges_seen = function
| [] -> IList.rev found | [] -> List.rev found
| (e1, e2) :: edges_notseen -> | (e1, e2) :: edges_notseen ->
let edges_others = (IList.rev edges_seen) @ edges_notseen in let edges_others = List.rev_append edges_seen edges_notseen in
let edges_matched = List.filter ~f:(fun (e1', _) -> Exp.equal e2 e1') edges_others in let edges_matched = List.filter ~f:(fun (e1', _) -> Exp.equal e2 e1') edges_others in
let new_found = let new_found =
let f found_acc (_, e3) = (e1, e2, e3) :: found_acc in let f found_acc (_, e3) = (e1, e2, e3) :: found_acc in
@ -509,12 +509,12 @@ let discover_para_dll_candidates tenv p =
match se with match se with
| Sil.Eexp _ | Sil.Earray _ -> () | Sil.Eexp _ | Sil.Earray _ -> ()
| Sil.Estruct (fsel, _) -> | Sil.Estruct (fsel, _) ->
let fsel' = List.filter ~f:(fun (fld, _) -> is_rec_fld fld) fsel in let fsel' = List.rev_filter ~f:(fun (fld, _) -> is_rec_fld fld) fsel in
let convert_to_exp acc (_, se) = let convert_to_exp acc (_, se) =
match se with match se with
| Sil.Eexp (e, _) -> e:: acc | Sil.Eexp (e, _) -> e:: acc
| _ -> assert false in | _ -> assert false in
let links = IList.rev (List.fold ~f:convert_to_exp ~init:[] fsel') in let links = List.fold ~f:convert_to_exp ~init:[] fsel' in
let rec iter_pairs = function let rec iter_pairs = function
| [] -> () | [] -> ()
| x:: l -> (List.iter ~f:(fun y -> add_edge (root, x, y)) l; iter_pairs l) in | x:: l -> (List.iter ~f:(fun y -> add_edge (root, x, y)) l; iter_pairs l) in
@ -528,9 +528,9 @@ let discover_para_dll_candidates tenv p =
get_edges_strexp rec_flds root se; get_edges_strexp rec_flds root se;
get_edges_sigma sigma_rest in get_edges_sigma sigma_rest in
let rec find_all_consecutive_edges found edges_seen = function let rec find_all_consecutive_edges found edges_seen = function
| [] -> IList.rev found | [] -> List.rev found
| (iF, blink, flink) :: edges_notseen -> | (iF, blink, flink) :: edges_notseen ->
let edges_others = (IList.rev edges_seen) @ edges_notseen in let edges_others = List.rev_append edges_seen edges_notseen in
let edges_matched = List.filter ~f:(fun (e1', _, _) -> Exp.equal flink e1') edges_others in let edges_matched = List.filter ~f:(fun (e1', _, _) -> Exp.equal flink e1') edges_others in
let new_found = let new_found =
let f found_acc (_, _, flink2) = (iF, blink, flink, flink2) :: found_acc in let f found_acc (_, _, flink2) = (iF, blink, flink, flink2) :: found_acc in
@ -635,7 +635,7 @@ let eqs_solve ids_in eqs_in =
let sigma_special_cases_eqs sigma = let sigma_special_cases_eqs sigma =
let rec f ids_acc eqs_acc sigma_acc = function let rec f ids_acc eqs_acc sigma_acc = function
| [] -> | [] ->
[(IList.rev ids_acc, IList.rev eqs_acc, IList.rev sigma_acc)] [(List.rev ids_acc, List.rev eqs_acc, List.rev sigma_acc)]
| Sil.Hpointsto _ as hpred :: sigma_rest -> | Sil.Hpointsto _ as hpred :: sigma_rest ->
f ids_acc eqs_acc (hpred:: sigma_acc) sigma_rest f ids_acc eqs_acc (hpred:: sigma_acc) sigma_rest
| Sil.Hlseg(_, para, e1, e2, es) as hpred :: sigma_rest -> | Sil.Hlseg(_, para, e1, e2, es) as hpred :: sigma_rest ->
@ -668,7 +668,7 @@ let sigma_special_cases ids sigma : (Ident.t list * Sil.hpred list) list =
| Some (ids_res, sub) -> | Some (ids_res, sub) ->
(ids_res, List.map ~f:(Sil.hpred_sub sub) sigma_cur) :: acc in (ids_res, List.map ~f:(Sil.hpred_sub sub) sigma_cur) :: acc in
List.fold ~f ~init:[] special_cases_eqs in List.fold ~f ~init:[] special_cases_eqs in
IList.rev special_cases_rev List.rev special_cases_rev
let hpara_special_cases hpara : Sil.hpara list = let hpara_special_cases hpara : Sil.hpara list =
let update_para (evars', body') = { hpara with Sil.evars = evars'; Sil.body = body'} in let update_para (evars', body') = { hpara with Sil.evars = evars'; Sil.body = body'} in
@ -780,7 +780,7 @@ let abstract_pure_part tenv p ~(from_abstract_footprint: bool) =
| Sil.Aeq _ | Aneq _ | Apred _ | Anpred _ -> pi | Sil.Aeq _ | Aneq _ | Apred _ | Anpred _ -> pi
) )
~init:[] pi_filtered in ~init:[] pi_filtered in
IList.rev new_pure in List.rev new_pure in
let new_pure = do_pure (Prop.get_pure p) in let new_pure = do_pure (Prop.get_pure p) in
let eprop' = Prop.set p ~pi:new_pure ~sub:Sil.sub_empty in let eprop' = Prop.set p ~pi:new_pure ~sub:Sil.sub_empty in
@ -1072,7 +1072,7 @@ let check_junk ?original_prop pname tenv prop =
hpred_is_loop || List.exists ~f:predicate entries in hpred_is_loop || List.exists ~f:predicate entries in
let rec remove_junk_recursive sigma_done sigma_todo = let rec remove_junk_recursive sigma_done sigma_todo =
match sigma_todo with match sigma_todo with
| [] -> IList.rev sigma_done | [] -> List.rev sigma_done
| hpred :: sigma_todo' -> | hpred :: sigma_todo' ->
let entries = hpred_entries hpred in let entries = hpred_entries hpred in
if should_remove_hpred entries then if should_remove_hpred entries then

8
infer/src/backend/absarray.ml
Unescape View File

@ -159,7 +159,7 @@ end = struct
let find tenv (sigma : sigma) (pred : strexp_data -> bool) : t list = let find tenv (sigma : sigma) (pred : strexp_data -> bool) : t list =
let found = ref [] in let found = ref [] in
let rec find_offset_sexp sigma_other hpred root offs se (typ: Typ.t) = let rec find_offset_sexp sigma_other hpred root offs se (typ: Typ.t) =
let offs' = IList.rev offs in let offs' = List.rev offs in
let path = (root, offs') in let path = (root, offs') in
if pred (path, se, typ) then found := (sigma, hpred, offs') :: !found if pred (path, se, typ) then found := (sigma, hpred, offs') :: !found
else begin else begin
@ -429,7 +429,7 @@ let keep_only_indices tenv
match se with match se with
| Sil.Earray (len, esel, inst) -> | Sil.Earray (len, esel, inst) ->
let esel', esel_leftover' = let esel', esel_leftover' =
IList.partition (fun (e, _) -> List.exists ~f:(Exp.equal e) indices) esel in List.partition_tf ~f:(fun (e, _) -> List.exists ~f:(Exp.equal e) indices) esel in
if List.is_empty esel_leftover' then (sigma, false) if List.is_empty esel_leftover' then (sigma, false)
else begin else begin
let se' = Sil.Earray (len, esel', inst) in let se' = Sil.Earray (len, esel', inst) in
@ -479,7 +479,7 @@ let strexp_do_abstract tenv
prune_and_blur Sil.d_exp_list (keep_only_indices tenv) (blur_array_indices tenv) in prune_and_blur Sil.d_exp_list (keep_only_indices tenv) (blur_array_indices tenv) in
let partition_abstract should_keep abstract ksel default_keys = let partition_abstract should_keep abstract ksel default_keys =
let keep_ksel, remove_ksel = IList.partition should_keep ksel in let keep_ksel, remove_ksel = List.partition_tf ~f:should_keep ksel in
let keep_keys, _, _ = let keep_keys, _, _ =
List.map ~f:fst keep_ksel, List.map ~f:fst remove_ksel, List.map ~f:fst ksel in List.map ~f:fst keep_ksel, List.map ~f:fst remove_ksel, List.map ~f:fst ksel in
let keep_keys' = if List.is_empty keep_keys then default_keys else keep_keys in let keep_keys' = if List.is_empty keep_keys then default_keys else keep_keys in
@ -491,7 +491,7 @@ let strexp_do_abstract tenv
let default_indices = let default_indices =
match List.map ~f:fst esel with match List.map ~f:fst esel with
| [] -> [] | [] -> []
| indices -> [List.hd_exn (IList.rev indices)] (* keep last key at least *) in | indices -> [List.last_exn indices] (* keep last key at least *) in
partition_abstract should_keep abstract esel default_indices in partition_abstract should_keep abstract esel default_indices in
let do_footprint () = let do_footprint () =
match se_in with match se_in with

2
infer/src/backend/builtin.ml
Unescape View File

@ -55,7 +55,7 @@ let register proc_name sym_exe_fun : registered =
let pp_registered fmt () = let pp_registered fmt () =
let builtin_names = ref [] in let builtin_names = ref [] in
Procname.Hash.iter (fun name _ -> builtin_names := name :: !builtin_names) builtin_functions; Procname.Hash.iter (fun name _ -> builtin_names := name :: !builtin_names) builtin_functions;
builtin_names := IList.sort Procname.compare !builtin_names; builtin_names := List.sort ~cmp:Procname.compare !builtin_names;
let pp pname = Format.fprintf fmt "%a@\n" Procname.pp pname in let pp pname = Format.fprintf fmt "%a@\n" Procname.pp pname in
Format.fprintf fmt "Registered builtins:@\n @["; Format.fprintf fmt "Registered builtins:@\n @[";
List.iter ~f:pp !builtin_names; List.iter ~f:pp !builtin_names;

46
infer/src/backend/dom.ml
Unescape View File

@ -35,15 +35,15 @@ let equal_sigma sigma1 sigma2 =
| hpred1:: sigma1_rest', hpred2:: sigma2_rest' -> | hpred1:: sigma1_rest', hpred2:: sigma2_rest' ->
if Sil.equal_hpred hpred1 hpred2 then f sigma1_rest' sigma2_rest' if Sil.equal_hpred hpred1 hpred2 then f sigma1_rest' sigma2_rest'
else (L.d_strln "failure reason 2"; raise Sil.JoinFail) in else (L.d_strln "failure reason 2"; raise Sil.JoinFail) in
let sigma1_sorted = IList.sort Sil.compare_hpred sigma1 in let sigma1_sorted = List.sort ~cmp:Sil.compare_hpred sigma1 in
let sigma2_sorted = IList.sort Sil.compare_hpred sigma2 in let sigma2_sorted = List.sort ~cmp:Sil.compare_hpred sigma2 in
f sigma1_sorted sigma2_sorted f sigma1_sorted sigma2_sorted
let sigma_get_start_lexps_sort sigma = let sigma_get_start_lexps_sort sigma =
let exp_compare_neg e1 e2 = - (Exp.compare e1 e2) in let exp_compare_neg e1 e2 = - (Exp.compare e1 e2) in
let filter e = Sil.fav_for_all (Sil.exp_fav e) Ident.is_normal 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 let lexps = Sil.hpred_list_get_lexps filter sigma in
IList.sort exp_compare_neg lexps List.sort ~cmp:exp_compare_neg lexps
(** {2 Utility functions for side} *) (** {2 Utility functions for side} *)
@ -172,7 +172,7 @@ end = struct
let check side es = let check side es =
let f = function Exp.Var id -> can_rename id | _ -> false in let f = function Exp.Var id -> can_rename id | _ -> false in
let vars, nonvars = IList.partition f es in let vars, nonvars = List.partition_tf ~f es in
let tbl, const_tbl = let tbl, const_tbl =
match side with match side with
| Lhs -> equiv_tbl1, const_tbl1 | Lhs -> equiv_tbl1, const_tbl1
@ -469,7 +469,7 @@ end = struct
let minus2_to_2 = List.map ~f:IntLit.of_int [-2; -1; 0; 1; 2] let minus2_to_2 = List.map ~f:IntLit.of_int [-2; -1; 0; 1; 2]
let get_induced_pi tenv () = let get_induced_pi tenv () =
let t_sorted = IList.sort entry_compare !t in let t_sorted = List.sort ~cmp:entry_compare !t in
let add_and_chk_eq e1 e1' n = let add_and_chk_eq e1 e1' n =
match e1, e1' with match e1, e1' with
@ -599,8 +599,8 @@ end = struct
res := v'::!res res := v'::!res
| _ -> () in | _ -> () in
begin begin
List.iter ~f:f !tbl; List.iter ~f !tbl;
IList.rev !res List.rev !res
end end
(* Return the triple whose side is [e], if it exists unique *) (* Return the triple whose side is [e], if it exists unique *)
@ -629,7 +629,7 @@ end = struct
~f:(function (e1, e2, Exp.Var i) -> (i, select side e1 e2) | _ -> assert false) ~f:(function (e1, e2, Exp.Var i) -> (i, select side e1 e2) | _ -> assert false)
renaming_restricted in renaming_restricted in
let sub_list_side_sorted = let sub_list_side_sorted =
IList.sort (fun (_, e) (_, e') -> Exp.compare e e') sub_list_side in List.sort ~cmp:(fun (_, e) (_, e') -> Exp.compare e e') sub_list_side in
let rec find_duplicates = let rec find_duplicates =
function function
| (_, e):: ((_, e'):: _ as t) -> Exp.equal e e' || find_duplicates t | (_, e):: ((_, e'):: _ as t) -> Exp.equal e e' || find_duplicates t
@ -652,7 +652,7 @@ end = struct
List.map ~f:project renaming_restricted in List.map ~f:project renaming_restricted in
let sub_list_sorted = let sub_list_sorted =
let compare (i, _) (i', _) = Ident.compare i i' in let compare (i, _) (i', _) = Ident.compare i i' in
IList.sort compare sub_list in List.sort ~cmp:compare sub_list in
let rec find_duplicates = function let rec find_duplicates = function
| (i, _):: ((i', _):: _ as t) -> Ident.equal i i' || find_duplicates t | (i, _):: ((i', _):: _ as t) -> Ident.equal i i' || find_duplicates t
| _ -> false in | _ -> false in
@ -1055,12 +1055,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 = let rec f_fld_se_list inst mode acc fld_se_list1 fld_se_list2 =
match fld_se_list1, fld_se_list2 with match fld_se_list1, fld_se_list2 with
| [], [] -> Sil.Estruct (IList.rev acc, inst) | [], [] -> Sil.Estruct (List.rev acc, inst)
| [], _ | _, [] -> | [], _ | _, [] ->
begin begin
match mode with match mode with
| JoinState.Pre -> (L.d_strln "failure reason 42"; raise Sil.JoinFail) | JoinState.Pre -> (L.d_strln "failure reason 42"; raise Sil.JoinFail)
| JoinState.Post -> Sil.Estruct (IList.rev acc, inst) | JoinState.Post -> Sil.Estruct (List.rev acc, inst)
end end
| (fld1, se1):: fld_se_list1', (fld2, se2):: fld_se_list2' -> | (fld1, se1):: fld_se_list1', (fld2, se2):: fld_se_list2' ->
let comparison = Ident.compare_fieldname fld1 fld2 in let comparison = Ident.compare_fieldname fld1 fld2 in
@ -1085,13 +1085,13 @@ let rec strexp_partial_join mode (strexp1: Sil.strexp) (strexp2: Sil.strexp) : S
let rec f_idx_se_list inst len idx_se_list_acc idx_se_list1 idx_se_list2 = let rec f_idx_se_list inst len idx_se_list_acc idx_se_list1 idx_se_list2 =
match idx_se_list1, idx_se_list2 with match idx_se_list1, idx_se_list2 with
| [], [] -> Sil.Earray (len, IList.rev idx_se_list_acc, inst) | [], [] -> Sil.Earray (len, List.rev idx_se_list_acc, inst)
| [], _ | _, [] -> | [], _ | _, [] ->
begin begin
match mode with match mode with
| JoinState.Pre -> (L.d_strln "failure reason 44"; raise Sil.JoinFail) | JoinState.Pre -> (L.d_strln "failure reason 44"; raise Sil.JoinFail)
| JoinState.Post -> | JoinState.Post ->
Sil.Earray (len, IList.rev idx_se_list_acc, inst) Sil.Earray (len, List.rev idx_se_list_acc, inst)
end end
| (idx1, se1):: idx_se_list1', (idx2, se2):: idx_se_list2' -> | (idx1, se1):: idx_se_list1', (idx2, se2):: idx_se_list2' ->
let idx = exp_partial_join idx1 idx2 in let idx = exp_partial_join idx1 idx2 in
@ -1116,12 +1116,12 @@ let rec strexp_partial_meet (strexp1: Sil.strexp) (strexp2: Sil.strexp) : Sil.st
let construct side rev_list ref_list = let construct side rev_list ref_list =
let construct_offset_se (off, se) = (off, strexp_construct_fresh side se) in let construct_offset_se (off, se) = (off, strexp_construct_fresh side se) in
let acc = List.map ~f:construct_offset_se ref_list in let acc = List.map ~f:construct_offset_se ref_list in
IList.rev_append rev_list acc in List.rev_append rev_list acc in
let rec f_fld_se_list inst acc fld_se_list1 fld_se_list2 = let rec f_fld_se_list inst acc fld_se_list1 fld_se_list2 =
match fld_se_list1, fld_se_list2 with match fld_se_list1, fld_se_list2 with
| [], [] -> | [], [] ->
Sil.Estruct (IList.rev acc, inst) Sil.Estruct (List.rev acc, inst)
| [], _ -> | [], _ ->
Sil.Estruct (construct Rhs acc fld_se_list2, inst) Sil.Estruct (construct Rhs acc fld_se_list2, inst)
| _, [] -> | _, [] ->
@ -1144,7 +1144,7 @@ let rec strexp_partial_meet (strexp1: Sil.strexp) (strexp2: Sil.strexp) : Sil.st
let rec f_idx_se_list inst len acc idx_se_list1 idx_se_list2 = let rec f_idx_se_list inst len acc idx_se_list1 idx_se_list2 =
match idx_se_list1, idx_se_list2 with match idx_se_list1, idx_se_list2 with
| [],[] -> | [],[] ->
Sil.Earray (len, IList.rev acc, inst) Sil.Earray (len, List.rev acc, inst)
| [], _ -> | [], _ ->
Sil.Earray (len, construct Rhs acc idx_se_list2, inst) Sil.Earray (len, construct Rhs acc idx_se_list2, inst)
| _, [] -> | _, [] ->
@ -1285,7 +1285,7 @@ let find_hpred_by_address tenv (e: Exp.t) (sigma: Prop.sigma) : Sil.hpred option
| [] -> None, sigma | [] -> None, sigma
| hpred:: sigma -> | hpred:: sigma ->
if contains_e hpred then if contains_e hpred then
Some hpred, (IList.rev sigma_acc) @ sigma Some hpred, List.rev_append sigma_acc sigma
else else
f (hpred:: sigma_acc) sigma in f (hpred:: sigma_acc) sigma in
f [] sigma f [] sigma
@ -1578,8 +1578,8 @@ let pi_partial_join tenv mode
let bounds = let bounds =
let bounds1 = get_array_len ep1 in let bounds1 = get_array_len ep1 in
let bounds2 = get_array_len ep2 in let bounds2 = get_array_len ep2 in
let bounds_sorted = IList.sort IntLit.compare_value (bounds1@bounds2) in let bounds_sorted = List.sort ~cmp:IntLit.compare_value (bounds1@bounds2) in
IList.rev (IList.remove_duplicates IntLit.compare_value bounds_sorted) in List.rev (List.remove_consecutive_duplicates ~equal:IntLit.eq bounds_sorted) in
let widening_atom a = let widening_atom a =
(* widening heuristic for upper bound: take the length of some array, -2 and -1 *) (* widening heuristic for upper bound: take the length of some array, -2 and -1 *)
match Prop.atom_exp_le_const a, bounds with match Prop.atom_exp_le_const a, bounds with
@ -1723,7 +1723,7 @@ let eprop_partial_meet tenv (ep1: 'a Prop.t) (ep2: 'b Prop.t) : 'c Prop.t =
let sub2 = ep2.Prop.sub in let sub2 = ep2.Prop.sub in
let range1 = Sil.sub_range sub1 in let range1 = Sil.sub_range sub1 in
let f e = Sil.fav_for_all (Sil.exp_fav e) Ident.is_normal in let f e = Sil.fav_for_all (Sil.exp_fav e) Ident.is_normal in
Sil.equal_subst sub1 sub2 && List.for_all ~f:f range1 in Sil.equal_subst sub1 sub2 && List.for_all ~f range1 in
if not (sub_check ()) then if not (sub_check ()) then
(L.d_strln "sub_check() failed"; raise Sil.JoinFail) (L.d_strln "sub_check() failed"; raise Sil.JoinFail)
@ -1870,7 +1870,7 @@ let eprop_partial_join tenv mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed P
let list_reduce name dd f list = let list_reduce name dd f list =
let rec element_list_reduce acc (x, p1) = function let rec element_list_reduce acc (x, p1) = function
| [] -> ((x, p1), IList.rev acc) | [] -> ((x, p1), List.rev acc)
| (y, p2):: ys -> begin | (y, p2):: ys -> begin
L.d_strln ("COMBINE[" ^ name ^ "] ...."); L.d_strln ("COMBINE[" ^ name ^ "] ....");
L.d_str "ENTRY1: "; L.d_ln (); dd x; L.d_ln (); L.d_str "ENTRY1: "; L.d_ln (); dd x; L.d_ln ();
@ -1886,7 +1886,7 @@ let list_reduce name dd f list =
element_list_reduce acc (x', p1) ys element_list_reduce acc (x', p1) ys
end in end in
let rec reduce acc = function let rec reduce acc = function
| [] -> IList.rev acc | [] -> List.rev acc
| x:: xs -> | x:: xs ->
let (x', xs') = element_list_reduce [] x xs in let (x', xs') = element_list_reduce [] x xs in
reduce (x':: acc) xs' in reduce (x':: acc) xs' in
@ -1954,7 +1954,7 @@ let pathset_join
let ppalist1 = pset_to_plist pset1 in let ppalist1 = pset_to_plist pset1 in
let ppalist2 = pset_to_plist pset2 in let ppalist2 = pset_to_plist pset2 in
let rec join_proppath_plist ppalist2_acc ((p2, pa2) as ppa2) = function let rec join_proppath_plist ppalist2_acc ((p2, pa2) as ppa2) = function
| [] -> (ppa2, IList.rev ppalist2_acc) | [] -> (ppa2, List.rev ppalist2_acc)
| ((p2', pa2') as ppa2') :: ppalist2_rest -> begin | ((p2', pa2') as ppa2') :: ppalist2_rest -> begin
L.d_strln ".... JOIN ...."; L.d_strln ".... JOIN ....";
L.d_strln "JOIN SYM HEAP1: "; Prop.d_prop p2; L.d_ln (); L.d_strln "JOIN SYM HEAP1: "; Prop.d_prop p2; L.d_ln ();

6
infer/src/backend/dotty.ml
Unescape View File

@ -335,7 +335,7 @@ let set_exps_neq_zero pi =
exps_neq_zero := e :: !exps_neq_zero exps_neq_zero := e :: !exps_neq_zero
| _ -> () in | _ -> () in
exps_neq_zero := []; exps_neq_zero := [];
List.iter ~f:f pi List.iter ~f pi
let box_dangling e = let box_dangling e =
let entry_e = List.filter ~f:(fun b -> match b with let entry_e = List.filter ~f:(fun b -> match b with
@ -1316,10 +1316,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)] [] Io_infer.Xml.create_tree "cell" [("content-value", exp_to_xml_string e)] []
| Sil.Estruct (fel, _) -> | 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 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:f fel) Io_infer.Xml.create_tree "struct" [] (List.map ~f fel)
| Sil.Earray (len, nel, _) -> | Sil.Earray (len, nel, _) ->
let f (e, se) = Io_infer.Xml.create_tree "array-element" [("index", exp_to_xml_string e)] [pointsto_contents_to_xml se] in 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 len)] (List.map ~f:f nel) Io_infer.Xml.create_tree "array" [("size", exp_to_xml_string len)] (List.map ~f nel)
(* Convert an atom to xml in a light version. Namely, the expressions are not fully blown-up into *) (* Convert an atom to xml in a light version. Namely, the expressions are not fully blown-up into *)
(* xml tree but visualized as strings *) (* xml tree but visualized as strings *)

10
infer/src/backend/errdesc.ml
Unescape View File

@ -78,7 +78,7 @@ let find_in_node_or_preds start_node f_node_instr =
begin begin
visited := Procdesc.NodeSet.add node !visited; visited := Procdesc.NodeSet.add node !visited;
let instrs = Procdesc.Node.get_instrs node in let instrs = Procdesc.Node.get_instrs node in
match List.find_map ~f:(f_node_instr node) (IList.rev instrs) with match List.find_map ~f:(f_node_instr node) (List.rev instrs) with
| Some res -> Some res | Some res -> Some res
| None -> List.find_map ~f:find (Procdesc.Node.get_preds node) | None -> List.find_map ~f:find (Procdesc.Node.get_preds node)
end in end in
@ -172,7 +172,7 @@ let find_struct_by_value_assignment node pvar =
let find_instr node = function let find_instr node = function
| Sil.Call (_, Const (Cfun pname), args, loc, cf) -> | Sil.Call (_, Const (Cfun pname), args, loc, cf) ->
begin begin
match IList.last args with match List.last args with
| Some (Exp.Lvar last_arg, _) when Pvar.equal pvar last_arg -> | Some (Exp.Lvar last_arg, _) when Pvar.equal pvar last_arg ->
Some (node, pname, loc, cf) Some (node, pname, loc, cf)
| _ -> | _ ->
@ -575,7 +575,7 @@ let vpath_find tenv prop _exp : DExp.t option * Typ.t option =
let rec find sigma_acc sigma_todo exp = let rec find sigma_acc sigma_todo exp =
let do_fse res sigma_acc' sigma_todo' lexp texp (f, se) = match se with let do_fse res sigma_acc' sigma_todo' lexp texp (f, se) = match se with
| Sil.Eexp (e, _) when Exp.equal exp e -> | Sil.Eexp (e, _) when Exp.equal exp e ->
let sigma' = (IList.rev_append sigma_acc' sigma_todo') in let sigma' = (List.rev_append sigma_acc' sigma_todo') in
(match lexp with (match lexp with
| Exp.Lvar pv -> | Exp.Lvar pv ->
let typo = match texp with let typo = match texp with
@ -601,7 +601,7 @@ let vpath_find tenv prop _exp : DExp.t option * Typ.t option =
| _ -> () in | _ -> () in
let do_sexp sigma_acc' sigma_todo' lexp sexp texp = match sexp with let do_sexp sigma_acc' sigma_todo' lexp sexp texp = match sexp with
| Sil.Eexp (e, _) when Exp.equal exp e -> | Sil.Eexp (e, _) when Exp.equal exp e ->
let sigma' = (IList.rev_append sigma_acc' sigma_todo') in let sigma' = (List.rev_append sigma_acc' sigma_todo') in
(match lexp with (match lexp with
| Exp.Lvar pv when not (Pvar.is_frontend_tmp pv) -> | Exp.Lvar pv when not (Pvar.is_frontend_tmp pv) ->
let typo = match texp with let typo = match texp with
@ -981,7 +981,7 @@ let find_with_exp prop exp =
if not (Pvar.is_abduced pv) && not (Pvar.is_this pv) then if not (Pvar.is_abduced pv) && not (Pvar.is_this pv) then
res := Some (pv, Fpvar) in res := Some (pv, Fpvar) in
let found_in_struct pv fld_lst = (* found_in_pvar has priority *) let found_in_struct pv fld_lst = (* found_in_pvar has priority *)
if is_none !res then res := Some (pv, Fstruct (IList.rev fld_lst)) in if is_none !res then res := Some (pv, Fstruct (List.rev fld_lst)) in
let rec search_struct pv fld_lst = function let rec search_struct pv fld_lst = function
| Sil.Eexp (e, _) -> | Sil.Eexp (e, _) ->
if Exp.equal e exp then found_in_struct pv fld_lst if Exp.equal e exp then found_in_struct pv fld_lst

8
infer/src/backend/infer.ml
Unescape View File

@ -221,8 +221,8 @@ let capture = function
let args = let args =
List.rev_append Config.anon_args ( List.rev_append Config.anon_args (
["--analyzer"; ["--analyzer";
IList.assoc Config.equal_analyzer Config.analyzer List.Assoc.find_exn ~equal:Config.equal_analyzer
(List.map ~f:(fun (n,a) -> (a,n)) Config.string_to_analyzer)] @ (List.map ~f:(fun (n,a) -> (a,n)) Config.string_to_analyzer) Config.analyzer] @
(match Config.blacklist with (match Config.blacklist with
| Some s when in_buck_mode -> ["--blacklist-regex"; s] | Some s when in_buck_mode -> ["--blacklist-regex"; s]
| _ -> []) @ | _ -> []) @
@ -232,7 +232,7 @@ let capture = function
["--buck"]) @ ["--buck"]) @
(match Config.java_jar_compiler with None -> [] | Some p -> (match Config.java_jar_compiler with None -> [] | Some p ->
["--java-jar-compiler"; p]) @ ["--java-jar-compiler"; p]) @
(match IList.rev Config.buck_build_args with (match List.rev Config.buck_build_args with
| args when in_buck_mode -> | args when in_buck_mode ->
List.map ~f:(fun arg -> ["--Xbuck"; "'" ^ arg ^ "'"]) args |> List.concat List.map ~f:(fun arg -> ["--Xbuck"; "'" ^ arg ^ "'"]) args |> List.concat
| _ -> []) @ | _ -> []) @
@ -430,7 +430,7 @@ let get_driver_mode () =
assert_supported_mode `Java "Buck genrule"; assert_supported_mode `Java "Buck genrule";
BuckGenrule path BuckGenrule path
| None -> | None ->
driver_mode_of_build_cmd (IList.rev Config.rest) driver_mode_of_build_cmd (List.rev Config.rest)
let () = let () =
let driver_mode = get_driver_mode () in let driver_mode = get_driver_mode () in

2
infer/src/backend/inferconfig.ml
Unescape View File

@ -253,7 +253,7 @@ let patterns_of_json_with_key (json_key, json) =
let collect accu = function let collect accu = function
| `String s -> s:: accu | `String s -> s:: accu
| _ -> failwith ("Unrecognised parameters in " ^ Yojson.Basic.to_string (`Assoc assoc)) in | _ -> failwith ("Unrecognised parameters in " ^ Yojson.Basic.to_string (`Assoc assoc)) in
IList.rev (List.fold ~f:collect ~init:[] l) in List.rev (List.fold ~f:collect ~init:[] l) in
let create_method_pattern assoc = let create_method_pattern assoc =
let loop mp = function let loop mp = function
| (key, `String s) when String.equal key "class" -> | (key, `String s) when String.equal key "class" ->

6
infer/src/backend/interproc.ml
Unescape View File

@ -731,7 +731,7 @@ let compute_visited vset =
let node_loc = Procdesc.Node.get_loc n in let node_loc = Procdesc.Node.get_loc n in
let instrs_loc = List.map ~f:Sil.instr_get_loc (Procdesc.Node.get_instrs n) in let instrs_loc = List.map ~f:Sil.instr_get_loc (Procdesc.Node.get_instrs n) in
let lines = List.map ~f:(fun loc -> loc.Location.line) (node_loc :: instrs_loc) in let lines = List.map ~f:(fun loc -> loc.Location.line) (node_loc :: instrs_loc) in
IList.remove_duplicates Int.compare (IList.sort Int.compare lines) in List.remove_consecutive_duplicates ~equal:Int.equal (List.sort ~cmp:Int.compare lines) in
let do_node n = let do_node n =
res := res :=
Specs.Visitedset.add (Procdesc.Node.get_id n, node_get_all_lines n) !res in Specs.Visitedset.add (Procdesc.Node.get_id n, node_get_all_lines n) !res in
@ -769,7 +769,7 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list =
vset_ref_add_path vset_ref path; vset_ref_add_path vset_ref path;
compute_visited !vset_ref in compute_visited !vset_ref in
(pre', post', visited) in (pre', post', visited) in
List.map ~f:f pplist in List.map ~f pplist in
let pre_post_map = let pre_post_map =
let add map (pre, post, visited) = let add map (pre, post, visited) =
let current_posts, current_visited = let current_posts, current_visited =
@ -1422,7 +1422,7 @@ let do_analysis exe_env =
let calls = ref [] in let calls = ref [] in
let f (callee_pname, loc) = calls := (callee_pname, loc) :: !calls in let f (callee_pname, loc) = calls := (callee_pname, loc) :: !calls in
Procdesc.iter_calls f caller_pdesc; Procdesc.iter_calls f caller_pdesc;
IList.rev !calls in List.rev !calls in
let init_proc pname = let init_proc pname =
let pdesc = match Exe_env.get_proc_desc exe_env pname with let pdesc = match Exe_env.get_proc_desc exe_env pname with
| Some pdesc -> | Some pdesc ->

12
infer/src/backend/match.ml
Unescape View File

@ -159,7 +159,7 @@ and isel_match isel1 sub vars isel2 =
(* extends substitution sub by creating a new substitution for vars *) (* extends substitution sub by creating a new substitution for vars *)
let sub_extend_with_ren (sub: Sil.subst) vars = let sub_extend_with_ren (sub: Sil.subst) vars =
let f id = (id, Exp.Var (Ident.create_fresh Ident.kprimed)) in let f id = (id, Exp.Var (Ident.create_fresh Ident.kprimed)) in
let renaming_for_vars = Sil.sub_of_list (List.map ~f:f vars) in let renaming_for_vars = Sil.sub_of_list (List.map ~f vars) in
Sil.sub_join sub renaming_for_vars Sil.sub_join sub renaming_for_vars
type sidecondition = Prop.normal Prop.t -> Sil.subst -> bool type sidecondition = Prop.normal Prop.t -> Sil.subst -> bool
@ -409,10 +409,10 @@ and hpara_common_match_with_impl tenv impl_ok ids1 sigma1 eids2 ids2 sigma2 =
let sub_ids = let sub_ids =
let ren_ids = List.zip_exn ids2 ids1 in let ren_ids = List.zip_exn ids2 ids1 in
let f (id2, id1) = (id2, Exp.Var id1) in let f (id2, id1) = (id2, Exp.Var id1) in
List.map ~f:f ren_ids in List.map ~f ren_ids in
let (sub_eids, eids_fresh) = let (sub_eids, eids_fresh) =
let f id = (id, Ident.create_fresh Ident.kprimed) in let f id = (id, Ident.create_fresh Ident.kprimed) in
let ren_eids = List.map ~f:f eids2 in let ren_eids = List.map ~f eids2 in
let eids_fresh = List.map ~f:snd ren_eids in let eids_fresh = List.map ~f:snd ren_eids in
let sub_eids = List.map ~f:(fun (id2, id1) -> (id2, Exp.Var id1)) ren_eids in let sub_eids = List.map ~f:(fun (id2, id1) -> (id2, Exp.Var id1)) ren_eids in
(sub_eids, eids_fresh) in (sub_eids, eids_fresh) in
@ -471,7 +471,7 @@ let sigma_remove_hpred eq sigma e =
| Sil.Hpointsto (root, _, _) | Sil.Hpointsto (root, _, _)
| Sil.Hlseg (_, _, root, _, _) | Sil.Hlseg (_, _, root, _, _)
| Sil.Hdllseg (_, _, root, _, _, _, _) -> eq root e in | Sil.Hdllseg (_, _, root, _, _, _, _) -> eq root e in
let sigma_e, sigma_no_e = IList.partition filter sigma in let sigma_e, sigma_no_e = List.partition_tf ~f:filter sigma in
match sigma_e with match sigma_e with
| [] -> (None, sigma) | [] -> (None, sigma)
| [hpred_e] -> (Some hpred_e, sigma_no_e) | [hpred_e] -> (Some hpred_e, sigma_no_e)
@ -579,7 +579,7 @@ let rec generic_find_partial_iso tenv mode update corres sigma_corres todos sigm
match todos with match todos with
| [] -> | [] ->
let sigma1, sigma2 = sigma_corres in let sigma1, sigma2 = sigma_corres in
Some (IList.rev corres, IList.rev sigma1, IList.rev sigma2, sigma_todo) Some (List.rev corres, List.rev sigma1, List.rev sigma2, sigma_todo)
| (e1, e2) :: todos' when corres_related corres e1 e2 -> | (e1, e2) :: todos' when corres_related corres e1 e2 ->
begin begin
match corres_extend_front e1 e2 corres with match corres_extend_front e1 e2 corres with
@ -721,7 +721,7 @@ let generic_para_create tenv corres sigma1 elist1 =
let not_in_elist1 ((e1, _), _) = not (List.exists ~f:(Exp.equal e1) elist1) in let not_in_elist1 ((e1, _), _) = not (List.exists ~f:(Exp.equal e1) elist1) in
let corres_ids_no_elist1 = List.filter ~f:not_in_elist1 corres_ids in let corres_ids_no_elist1 = List.filter ~f:not_in_elist1 corres_ids in
let should_be_shared ((e1, e2), _) = Exp.equal e1 e2 in let should_be_shared ((e1, e2), _) = Exp.equal e1 e2 in
let shared, exists = IList.partition should_be_shared corres_ids_no_elist1 in let shared, exists = List.partition_tf ~f:should_be_shared corres_ids_no_elist1 in
let es_shared = List.map ~f:(fun ((e1, _), _) -> e1) shared in let es_shared = List.map ~f:(fun ((e1, _), _) -> e1) shared in
(es_shared, List.map ~f:snd shared, List.map ~f:snd exists) in (es_shared, List.map ~f:snd shared, List.map ~f:snd exists) in
let renaming = List.map ~f:(fun ((e1, _), id) -> (e1, id)) corres_ids in let renaming = List.map ~f:(fun ((e1, _), id) -> (e1, id)) corres_ids in

11
infer/src/backend/paths.ml
Unescape View File

@ -319,11 +319,11 @@ end = struct
if !position_seen then if !position_seen then
let rec remove_until_seen = function let rec remove_until_seen = function
| ((_, p, _, _) as x):: l -> | ((_, p, _, _) as x):: l ->
if path_pos_at_path p then IList.rev (x :: l) if path_pos_at_path p then List.rev (x :: l)
else remove_until_seen l else remove_until_seen l
| [] -> [] in | [] -> [] in
remove_until_seen inverse_sequence remove_until_seen inverse_sequence
else IList.rev inverse_sequence in else List.rev inverse_sequence in
List.iter List.iter
~f:(fun (level, p, session, exn_opt) -> f level p session exn_opt) ~f:(fun (level, p, session, exn_opt) -> f level p session exn_opt)
sequence_up_to_last_seen sequence_up_to_last_seen
@ -493,13 +493,8 @@ end = struct
let n = Int.compare lt1.Errlog.lt_level lt2.Errlog.lt_level in 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 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 let relevant lt = lt.Errlog.lt_node_tags <> [] in
IList.remove_irrelevant_duplicates compare relevant (IList.rev !trace) IList.remove_irrelevant_duplicates compare relevant (List.rev !trace)
(* IList.remove_duplicates compare (IList.sort compare !trace) *)
(*
let equal p1 p2 =
compare p1 p2 = 0
*)
end end
(* =============== END of the Path module ===============*) (* =============== END of the Path module ===============*)

10
infer/src/backend/preanal.ml
Unescape View File

@ -37,7 +37,7 @@ let add_dispatch_calls pdesc cg tenv =
receiver_typ in receiver_typ in
let sorted_overrides = let sorted_overrides =
let overrides = Prover.get_overrides_of tenv receiver_typ_no_ptr callee_pname in let overrides = Prover.get_overrides_of tenv receiver_typ_no_ptr callee_pname in
IList.sort (fun (_, p1) (_, p2) -> Procname.compare p1 p2) overrides in List.sort ~cmp:(fun (_, p1) (_, p2) -> Procname.compare p1 p2) overrides in
(match sorted_overrides with (match sorted_overrides with
| ((_, target_pname) :: _) as all_targets -> | ((_, target_pname) :: _) as all_targets ->
let targets_to_add = let targets_to_add =
@ -127,7 +127,7 @@ module NullifyTransferFunctions = struct
let last_instr_in_node node = let last_instr_in_node node =
let get_last_instr () = let get_last_instr () =
let instrs = CFG.instrs node in let instrs = CFG.instrs node in
match IList.rev instrs with match List.rev instrs with
| instr :: _ -> instr | instr :: _ -> instr
| [] -> Sil.skip_instr in | [] -> Sil.skip_instr in
if phys_equal node !cache_node if phys_equal node !cache_node
@ -215,12 +215,12 @@ let add_nullify_instrs pdesc tenv liveness_inv_map =
List.filter ~f:is_local pvars List.filter ~f:is_local pvars
|> List.map ~f:(fun pvar -> Sil.Nullify (pvar, loc)) in |> List.map ~f:(fun pvar -> Sil.Nullify (pvar, loc)) in
if nullify_instrs <> [] if nullify_instrs <> []
then Procdesc.Node.append_instrs node (IList.rev nullify_instrs) in then Procdesc.Node.append_instrs node (List.rev nullify_instrs) in
let node_add_removetmps_instructions node ids = let node_add_removetmps_instructions node ids =
if ids <> [] then if ids <> [] then
let loc = Procdesc.Node.get_last_loc node in let loc = Procdesc.Node.get_last_loc node in
Procdesc.Node.append_instrs node [Sil.Remove_temps (IList.rev ids, loc)] in Procdesc.Node.append_instrs node [Sil.Remove_temps (List.rev ids, loc)] in
List.iter List.iter
~f:(fun node -> ~f:(fun node ->
@ -294,7 +294,7 @@ let do_copy_propagation pdesc tenv =
~f:(fun node -> ~f:(fun node ->
let instrs, changed = rev_transform_node_instrs node in let instrs, changed = rev_transform_node_instrs node in
if changed if changed
then Procdesc.Node.replace_instrs node (IList.rev instrs)) then Procdesc.Node.replace_instrs node (List.rev instrs))
(Procdesc.get_nodes pdesc) (Procdesc.get_nodes pdesc)
let do_liveness pdesc tenv = let do_liveness pdesc tenv =

6
infer/src/backend/printer.ml
Unescape View File

@ -42,7 +42,7 @@ struct
assert false (* execution never reaches here *) assert false (* execution never reaches here *)
with End_of_file -> with End_of_file ->
(In_channel.close cin; (In_channel.close cin;
Array.of_list (IList.rev !lines)) Array.of_list (List.rev !lines))
let file_data (hash: t) fname = let file_data (hash: t) fname =
try try
@ -367,7 +367,7 @@ let force_delayed_prints () =
F.fprintf !curr_html_formatter "@?"; (* flush html stream *) F.fprintf !curr_html_formatter "@?"; (* flush html stream *)
List.iter List.iter
~f:(force_delayed_print !curr_html_formatter) ~f:(force_delayed_print !curr_html_formatter)
(IList.rev (L.get_delayed_prints ())); (List.rev (L.get_delayed_prints ()));
F.fprintf !curr_html_formatter "@?"; F.fprintf !curr_html_formatter "@?";
L.reset_delayed_prints (); L.reset_delayed_prints ();
Config.forcing_delayed_prints := false Config.forcing_delayed_prints := false
@ -418,7 +418,7 @@ let write_proc_html source whole_seconds pdesc =
if Config.write_html then if Config.write_html then
begin begin
let pname = Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
let nodes = IList.sort Procdesc.Node.compare (Procdesc.get_nodes pdesc) in let nodes = List.sort ~cmp:Procdesc.Node.compare (Procdesc.get_nodes pdesc) in
let linenum = (Procdesc.Node.get_loc (List.hd_exn nodes)).Location.line in let linenum = (Procdesc.Node.get_loc (List.hd_exn nodes)).Location.line in
let fd, fmt = let fd, fmt =
Io_infer.Html.create Io_infer.Html.create

76
infer/src/backend/prop.ml
Unescape View File

@ -194,13 +194,13 @@ let sigma_get_stack_nonstack only_local_vars sigma =
let hpred_is_stack_var = function let hpred_is_stack_var = function
| Sil.Hpointsto (Lvar pvar, _, _) -> not only_local_vars || Pvar.is_local pvar | Sil.Hpointsto (Lvar pvar, _, _) -> not only_local_vars || Pvar.is_local pvar
| _ -> false in | _ -> false in
IList.partition hpred_is_stack_var sigma List.partition_tf ~f:hpred_is_stack_var sigma
(** Pretty print a sigma in simple mode. *) (** Pretty print a sigma in simple mode. *)
let pp_sigma_simple pe env fmt sigma = let pp_sigma_simple pe env fmt sigma =
let sigma_stack, sigma_nonstack = sigma_get_stack_nonstack false sigma in let sigma_stack, sigma_nonstack = sigma_get_stack_nonstack false sigma in
let pp_stack fmt _sg = let pp_stack fmt _sg =
let sg = IList.sort Sil.compare_hpred _sg in let sg = List.sort ~cmp:Sil.compare_hpred _sg in
if sg <> [] then Format.fprintf fmt "%a" (Pp.semicolon_seq pe (pp_hpred_stackvar pe)) sg in if sg <> [] then Format.fprintf fmt "%a" (Pp.semicolon_seq pe (pp_hpred_stackvar pe)) sg in
let pp_nl fmt doit = if doit then let pp_nl fmt doit = if doit then
(match pe.Pp.kind with (match pe.Pp.kind with
@ -428,11 +428,11 @@ let prop_fpv prop =
let pi_sub (subst: Sil.subst) pi = let pi_sub (subst: Sil.subst) pi =
let f = Sil.atom_sub subst in let f = Sil.atom_sub subst in
List.map ~f:f pi List.map ~f pi
let sigma_sub subst sigma = let sigma_sub subst sigma =
let f = Sil.hpred_sub subst in let f = Sil.hpred_sub subst in
List.map ~f:f sigma List.map ~f sigma
(** Return [true] if the atom is an inequality *) (** Return [true] if the atom is an inequality *)
let atom_is_inequality (atom : Sil.atom) = match atom with let atom_is_inequality (atom : Sil.atom) = match atom with
@ -656,7 +656,7 @@ module Normalize = struct
in in
let rec f eqs_zero sigma_passed (sigma1: sigma) = match sigma1 with let rec f eqs_zero sigma_passed (sigma1: sigma) = match sigma1 with
| [] -> | [] ->
(IList.rev eqs_zero, IList.rev sigma_passed) (List.rev eqs_zero, List.rev sigma_passed)
| Hpointsto _ as hpred :: sigma' -> | Hpointsto _ as hpred :: sigma' ->
f eqs_zero (hpred :: sigma_passed) sigma' f eqs_zero (hpred :: sigma_passed) sigma'
| Hlseg (Lseg_PE, _, e1, e2, _) :: sigma' | Hlseg (Lseg_PE, _, e1, e2, _) :: sigma'
@ -676,7 +676,7 @@ module Normalize = struct
let sigma_intro_nonemptylseg e1 e2 sigma = let sigma_intro_nonemptylseg e1 e2 sigma =
let rec f sigma_passed (sigma1 : sigma) = match sigma1 with let rec f sigma_passed (sigma1 : sigma) = match sigma1 with
| [] -> | [] ->
IList.rev sigma_passed List.rev sigma_passed
| Hpointsto _ as hpred :: sigma' -> | Hpointsto _ as hpred :: sigma' ->
f (hpred :: sigma_passed) sigma' f (hpred :: sigma_passed) sigma'
| Hlseg (Lseg_PE, para, f1, f2, shared) :: sigma' | Hlseg (Lseg_PE, para, f1, f2, shared) :: sigma'
@ -1192,15 +1192,15 @@ module Normalize = struct
| _ -> [e],[], IntLit.zero in | _ -> [e],[], IntLit.zero in
(* sort and filter out expressions appearing in both the positive and negative part *) (* sort and filter out expressions appearing in both the positive and negative part *)
let normalize_posnegoff (pos, neg, off) = let normalize_posnegoff (pos, neg, off) =
let pos' = IList.sort Exp.compare pos in let pos' = List.sort ~cmp:Exp.compare pos in
let neg' = IList.sort Exp.compare neg in let neg' = List.sort ~cmp:Exp.compare neg in
let rec combine pacc nacc = function let rec combine pacc nacc = function
| x:: ps, y:: ng -> | x:: ps, y:: ng ->
(match Exp.compare x y with (match Exp.compare x y with
| n when n < 0 -> combine (x:: pacc) nacc (ps, y :: ng) | n when n < 0 -> combine (x:: pacc) nacc (ps, y :: ng)
| 0 -> combine pacc nacc (ps, ng) | 0 -> combine pacc nacc (ps, ng)
| _ -> combine pacc (y:: nacc) (x :: ps, ng)) | _ -> combine pacc (y:: nacc) (x :: ps, ng))
| ps, ng -> (IList.rev pacc) @ ps, (IList.rev nacc) @ ng in | ps, ng -> List.rev_append pacc ps, List.rev_append nacc ng in
let pos'', neg'' = combine [] [] (pos', neg') in let pos'', neg'' = combine [] [] (pos', neg') in
(pos'', neg'', off) in (pos'', neg'', off) in
(* turn a non-empty list of expressions into a sum expression *) (* turn a non-empty list of expressions into a sum expression *)
@ -1318,7 +1318,7 @@ module Normalize = struct
let fld_cnts' = let fld_cnts' =
List.map ~f:(fun (fld, cnt) -> List.map ~f:(fun (fld, cnt) ->
fld, strexp_normalize tenv sub cnt) fld_cnts in fld, strexp_normalize tenv sub cnt) fld_cnts in
let fld_cnts'' = IList.sort [%compare: Ident.fieldname * Sil.strexp] fld_cnts' in let fld_cnts'' = List.sort ~cmp:[%compare: Ident.fieldname * Sil.strexp] fld_cnts' in
Estruct (fld_cnts'', inst) Estruct (fld_cnts'', inst)
end end
| Earray (len, idx_cnts, inst) -> | Earray (len, idx_cnts, inst) ->
@ -1333,7 +1333,7 @@ module Normalize = struct
let idx' = exp_normalize tenv sub idx in let idx' = exp_normalize tenv sub idx in
idx', strexp_normalize tenv sub cnt) idx_cnts in idx', strexp_normalize tenv sub cnt) idx_cnts in
let idx_cnts'' = let idx_cnts'' =
IList.sort [%compare: Exp.t * Sil.strexp] idx_cnts' in List.sort ~cmp:[%compare: Exp.t * Sil.strexp] idx_cnts' in
Earray (len', idx_cnts'', inst) Earray (len', idx_cnts'', inst)
end end
@ -1413,22 +1413,22 @@ module Normalize = struct
and hpara_normalize tenv (para : Sil.hpara) = and hpara_normalize tenv (para : Sil.hpara) =
let normalized_body = List.map ~f:(hpred_normalize tenv Sil.sub_empty) (para.body) in let normalized_body = List.map ~f:(hpred_normalize tenv Sil.sub_empty) (para.body) in
let sorted_body = IList.sort Sil.compare_hpred normalized_body in let sorted_body = List.sort ~cmp:Sil.compare_hpred normalized_body in
{ para with body = sorted_body } { para with body = sorted_body }
and hpara_dll_normalize tenv (para : Sil.hpara_dll) = and hpara_dll_normalize tenv (para : Sil.hpara_dll) =
let normalized_body = List.map ~f:(hpred_normalize tenv Sil.sub_empty) (para.body_dll) in let normalized_body = List.map ~f:(hpred_normalize tenv Sil.sub_empty) (para.body_dll) in
let sorted_body = IList.sort Sil.compare_hpred normalized_body in let sorted_body = List.sort ~cmp:Sil.compare_hpred normalized_body in
{ para with body_dll = sorted_body } { para with body_dll = sorted_body }
let sigma_normalize tenv sub sigma = let sigma_normalize tenv sub sigma =
let sigma' = let sigma' =
IList.stable_sort Sil.compare_hpred (List.map ~f:(hpred_normalize tenv sub) sigma) in List.stable_sort ~cmp:Sil.compare_hpred (List.map ~f:(hpred_normalize tenv sub) sigma) in
if equal_sigma sigma sigma' then sigma else sigma' if equal_sigma sigma sigma' then sigma else sigma'
let pi_tighten_ineq tenv pi = let pi_tighten_ineq tenv pi =
let ineq_list, nonineq_list = IList.partition atom_is_inequality pi in let ineq_list, nonineq_list = List.partition_tf ~f:atom_is_inequality pi in
let diseq_list = let diseq_list =
let get_disequality_info acc (a : Sil.atom) = match a with let get_disequality_info acc (a : Sil.atom) = match a with
| Aneq (Const (Cint n), e) | Aneq (Const (Cint n), e)
@ -1443,11 +1443,11 @@ module Normalize = struct
| Some (e, n) -> (e, n):: acc | Some (e, n) -> (e, n):: acc
| _ -> acc in | _ -> acc in
let rec le_tighten le_list_done = function let rec le_tighten le_list_done = function
| [] -> IList.rev le_list_done | [] -> List.rev le_list_done
| (e, n):: le_list_todo -> (* e <= n *) | (e, n):: le_list_todo -> (* e <= n *)
if is_neq e n then le_tighten le_list_done ((e, n -- IntLit.one):: le_list_todo) if is_neq e n then le_tighten le_list_done ((e, n -- IntLit.one):: le_list_todo)
else le_tighten ((e, n):: le_list_done) (le_list_todo) in else le_tighten ((e, n):: le_list_done) (le_list_todo) in
let le_list = IList.rev (List.fold ~f:get_le_inequality_info ~init:[] ineq_list) in let le_list = List.rev (List.fold ~f:get_le_inequality_info ~init:[] ineq_list) in
le_tighten [] le_list in le_tighten [] le_list in
let lt_list_tightened = let lt_list_tightened =
let get_lt_inequality_info acc a = let get_lt_inequality_info acc a =
@ -1455,13 +1455,13 @@ module Normalize = struct
| Some (n, e) -> (n, e):: acc | Some (n, e) -> (n, e):: acc
| _ -> acc in | _ -> acc in
let rec lt_tighten lt_list_done = function let rec lt_tighten lt_list_done = function
| [] -> IList.rev lt_list_done | [] -> List.rev lt_list_done
| (n, e):: lt_list_todo -> (* n < e *) | (n, e):: lt_list_todo -> (* n < e *)
let n_plus_one = n ++ IntLit.one in let n_plus_one = n ++ IntLit.one in
if is_neq e n_plus_one if is_neq e n_plus_one
then lt_tighten lt_list_done ((n ++ IntLit.one, e):: lt_list_todo) then lt_tighten lt_list_done ((n ++ IntLit.one, e):: lt_list_todo)
else lt_tighten ((n, e):: lt_list_done) (lt_list_todo) in else lt_tighten ((n, e):: lt_list_done) (lt_list_todo) in
let lt_list = IList.rev (List.fold ~f:get_lt_inequality_info ~init:[] ineq_list) in let lt_list = List.rev (List.fold ~f:get_lt_inequality_info ~init:[] ineq_list) in
lt_tighten [] lt_list in lt_tighten [] lt_list in
let ineq_list' = let ineq_list' =
let le_ineq_list = let le_ineq_list =
@ -1519,8 +1519,8 @@ module Normalize = struct
not (Const.equal c1 c2) not (Const.equal c1 c2)
| _ -> true in | _ -> true in
let pi' = let pi' =
IList.stable_sort List.stable_sort
Sil.compare_atom ~cmp:Sil.compare_atom
((List.filter ~f:filter_useful_atom nonineq_list) @ ineq_list) in ((List.filter ~f:filter_useful_atom nonineq_list) @ ineq_list) in
let pi'' = pi_sorted_remove_redundant pi' in let pi'' = pi_sorted_remove_redundant pi' in
if equal_pi pi0 pi'' then pi0 else pi'' if equal_pi pi0 pi'' then pi0 else pi''
@ -1769,7 +1769,7 @@ end = struct
let stack = Stack.create () let stack = Stack.create ()
let init es = let init es =
Stack.clear stack; Stack.clear stack;
List.iter ~f:(fun e -> Stack.push stack e) (IList.rev es) List.iter ~f:(fun e -> Stack.push stack e) (List.rev es)
let final () = Stack.clear stack let final () = Stack.clear stack
let is_empty () = Stack.is_empty stack let is_empty () = Stack.is_empty stack
let push e = Stack.push stack e let push e = Stack.push stack e
@ -1780,7 +1780,7 @@ let sigma_get_start_lexps_sort sigma =
let exp_compare_neg e1 e2 = - (Exp.compare e1 e2) in let exp_compare_neg e1 e2 = - (Exp.compare e1 e2) in
let filter e = Sil.fav_for_all (Sil.exp_fav e) Ident.is_normal 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 let lexps = Sil.hpred_list_get_lexps filter sigma in
IList.sort exp_compare_neg lexps List.sort ~cmp:exp_compare_neg lexps
let sigma_dfs_sort tenv sigma = let sigma_dfs_sort tenv sigma =
@ -1799,30 +1799,30 @@ let sigma_dfs_sort tenv sigma =
List.iter ~f:(fun (_, se) -> handle_strexp se) idx_se_list in List.iter ~f:(fun (_, se) -> handle_strexp se) idx_se_list in
let rec handle_e visited seen e (sigma : sigma) = match sigma with let rec handle_e visited seen e (sigma : sigma) = match sigma with
| [] -> (visited, IList.rev seen) | [] -> (visited, List.rev seen)
| hpred :: cur -> | hpred :: cur ->
begin begin
match hpred with match hpred with
| Hpointsto (e', se, _) when Exp.equal e e' -> | Hpointsto (e', se, _) when Exp.equal e e' ->
handle_strexp se; handle_strexp se;
(hpred:: visited, IList.rev_append cur seen) (hpred:: visited, List.rev_append cur seen)
| Hlseg (_, _, root, next, shared) when Exp.equal e root -> | Hlseg (_, _, root, next, shared) when Exp.equal e root ->
List.iter ~f:ExpStack.push (next:: shared); List.iter ~f:ExpStack.push (next:: shared);
(hpred:: visited, IList.rev_append cur seen) (hpred:: visited, List.rev_append cur seen)
| Hdllseg (_, _, iF, oB, oF, iB, shared) | Hdllseg (_, _, iF, oB, oF, iB, shared)
when Exp.equal e iF || Exp.equal e iB -> when Exp.equal e iF || Exp.equal e iB ->
List.iter ~f:ExpStack.push (oB:: oF:: shared); List.iter ~f:ExpStack.push (oB:: oF:: shared);
(hpred:: visited, IList.rev_append cur seen) (hpred:: visited, List.rev_append cur seen)
| _ -> | _ ->
handle_e visited (hpred:: seen) e cur handle_e visited (hpred:: seen) e cur
end in end in
let rec handle_sigma visited = function let rec handle_sigma visited = function
| [] -> IList.rev visited | [] -> List.rev visited
| cur -> | cur ->
if ExpStack.is_empty () then if ExpStack.is_empty () then
let cur' = Normalize.sigma_normalize tenv Sil.sub_empty cur in let cur' = Normalize.sigma_normalize tenv Sil.sub_empty cur in
IList.rev_append cur' visited List.rev_append cur' visited
else else
let e = ExpStack.pop () in let e = ExpStack.pop () in
let (visited', cur') = handle_e visited [] e cur in let (visited', cur') = handle_e visited [] e cur in
@ -1864,7 +1864,7 @@ let hpred_get_array_indices acc (hpred : Sil.hpred) = match hpred with
let sigma_get_array_indices sigma = let sigma_get_array_indices sigma =
let indices = List.fold ~f:hpred_get_array_indices ~init:[] sigma in let indices = List.fold ~f:hpred_get_array_indices ~init:[] sigma in
IList.rev indices List.rev indices
let compute_reindexing fav_add get_id_offset list = let compute_reindexing fav_add get_id_offset list =
let rec select list_passed list_seen = function let rec select list_passed list_seen = function
@ -1931,7 +1931,7 @@ let prop_rename_array_indices tenv prop =
not (Exp.equal e1' e2' && IntLit.lt n1' n2') not (Exp.equal e1' e2' && IntLit.lt n1' n2')
| _ -> true in | _ -> true in
let rec select_minimal_indices indices_seen = function let rec select_minimal_indices indices_seen = function
| [] -> IList.rev indices_seen | [] -> List.rev indices_seen
| index:: indices_rest -> | index:: indices_rest ->
let indices_seen' = List.filter ~f:(not_same_base_lt_offsets index) indices_seen in let indices_seen' = List.filter ~f:(not_same_base_lt_offsets index) indices_seen in
let indices_seen_new = index:: indices_seen' in let indices_seen_new = index:: indices_seen' in
@ -1944,7 +1944,7 @@ let prop_rename_array_indices tenv prop =
let compute_renaming fav = let compute_renaming fav =
let ids = Sil.fav_to_list fav in let ids = Sil.fav_to_list fav in
let ids_primed, ids_nonprimed = IList.partition Ident.is_primed ids in let ids_primed, ids_nonprimed = List.partition_tf ~f:Ident.is_primed ids in
let ids_footprint = List.filter ~f:Ident.is_footprint ids_nonprimed in let ids_footprint = List.filter ~f:Ident.is_footprint ids_nonprimed in
let id_base_primed = Ident.create Ident.kprimed 0 in let id_base_primed = Ident.create Ident.kprimed 0 in
@ -2016,13 +2016,13 @@ let rec strexp_captured_ren ren (se : Sil.strexp) : Sil.strexp = match se with
Eexp (exp_captured_ren ren e, inst) Eexp (exp_captured_ren ren e, inst)
| Estruct (fld_se_list, inst) -> | Estruct (fld_se_list, inst) ->
let f (fld, se) = (fld, strexp_captured_ren ren se) in let f (fld, se) = (fld, strexp_captured_ren ren se) in
Estruct (List.map ~f:f fld_se_list, inst) Estruct (List.map ~f fld_se_list, inst)
| Earray (len, idx_se_list, inst) -> | Earray (len, idx_se_list, inst) ->
let f (idx, se) = let f (idx, se) =
let idx' = exp_captured_ren ren idx in let idx' = exp_captured_ren ren idx in
(idx', strexp_captured_ren ren se) in (idx', strexp_captured_ren ren se) in
let len' = exp_captured_ren ren len in let len' = exp_captured_ren ren len in
Earray (len', List.map ~f:f idx_se_list, inst) Earray (len', List.map ~f idx_se_list, inst)
and hpred_captured_ren ren (hpred : Sil.hpred) : Sil.hpred = match hpred with and hpred_captured_ren ren (hpred : Sil.hpred) : Sil.hpred = match hpred with
| Hpointsto (base, se, te) -> | Hpointsto (base, se, te) ->
@ -2234,7 +2234,7 @@ let prop_iter_create prop =
(** Return the prop associated to the iterator. *) (** Return the prop associated to the iterator. *)
let prop_iter_to_prop tenv iter = let prop_iter_to_prop tenv iter =
let sigma = IList.rev_append iter.pit_old (iter.pit_curr:: iter.pit_new) in let sigma = List.rev_append iter.pit_old (iter.pit_curr:: iter.pit_new) in
let prop = let prop =
Normalize.normalize tenv Normalize.normalize tenv
(set prop_emp (set prop_emp
@ -2257,7 +2257,7 @@ let prop_iter_add_atom footprint iter atom =
(** Remove the current element of the iterator, and return the prop (** Remove the current element of the iterator, and return the prop
associated to the resulting iterator *) associated to the resulting iterator *)
let prop_iter_remove_curr_then_to_prop tenv iter : normal t = let prop_iter_remove_curr_then_to_prop tenv iter : normal t =
let sigma = IList.rev_append iter.pit_old iter.pit_new in let sigma = List.rev_append iter.pit_old iter.pit_new in
let normalized_sigma = Normalize.sigma_normalize tenv iter.pit_sub sigma in let normalized_sigma = Normalize.sigma_normalize tenv iter.pit_sub sigma in
let prop = let prop =
set prop_emp set prop_emp
@ -2342,7 +2342,7 @@ let prop_iter_make_id_primed tenv id iter =
Normalize.atom_normalize tenv Sil.sub_empty eq' in Normalize.atom_normalize tenv Sil.sub_empty eq' in
let rec split pairs_unpid pairs_pid = function let rec split pairs_unpid pairs_pid = function
| [] -> (IList.rev pairs_unpid, IList.rev pairs_pid) | [] -> (List.rev pairs_unpid, List.rev pairs_pid)
| (eq:: eqs_cur : pi) -> | (eq:: eqs_cur : pi) ->
begin begin
match eq with match eq with
@ -2362,7 +2362,7 @@ let prop_iter_make_id_primed tenv id iter =
let rec get_eqs acc = function let rec get_eqs acc = function
| [] | [_] -> | [] | [_] ->
IList.rev acc List.rev acc
| (_, e1) :: (((_, e2) :: _) as pairs) -> | (_, e1) :: (((_, e2) :: _) as pairs) ->
get_eqs (Sil.Aeq(e1, e2):: acc) pairs in get_eqs (Sil.Aeq(e1, e2):: acc) pairs in

2
infer/src/backend/propgraph.ml
Unescape View File

@ -117,7 +117,7 @@ let contains_edge (footprint_part: bool) (g: t) (e: edge) =
(** [iter_edges footprint_part f g] iterates function [f] on the edges in [g] in the same order as returned by [get_edges]; (** [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. *) if [footprint_part] is true the edges are taken from the footprint part. *)
let iter_edges footprint_part f g = let iter_edges footprint_part f g =
List.iter ~f:f (get_edges footprint_part g) List.iter ~f (get_edges footprint_part g)
(** Graph annotated with the differences w.r.t. a previous graph *) (** Graph annotated with the differences w.r.t. a previous graph *)
type diff = type diff =

4
infer/src/backend/propset.ml
Unescape View File

@ -73,14 +73,14 @@ let to_proplist pset =
(** Apply function to all the elements of [propset], removing those where it returns [None]. *) (** Apply function to all the elements of [propset], removing those where it returns [None]. *)
let map_option tenv f pset = let map_option tenv f pset =
let plisto = List.map ~f:f (to_proplist pset) in let plisto = List.map ~f (to_proplist pset) in
let plisto = List.filter ~f:(function | Some _ -> true | None -> false) plisto in let plisto = List.filter ~f:(function | Some _ -> true | None -> false) plisto in
let plist = List.map ~f:(function Some p -> p | None -> assert false) plisto in let plist = List.map ~f:(function Some p -> p | None -> assert false) plisto in
from_proplist tenv plist from_proplist tenv plist
(** Apply function to all the elements of [propset]. *) (** Apply function to all the elements of [propset]. *)
let map tenv f pset = let map tenv f pset =
from_proplist tenv (List.map ~f:f (to_proplist pset)) from_proplist tenv (List.map ~f (to_proplist pset))
(** [fold f pset a] computes [f (... (f (f a p1) p2) ...) pn] (** [fold f pset a] computes [f (... (f (f a p1) p2) ...) pn]
where [p1 ... pN] are the elements of pset, in increasing order. *) where [p1 ... pN] are the elements of pset, in increasing order. *)

41
infer/src/backend/prover.ml
Unescape View File

@ -30,8 +30,8 @@ let rec list_rev_acc acc = function
| x:: l -> list_rev_acc (x:: acc) l | x:: l -> list_rev_acc (x:: acc) l
let rec remove_redundancy have_same_key acc = function let rec remove_redundancy have_same_key acc = function
| [] -> IList.rev acc | [] -> List.rev acc
| [x] -> IList.rev (x:: acc) | [x] -> List.rev (x:: acc)
| x:: ((y:: l') as l) -> | x:: ((y:: l') as l) ->
if have_same_key x y then remove_redundancy have_same_key acc (x:: 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 else remove_redundancy have_same_key (x:: acc) l
@ -123,7 +123,7 @@ end = struct
generate constr acc rest generate constr acc rest
let sort_then_remove_redundancy constraints = let sort_then_remove_redundancy constraints =
let constraints_sorted = IList.sort compare constraints in let constraints_sorted = List.sort ~cmp:compare constraints in
let have_same_key (e1, e2, _) (f1, f2, _) = [%compare.equal: Exp.t * Exp.t] (e1, e2) (f1, f2) in let have_same_key (e1, e2, _) (f1, f2, _) = [%compare.equal: Exp.t * Exp.t] (e1, e2) (f1, f2) in
remove_redundancy have_same_key [] constraints_sorted remove_redundancy have_same_key [] constraints_sorted
@ -133,8 +133,8 @@ end = struct
let rec combine acc_todos acc_seen constraints_new constraints_old = let rec combine acc_todos acc_seen constraints_new constraints_old =
match constraints_new, constraints_old with match constraints_new, constraints_old with
| [], [] -> IList.rev acc_todos, IList.rev acc_seen | [], [] -> List.rev acc_todos, List.rev acc_seen
| [], _ -> IList.rev acc_todos, list_rev_acc constraints_old acc_seen | [], _ -> List.rev acc_todos, list_rev_acc constraints_old acc_seen
| _, [] -> list_rev_acc constraints_new acc_todos, list_rev_acc constraints_new acc_seen | _, [] -> list_rev_acc constraints_new acc_todos, list_rev_acc constraints_new acc_seen
| constr:: rest, constr':: rest' -> | constr:: rest, constr':: rest' ->
let e1, e2, n = constr in let e1, e2, n = constr in
@ -268,7 +268,7 @@ end = struct
if c2 <> 0 then c2 else - (Exp.compare e1 f1) if c2 <> 0 then c2 else - (Exp.compare e1 f1)
let leqs_sort_then_remove_redundancy leqs = let leqs_sort_then_remove_redundancy leqs =
let leqs_sorted = IList.sort leq_compare leqs in let leqs_sorted = List.sort ~cmp:leq_compare leqs in
let have_same_key leq1 leq2 = let have_same_key leq1 leq2 =
match leq1, leq2 with match leq1, leq2 with
| (e1, Exp.Const (Const.Cint n1)), (e2, Exp.Const (Const.Cint n2)) -> | (e1, Exp.Const (Const.Cint n1)), (e2, Exp.Const (Const.Cint n2)) ->
@ -276,7 +276,7 @@ end = struct
| _, _ -> false in | _, _ -> false in
remove_redundancy have_same_key [] leqs_sorted remove_redundancy have_same_key [] leqs_sorted
let lts_sort_then_remove_redundancy lts = let lts_sort_then_remove_redundancy lts =
let lts_sorted = IList.sort lt_compare lts in let lts_sorted = List.sort ~cmp:lt_compare lts in
let have_same_key lt1 lt2 = let have_same_key lt1 lt2 =
match lt1, lt2 with match lt1, lt2 with
| (Exp.Const (Const.Cint n1), e1), (Exp.Const (Const.Cint n2), e2) -> | (Exp.Const (Const.Cint n1), e1), (Exp.Const (Const.Cint n2), e2) ->
@ -643,7 +643,7 @@ let check_disequal tenv prop e1 e2 =
let sigma_irrelevant' = hpred :: sigma_irrelevant let sigma_irrelevant' = hpred :: sigma_irrelevant
in f sigma_irrelevant' e sigma_rest in f sigma_irrelevant' e sigma_rest
| Some _ -> | Some _ ->
let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest let sigma_irrelevant' = List.rev_append sigma_irrelevant sigma_rest
in Some (true, sigma_irrelevant')) in Some (true, sigma_irrelevant'))
| Sil.Hlseg (k, _, e1, e2, _) as hpred :: sigma_rest -> | Sil.Hlseg (k, _, e1, e2, _) as hpred :: sigma_rest ->
(match is_root tenv prop e1 e with (match is_root tenv prop e1 e with
@ -652,20 +652,20 @@ let check_disequal tenv prop e1 e2 =
in f sigma_irrelevant' e sigma_rest in f sigma_irrelevant' e sigma_rest
| Some _ -> | Some _ ->
if (Sil.equal_lseg_kind k Sil.Lseg_NE || check_pi_implies_disequal e1 e2) then if (Sil.equal_lseg_kind k Sil.Lseg_NE || check_pi_implies_disequal e1 e2) then
let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest let sigma_irrelevant' = List.rev_append sigma_irrelevant sigma_rest
in Some (true, sigma_irrelevant') in Some (true, sigma_irrelevant')
else if (Exp.equal e2 Exp.zero) then else if (Exp.equal e2 Exp.zero) then
let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest let sigma_irrelevant' = List.rev_append sigma_irrelevant sigma_rest
in Some (false, sigma_irrelevant') in Some (false, sigma_irrelevant')
else else
let sigma_rest' = (IList.rev sigma_irrelevant) @ sigma_rest let sigma_rest' = List.rev_append sigma_irrelevant sigma_rest
in f [] e2 sigma_rest') in f [] e2 sigma_rest')
| Sil.Hdllseg (Sil.Lseg_NE, _, iF, _, _, iB, _) :: sigma_rest -> | Sil.Hdllseg (Sil.Lseg_NE, _, iF, _, _, iB, _) :: sigma_rest ->
if is_root tenv prop iF e <> None || is_root tenv prop iB e <> None then if is_root tenv prop iF e <> None || is_root tenv prop iB e <> None then
let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest let sigma_irrelevant' = List.rev_append sigma_irrelevant sigma_rest
in Some (true, sigma_irrelevant') in Some (true, sigma_irrelevant')
else else
let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest let sigma_irrelevant' = List.rev_append sigma_irrelevant sigma_rest
in Some (false, sigma_irrelevant') in Some (false, sigma_irrelevant')
| Sil.Hdllseg (Sil.Lseg_PE, _, iF, _, oF, _, _) as hpred :: sigma_rest -> | Sil.Hdllseg (Sil.Lseg_PE, _, iF, _, oF, _, _) as hpred :: sigma_rest ->
(match is_root tenv prop iF e with (match is_root tenv prop iF e with
@ -674,18 +674,18 @@ let check_disequal tenv prop e1 e2 =
in f sigma_irrelevant' e sigma_rest in f sigma_irrelevant' e sigma_rest
| Some _ -> | Some _ ->
if (check_pi_implies_disequal iF oF) then if (check_pi_implies_disequal iF oF) then
let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest let sigma_irrelevant' = List.rev_append sigma_irrelevant sigma_rest
in Some (true, sigma_irrelevant') in Some (true, sigma_irrelevant')
else if (Exp.equal oF Exp.zero) then else if (Exp.equal oF Exp.zero) then
let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest let sigma_irrelevant' = List.rev_append sigma_irrelevant sigma_rest
in Some (false, sigma_irrelevant') in Some (false, sigma_irrelevant')
else else
let sigma_rest' = (IList.rev sigma_irrelevant) @ sigma_rest let sigma_rest' = List.rev_append sigma_irrelevant sigma_rest
in f [] oF sigma_rest') in in f [] oF sigma_rest') in
let f_null_check sigma_irrelevant e sigma_rest = let f_null_check sigma_irrelevant e sigma_rest =
if not (Exp.equal e Exp.zero) then f sigma_irrelevant e sigma_rest if not (Exp.equal e Exp.zero) then f sigma_irrelevant e sigma_rest
else else
let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest let sigma_irrelevant' = List.rev_append sigma_irrelevant sigma_rest
in Some (false, sigma_irrelevant') in Some (false, sigma_irrelevant')
in match f_null_check [] n_e1 spatial_part with in match f_null_check [] n_e1 spatial_part with
| None -> false | None -> false
@ -1474,7 +1474,8 @@ let move_primed_lhs_from_front subs sigma = match sigma with
| [] -> sigma | [] -> sigma
| hpred:: _ -> | hpred:: _ ->
if hpred_has_primed_lhs (snd subs) hpred then if hpred_has_primed_lhs (snd subs) hpred then
let (sigma_primed, sigma_unprimed) = IList.partition (hpred_has_primed_lhs (snd subs)) sigma let (sigma_primed, sigma_unprimed) =
List.partition_tf ~f:(hpred_has_primed_lhs (snd subs)) sigma
in match sigma_unprimed with in match sigma_unprimed with
| [] -> raise (IMPL_EXC ("every hpred has primed lhs, cannot proceed", subs, (EXC_FALSE_SIGMA sigma))) | [] -> raise (IMPL_EXC ("every hpred has primed lhs, cannot proceed", subs, (EXC_FALSE_SIGMA sigma)))
| _:: _ -> sigma_unprimed @ sigma_primed | _:: _ -> sigma_unprimed @ sigma_primed
@ -2148,7 +2149,7 @@ let check_implication_base pname tenv check_frame_empty calc_missing prop1 prop2
let sigma1, sigma2 = prop1.Prop.sigma, prop2.Prop.sigma in let sigma1, sigma2 = prop1.Prop.sigma, prop2.Prop.sigma in
let subs = pre_check_pure_implication tenv calc_missing (prop1.Prop.sub, sub1_base) pi1 pi2 in let subs = pre_check_pure_implication tenv calc_missing (prop1.Prop.sub, sub1_base) pi1 pi2 in
let pi2_bcheck, pi2_nobcheck = (* find bounds checks implicit in pi2 *) let pi2_bcheck, pi2_nobcheck = (* find bounds checks implicit in pi2 *)
IList.partition ProverState.atom_is_array_bounds_check pi2 in List.partition_tf ~f:ProverState.atom_is_array_bounds_check pi2 in
List.iter ~f:(fun a -> ProverState.add_bounds_check (ProverState.BCfrom_pre a)) pi2_bcheck; List.iter ~f:(fun a -> ProverState.add_bounds_check (ProverState.BCfrom_pre a)) pi2_bcheck;
L.d_strln "pre_check_pure_implication"; L.d_strln "pre_check_pure_implication";
L.d_strln "pi1:"; L.d_strln "pi1:";
@ -2239,7 +2240,7 @@ exception NO_COVER
let find_minimum_pure_cover tenv cases = let find_minimum_pure_cover tenv cases =
let cases = let cases =
let compare (pi1, _) (pi2, _) = Int.compare (List.length pi1) (List.length pi2) let compare (pi1, _) (pi2, _) = Int.compare (List.length pi1) (List.length pi2)
in IList.sort compare cases in in List.sort ~cmp:compare cases in
let rec grow seen todo = match todo with let rec grow seen todo = match todo with
| [] -> raise NO_COVER | [] -> raise NO_COVER
| (pi, x):: todo' -> | (pi, x):: todo' ->

33
infer/src/backend/rearrange.ml
Unescape View File

@ -16,8 +16,8 @@ module L = Logging
module F = Format module F = Format
let list_product l1 l2 = let list_product l1 l2 =
let l1' = IList.rev l1 in let l1' = List.rev l1 in
let l2' = IList.rev l2 in let l2' = List.rev l2 in
List.fold List.fold
~f:(fun acc x -> List.fold ~f:(fun acc' y -> (x, y):: acc') ~init:acc l2') ~f:(fun acc x -> List.fold ~f:(fun acc' y -> (x, y):: acc') ~init:acc l2')
~init:[] ~init:[]
@ -117,7 +117,7 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp
let replace_typ_of_f (f', t', a') = let replace_typ_of_f (f', t', a') =
if Ident.equal_fieldname f f' then (f, res_t', a') else (f', t', a') in if Ident.equal_fieldname f f' then (f, res_t', a') else (f', t', a') in
let fields' = let fields' =
IList.sort StructTyp.compare_field (List.map ~f:replace_typ_of_f fields) in List.sort ~cmp:StructTyp.compare_field (List.map ~f:replace_typ_of_f fields) in
ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ;
(atoms', se, t) (atoms', se, t)
| None -> | None ->
@ -220,13 +220,13 @@ let rec _strexp_extend_values
let replace_fse ((f1, _) as ft1) = let replace_fse ((f1, _) as ft1) =
if Ident.equal_fieldname f1 f then (f1, res_se') else ft1 in if Ident.equal_fieldname f1 f then (f1, res_se') else ft1 in
let res_fsel' = let res_fsel' =
IList.sort List.sort
[%compare: Ident.fieldname * Sil.strexp] ~cmp:[%compare: Ident.fieldname * Sil.strexp]
(List.map ~f:replace_fse fsel) in (List.map ~f:replace_fse fsel) in
let replace_fta ((f1, _, a1) as fta1) = let replace_fta ((f1, _, a1) as fta1) =
if Ident.equal_fieldname f f1 then (f1, res_typ', a1) else fta1 in if Ident.equal_fieldname f f1 then (f1, res_typ', a1) else fta1 in
let fields' = let fields' =
IList.sort StructTyp.compare_field (List.map ~f:replace_fta fields) in List.sort ~cmp:StructTyp.compare_field (List.map ~f:replace_fta fields) in
ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ;
(res_atoms', Sil.Estruct (res_fsel', inst'), typ) :: acc in (res_atoms', Sil.Estruct (res_fsel', inst'), typ) :: acc in
List.fold ~f:replace ~init:[] atoms_se_typ_list' List.fold ~f:replace ~init:[] atoms_se_typ_list'
@ -235,11 +235,11 @@ let rec _strexp_extend_values
create_struct_values create_struct_values
pname tenv orig_prop footprint_part kind max_stamp typ' off' inst in pname tenv orig_prop footprint_part kind max_stamp typ' off' inst in
let res_fsel' = let res_fsel' =
IList.sort [%compare: Ident.fieldname * Sil.strexp] ((f, se'):: fsel) in List.sort ~cmp:[%compare: Ident.fieldname * Sil.strexp] ((f, se'):: fsel) in
let replace_fta (f', t', a') = let replace_fta (f', t', a') =
if Ident.equal_fieldname f' f then (f, res_typ', a') else (f', t', a') in if Ident.equal_fieldname f' f then (f, res_typ', a') else (f', t', a') in
let fields' = let fields' =
IList.sort StructTyp.compare_field (List.map ~f:replace_fta fields) in List.sort ~cmp:StructTyp.compare_field (List.map ~f:replace_fta fields) in
ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ;
[(atoms', Sil.Estruct (res_fsel', inst'), typ)] [(atoms', Sil.Estruct (res_fsel', inst'), typ)]
) )
@ -317,7 +317,7 @@ and array_case_analysis_index pname tenv orig_prop
create_struct_values create_struct_values
pname tenv orig_prop footprint_part kind max_stamp typ_cont off inst in pname tenv orig_prop footprint_part kind max_stamp typ_cont off inst in
check_sound elem_typ; check_sound elem_typ;
let cont_new = IList.sort [%compare: Exp.t * Sil.strexp] ((index, elem_se):: array_cont) in let cont_new = List.sort ~cmp:[%compare: Exp.t * Sil.strexp] ((index, elem_se):: array_cont) in
let array_new = Sil.Earray (array_len, cont_new, inst_arr) in let array_new = Sil.Earray (array_len, cont_new, inst_arr) in
let typ_new = Typ.Tarray (elem_typ, typ_array_len) in let typ_new = Typ.Tarray (elem_typ, typ_array_len) in
[(atoms, array_new, typ_new)] [(atoms, array_new, typ_new)]
@ -330,13 +330,14 @@ and array_case_analysis_index pname tenv orig_prop
create_struct_values create_struct_values
pname tenv orig_prop footprint_part kind max_stamp typ_cont off inst in pname tenv orig_prop footprint_part kind max_stamp typ_cont off inst in
check_sound elem_typ; check_sound elem_typ;
let cont_new = IList.sort [%compare: Exp.t * Sil.strexp] ((index, elem_se):: array_cont) in let cont_new =
List.sort ~cmp:[%compare: Exp.t * Sil.strexp] ((index, elem_se):: array_cont) in
let array_new = Sil.Earray (array_len, cont_new, inst_arr) in let array_new = Sil.Earray (array_len, cont_new, inst_arr) in
let typ_new = Typ.Tarray (elem_typ, typ_array_len) in let typ_new = Typ.Tarray (elem_typ, typ_array_len) in
[(atoms, array_new, typ_new)] [(atoms, array_new, typ_new)]
end in end in
let rec handle_case acc isel_seen_rev = function let rec handle_case acc isel_seen_rev = function
| [] -> List.concat (IList.rev (res_new:: acc)) | [] -> List.concat (List.rev (res_new:: acc))
| (i, se) as ise :: isel_unseen -> | (i, se) as ise :: isel_unseen ->
let atoms_se_typ_list = let atoms_se_typ_list =
_strexp_extend_values _strexp_extend_values
@ -367,7 +368,7 @@ let laundry_offset_for_footprint max_stamp offs_in =
let rec laundry offs_seen eqs offs = let rec laundry offs_seen eqs offs =
match offs with match offs with
| [] -> | [] ->
(IList.rev offs_seen, IList.rev eqs) (List.rev offs_seen, List.rev eqs)
| (Sil.Off_fld _ as off):: offs' -> | (Sil.Off_fld _ as off):: offs' ->
let offs_seen' = off:: offs_seen in let offs_seen' = off:: offs_seen in
laundry offs_seen' eqs offs' laundry offs_seen' eqs offs'
@ -487,7 +488,7 @@ let prop_iter_check_fields_ptsto_shallow tenv iter lexp =
let fav_max_stamp fav = let fav_max_stamp fav =
let max_stamp = ref 0 in let max_stamp = ref 0 in
let f id = max_stamp := max !max_stamp (Ident.get_stamp id) in let f id = max_stamp := max !max_stamp (Ident.get_stamp id) in
List.iter ~f:f (Sil.fav_to_list fav); List.iter ~f (Sil.fav_to_list fav);
max_stamp max_stamp
(** [prop_iter_extend_ptsto iter lexp] extends the current psto (** [prop_iter_extend_ptsto iter lexp] extends the current psto
@ -555,7 +556,7 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst =
let atoms_fp_sigma_list = let atoms_fp_sigma_list =
let footprint_sigma = Prop.prop_iter_get_footprint_sigma iter in let footprint_sigma = Prop.prop_iter_get_footprint_sigma iter in
let sigma_pto, sigma_rest = let sigma_pto, sigma_rest =
IList.partition (function List.partition_tf ~f:(function
| Sil.Hpointsto(e', _, _) -> Exp.equal e e' | Sil.Hpointsto(e', _, _) -> Exp.equal e e'
| Sil.Hlseg (_, _, e1, _, _) -> Exp.equal e e1 | Sil.Hlseg (_, _, e1, _, _) -> Exp.equal e e1
| Sil.Hdllseg (_, _, e_iF, _, _, e_iB, _) -> | Sil.Hdllseg (_, _, e_iF, _, _, e_iB, _) ->
@ -570,7 +571,7 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst =
L.d_warning "Cannot extend "; Sil.d_exp lexp; L.d_strln " in"; Prop.d_prop (Prop.prop_iter_to_prop tenv iter); L.d_ln(); L.d_warning "Cannot extend "; Sil.d_exp lexp; L.d_strln " in"; Prop.d_prop (Prop.prop_iter_to_prop tenv iter); L.d_ln();
[([], footprint_sigma)] in [([], footprint_sigma)] in
List.map List.map
~f:(fun (atoms, sigma') -> (atoms, IList.stable_sort Sil.compare_hpred sigma')) ~f:(fun (atoms, sigma') -> (atoms, List.stable_sort ~cmp:Sil.compare_hpred sigma'))
atoms_sigma_list in atoms_sigma_list in
let iter_atoms_fp_sigma_list = let iter_atoms_fp_sigma_list =
list_product iter_list atoms_fp_sigma_list in list_product iter_list atoms_fp_sigma_list in
@ -1232,7 +1233,7 @@ let rec iter_rearrange
else else
iter_rearrange pname tenv (Prop.lexp_normalize_prop tenv prop' lexp) typ prop' iter' inst in iter_rearrange pname tenv (Prop.lexp_normalize_prop tenv prop' lexp) typ prop' iter' inst in
let rec f_many_iters iters_lst = function let rec f_many_iters iters_lst = function
| [] -> List.concat (IList.rev iters_lst) | [] -> List.concat (List.rev iters_lst)
| iter':: iters' -> | iter':: iters' ->
let iters_res' = f_one_iter iter' in let iters_res' = f_one_iter iter' in
f_many_iters (iters_res':: iters_lst) iters' in f_many_iters (iters_res':: iters_lst) iters' in

4
infer/src/backend/specs.ml
Unescape View File

@ -271,7 +271,7 @@ module CallStats = struct (** module for tracing stats of function calls *)
let pp_trace fmt tr = let pp_trace fmt tr =
Pp.seq Pp.seq
(fun fmt x -> F.fprintf fmt "%s" (tr_elem_str x)) (fun fmt x -> F.fprintf fmt "%s" (tr_elem_str x))
fmt (IList.rev tr) fmt (List.rev tr)
let iter f t = let iter f t =
let elems = ref [] in let elems = ref [] in
@ -279,7 +279,7 @@ module CallStats = struct (** module for tracing stats of function calls *)
let sorted_elems = let sorted_elems =
let compare (pname_loc1, _) (pname_loc2, _) = let compare (pname_loc1, _) (pname_loc2, _) =
[%compare: Procname.t * Location.t] pname_loc1 pname_loc2 in [%compare: Procname.t * Location.t] pname_loc1 pname_loc2 in
IList.sort compare !elems in List.sort ~cmp:compare !elems in
List.iter ~f:(fun (x, tr) -> f x tr) sorted_elems List.iter ~f:(fun (x, tr) -> f x tr) sorted_elems
(* (*

2
infer/src/backend/state.ml
Unescape View File

@ -211,7 +211,7 @@ let mk_find_duplicate_nodes proc_desc : (Procdesc.Node.t -> Procdesc.NodeSet.t)
let elements = S.elements s in let elements = S.elements s in
let (_, node_normalized_instrs), _ = let (_, node_normalized_instrs), _ =
let filter (node', _) = Procdesc.Node.equal node node' in let filter (node', _) = Procdesc.Node.equal node node' in
match IList.partition filter elements with match List.partition_tf ~f:filter elements with
| [this], others -> this, others | [this], others -> this, others
| _ -> raise Not_found in | _ -> raise Not_found in
let duplicates = let duplicates =

14
infer/src/backend/symExec.ml
Unescape View File

@ -603,7 +603,7 @@ let resolve_java_pname tenv prop args pname_java call_flags : Procname.java =
| Some class_name -> | Some class_name ->
(Procname.split_classname (Typename.name class_name)) :: accu (Procname.split_classname (Typename.name class_name)) :: accu
| None -> name :: accu) | None -> name :: accu)
~init:[] args (Procname.java_get_parameters resolved_pname_java) |> IList.rev in ~init:[] args (Procname.java_get_parameters resolved_pname_java) |> List.rev in
Procname.java_replace_parameters resolved_pname_java resolved_params in Procname.java_replace_parameters resolved_pname_java resolved_params in
let resolved_pname_java, other_args = let resolved_pname_java, other_args =
match args with match args with
@ -792,7 +792,7 @@ let normalize_params tenv pdesc prop actual_params =
let e', p' = check_arith_norm_exp tenv pdesc e p in let e', p' = check_arith_norm_exp tenv pdesc e p in
(p', (e', t) :: args) in (p', (e', t) :: args) in
let prop, args = List.fold ~f:norm_arg ~init:(prop, []) actual_params in let prop, args = List.fold ~f:norm_arg ~init:(prop, []) actual_params in
(prop, IList.rev args) (prop, List.rev args)
let do_error_checks tenv node_opt instr pname pdesc = match node_opt with let do_error_checks tenv node_opt instr pname pdesc = match node_opt with
| Some node -> | Some node ->
@ -920,7 +920,7 @@ let execute_load ?(report_deref_errors=true) pname pdesc tenv id rhs_exp typ loc
begin begin
match pred_insts_op with match pred_insts_op with
| None -> update acc_in ([],[]) | None -> update acc_in ([],[])
| Some pred_insts -> IList.rev (List.fold ~f:update ~init:acc_in pred_insts) | Some pred_insts -> List.rev (List.fold ~f:update ~init:acc_in pred_insts)
end end
| (Sil.Hpointsto _, _) -> | (Sil.Hpointsto _, _) ->
Errdesc.warning_err loc "no offset access in execute_load -- treating as skip@."; Errdesc.warning_err loc "no offset access in execute_load -- treating as skip@.";
@ -956,7 +956,7 @@ let execute_load ?(report_deref_errors=true) pname pdesc tenv id rhs_exp typ loc
else prop in else prop in
let iter_list = let iter_list =
Rearrange.rearrange ~report_deref_errors pdesc tenv n_rhs_exp' typ prop' loc in Rearrange.rearrange ~report_deref_errors pdesc tenv n_rhs_exp' typ prop' loc in
IList.rev (List.fold ~f:(execute_load_ pdesc tenv id loc) ~init:[] iter_list) List.rev (List.fold ~f:(execute_load_ pdesc tenv id loc) ~init:[] iter_list)
with Rearrange.ARRAY_ACCESS -> with Rearrange.ARRAY_ACCESS ->
if Int.equal Config.array_level 0 then assert false if Int.equal Config.array_level 0 then assert false
else else
@ -995,7 +995,7 @@ let execute_store ?(report_deref_errors=true) pname pdesc tenv lhs_exp typ rhs_e
let prop = Attribute.replace_objc_null tenv prop n_lhs_exp n_rhs_exp in let prop = Attribute.replace_objc_null tenv prop n_lhs_exp n_rhs_exp in
let n_lhs_exp' = Prop.exp_collapse_consecutive_indices_prop typ n_lhs_exp in let n_lhs_exp' = Prop.exp_collapse_consecutive_indices_prop typ n_lhs_exp in
let iter_list = Rearrange.rearrange ~report_deref_errors pdesc tenv n_lhs_exp' typ prop loc in let iter_list = Rearrange.rearrange ~report_deref_errors pdesc tenv n_lhs_exp' typ prop loc in
IList.rev (List.fold ~f:(execute_store_ pdesc tenv n_rhs_exp) ~init:[] iter_list) List.rev (List.fold ~f:(execute_store_ pdesc tenv n_rhs_exp) ~init:[] iter_list)
with Rearrange.ARRAY_ACCESS -> with Rearrange.ARRAY_ACCESS ->
if Int.equal Config.array_level 0 then assert false if Int.equal Config.array_level 0 then assert false
else [prop_] else [prop_]
@ -1211,8 +1211,8 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
| Sil.Nullify (pvar, _) -> | Sil.Nullify (pvar, _) ->
begin begin
let eprop = Prop.expose prop_ in let eprop = Prop.expose prop_ in
match IList.partition match List.partition_tf
(function ~f:(function
| Sil.Hpointsto (Exp.Lvar pvar', _, _) -> Pvar.equal pvar pvar' | Sil.Hpointsto (Exp.Lvar pvar', _, _) -> Pvar.equal pvar pvar'
| _ -> false) eprop.Prop.sigma with | _ -> false) eprop.Prop.sigma with
| [Sil.Hpointsto(e, se, typ)], sigma' -> | [Sil.Hpointsto(e, se, typ)], sigma' ->

24
infer/src/backend/tabulation.ml
Unescape View File

@ -131,7 +131,7 @@ let spec_find_rename trace_call (proc_name : Procname.t)
end; end;
let formal_parameters = let formal_parameters =
List.map ~f:(fun (x, _) -> Pvar.mk_callee x proc_name) formals in List.map ~f:(fun (x, _) -> Pvar.mk_callee x proc_name) formals in
List.map ~f:f specs, formal_parameters List.map ~f specs, formal_parameters
with Not_found -> begin with Not_found -> begin
L.d_strln L.d_strln
("ERROR: found no entry for procedure " ^ ("ERROR: found no entry for procedure " ^
@ -214,10 +214,10 @@ let process_splitting
L.d_str "Don't know about id: "; Sil.d_exp (Exp.Var id); L.d_ln (); L.d_str "Don't know about id: "; Sil.d_exp (Exp.Var id); L.d_ln ();
assert false; assert false;
end end
in Sil.sub_of_list (List.map ~f:f fav_sub_list) in in Sil.sub_of_list (List.map ~f fav_sub_list) in
let sub2_list = let sub2_list =
let f id = (id, Exp.Var (Ident.create_fresh Ident.kfootprint)) let f id = (id, Exp.Var (Ident.create_fresh Ident.kfootprint))
in List.map ~f:f (Sil.fav_to_list fav_missing_primed) in in List.map ~f (Sil.fav_to_list fav_missing_primed) in
let sub_list' = let sub_list' =
List.map ~f:(fun (id, e) -> (id, Sil.exp_sub sub1 e)) sub_list in List.map ~f:(fun (id, e) -> (id, Sil.exp_sub sub1 e)) sub_list in
let sub' = Sil.sub_of_list (sub2_list @ sub_list') in let sub' = Sil.sub_of_list (sub2_list @ sub_list') in
@ -497,8 +497,8 @@ let hpred_star_fld tenv (hpred1 : Sil.hpred) (hpred2 : Sil.hpred) : Sil.hpred =
(** Implementation of [*] for the field-splitting model *) (** Implementation of [*] for the field-splitting model *)
let sigma_star_fld tenv (sigma1 : Sil.hpred list) (sigma2 : Sil.hpred list) : Sil.hpred list = let sigma_star_fld tenv (sigma1 : Sil.hpred list) (sigma2 : Sil.hpred list) : Sil.hpred list =
let sigma1 = IList.stable_sort hpred_lhs_compare sigma1 in let sigma1 = List.stable_sort ~cmp:hpred_lhs_compare sigma1 in
let sigma2 = IList.stable_sort hpred_lhs_compare sigma2 in let sigma2 = List.stable_sort ~cmp:hpred_lhs_compare sigma2 in
(* L.out "@.@. computing %a@.STAR @.%a@.@." pp_sigma sigma1 pp_sigma sigma2; *) (* L.out "@.@. computing %a@.STAR @.%a@.@." pp_sigma sigma1 pp_sigma sigma2; *)
let rec star sg1 sg2 : Sil.hpred list = let rec star sg1 sg2 : Sil.hpred list =
match sg1, sg2 with match sg1, sg2 with
@ -532,8 +532,8 @@ let hpred_star_typing (hpred1 : Sil.hpred) (_, te2) : Sil.hpred =
let sigma_star_typ let sigma_star_typ
(sigma1 : Sil.hpred list) (typings2 : (Exp.t * Exp.t) list) : Sil.hpred list = (sigma1 : Sil.hpred list) (typings2 : (Exp.t * Exp.t) list) : Sil.hpred list =
let typing_lhs_compare (e1, _) (e2, _) = Exp.compare e1 e2 in let typing_lhs_compare (e1, _) (e2, _) = Exp.compare e1 e2 in
let sigma1 = IList.stable_sort hpred_lhs_compare sigma1 in let sigma1 = List.stable_sort ~cmp:hpred_lhs_compare sigma1 in
let typings2 = IList.stable_sort typing_lhs_compare typings2 in let typings2 = List.stable_sort ~cmp:typing_lhs_compare typings2 in
let rec star sg1 typ2 : Sil.hpred list = let rec star sg1 typ2 : Sil.hpred list =
match sg1, typ2 with match sg1, typ2 with
| [], _ -> [] | [], _ -> []
@ -605,7 +605,7 @@ let prop_copy_footprint_pure tenv p1 p2 =
let p2' = let p2' =
Prop.set p2 ~pi_fp:p1.Prop.pi_fp ~sigma_fp:p1.Prop.sigma_fp in Prop.set p2 ~pi_fp:p1.Prop.pi_fp ~sigma_fp:p1.Prop.sigma_fp in
let pi2 = p2'.Prop.pi in let pi2 = p2'.Prop.pi in
let pi2_attr, pi2_noattr = IList.partition Attribute.is_pred pi2 in let pi2_attr, pi2_noattr = List.partition_tf ~f:Attribute.is_pred pi2 in
let res_noattr = Prop.set p2' ~pi:(Prop.get_pure p1 @ pi2_noattr) in let res_noattr = Prop.set p2' ~pi:(Prop.get_pure p1 @ pi2_noattr) in
let replace_attr prop atom = (* call replace_atom_attribute which deals with existing attibutes *) let replace_attr prop atom = (* call replace_atom_attribute which deals with existing attibutes *)
(* if [atom] represents an attribute [att], add the attribure to [prop] *) (* if [atom] represents an attribute [att], add the attribure to [prop] *)
@ -1057,7 +1057,7 @@ let exe_spec
check_uninitialize_dangling_deref tenv check_uninitialize_dangling_deref tenv
callee_pname actual_pre split.sub formal_params results; callee_pname actual_pre split.sub formal_params results;
let inconsistent_results, consistent_results = let inconsistent_results, consistent_results =
IList.partition (fun (p, _) -> Prover.check_inconsistency tenv p) results in List.partition_tf ~f:(fun (p, _) -> Prover.check_inconsistency tenv p) results in
let incons_pre_missing = inconsistent_actualpre_missing tenv actual_pre (Some split) in let incons_pre_missing = inconsistent_actualpre_missing tenv actual_pre (Some split) in
Valid_res { incons_pre_missing = incons_pre_missing; Valid_res { incons_pre_missing = incons_pre_missing;
vr_pi = split.missing_pi; vr_pi = split.missing_pi;
@ -1140,15 +1140,15 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re
| Invalid_res _ -> false | Invalid_res _ -> false
| Valid_res _ -> true in | Valid_res _ -> true in
let valid_res0, invalid_res0 = let valid_res0, invalid_res0 =
IList.partition filter_valid_res results in List.partition_tf ~f:filter_valid_res results in
let valid_res = let valid_res =
List.map ~f:(function Valid_res cr -> cr | Invalid_res _ -> assert false) valid_res0 in List.map ~f:(function Valid_res cr -> cr | Invalid_res _ -> assert false) valid_res0 in
let invalid_res = let invalid_res =
List.map ~f:(function Valid_res _ -> assert false | Invalid_res ir -> ir) invalid_res0 in List.map ~f:(function Valid_res _ -> assert false | Invalid_res ir -> ir) invalid_res0 in
let valid_res_miss_pi, valid_res_no_miss_pi = let valid_res_miss_pi, valid_res_no_miss_pi =
IList.partition (fun vr -> vr.vr_pi <> []) valid_res in List.partition_tf ~f:(fun vr -> vr.vr_pi <> []) valid_res in
let _, valid_res_cons_pre_missing = let _, valid_res_cons_pre_missing =
IList.partition (fun vr -> vr.incons_pre_missing) valid_res in List.partition_tf ~f:(fun vr -> vr.incons_pre_missing) valid_res in
let deref_errors = let deref_errors =
List.filter ~f:(function Dereference_error _ -> true | _ -> false) invalid_res in List.filter ~f:(function Dereference_error _ -> true | _ -> false) invalid_res in
let print_pi pi = let print_pi pi =

16
infer/src/base/CommandLineOption.ml
Unescape View File

@ -157,7 +157,7 @@ let wrap_line indent_string wrap_length line =
(rev_lines, new_non_empty, new_line, String.length new_line) in (rev_lines, new_non_empty, new_line, String.length new_line) in
let (rev_lines, _, line, _) = let (rev_lines, _, line, _) =
List.fold ~f:add_word_to_paragraph ~init:([], false, "", 0) words in List.fold ~f:add_word_to_paragraph ~init:([], false, "", 0) words in
IList.rev (line::rev_lines) List.rev (line::rev_lines)
let pad_and_xform doc_width left_width desc = let pad_and_xform doc_width left_width desc =
match desc with match desc with
@ -226,7 +226,7 @@ let check_no_duplicates desc_list =
| _ :: tl -> | _ :: tl ->
check_for_duplicates_ tl check_for_duplicates_ tl
in in
check_for_duplicates_ (IList.sort (fun (x, _, _) (y, _, _) -> String.compare x y) desc_list) check_for_duplicates_ (List.sort ~cmp:(fun (x, _, _) (y, _, _) -> String.compare x y) desc_list)
let parse_tag_desc_lists = List.map ~f:(fun parse_tag -> (parse_tag, ref [])) all_parse_tags let parse_tag_desc_lists = List.map ~f:(fun parse_tag -> (parse_tag, ref [])) all_parse_tags
@ -491,8 +491,8 @@ let mk_path_list ?(default=[]) ?(deprecated=[]) ~long ?short ?parse_mode ?(meta=
let mk_symbol ~default ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = let mk_symbol ~default ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc =
let strings = List.map ~f:fst symbols in let strings = List.map ~f:fst symbols in
let sym_to_str = List.map ~f:(fun (x,y) -> (y,x)) symbols in let sym_to_str = List.map ~f:(fun (x,y) -> (y,x)) symbols in
let of_string str = IList.assoc String.equal str symbols in let of_string str = List.Assoc.find_exn ~equal:String.equal symbols str in
let to_string sym = IList.assoc eq sym sym_to_str in let to_string sym = List.Assoc.find_exn ~equal:eq sym_to_str sym in
mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc
~default_to_string:(fun s -> to_string s) ~default_to_string:(fun s -> to_string s)
~mk_setter:(fun var str -> var := of_string str) ~mk_setter:(fun var str -> var := of_string str)
@ -501,7 +501,7 @@ let mk_symbol ~default ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode ?(
let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc =
let strings = List.map ~f:fst symbols in let strings = List.map ~f:fst symbols in
let of_string str = IList.assoc String.equal str symbols in let of_string str = List.Assoc.find_exn ~equal:String.equal symbols str in
mk ~deprecated ~long ?short ~default:None ?parse_mode ~meta doc mk ~deprecated ~long ?short ~default:None ?parse_mode ~meta doc
~default_to_string:(fun _ -> "") ~default_to_string:(fun _ -> "")
~mk_setter:(fun var str -> var := Some (of_string str)) ~mk_setter:(fun var str -> var := Some (of_string str))
@ -511,8 +511,8 @@ let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="")
let mk_symbol_seq ?(default=[]) ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode let mk_symbol_seq ?(default=[]) ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode
?(meta="") doc = ?(meta="") doc =
let sym_to_str = List.map ~f:(fun (x,y) -> (y,x)) symbols in let sym_to_str = List.map ~f:(fun (x,y) -> (y,x)) symbols in
let of_string str = IList.assoc String.equal str symbols in let of_string str = List.Assoc.find_exn ~equal:String.equal symbols str in
let to_string sym = IList.assoc eq sym sym_to_str in let to_string sym = List.Assoc.find_exn ~equal:eq sym_to_str sym in
mk ~deprecated ~long ?short ~default ?parse_mode ~meta:(",-separated sequence" ^ meta) doc mk ~deprecated ~long ?short ~default ?parse_mode ~meta:(",-separated sequence" ^ meta) doc
~default_to_string:(fun syms -> String.concat ~sep:" " (List.map ~f:to_string syms)) ~default_to_string:(fun syms -> String.concat ~sep:" " (List.map ~f:to_string syms))
~mk_setter:(fun var str_seq -> ~mk_setter:(fun var str_seq ->
@ -607,7 +607,7 @@ let set_curr_speclist_for_parse_action ~incomplete ~usage parse_action =
| _ -> | _ ->
let lower_norm s = String.lowercase @@ norm s in let lower_norm s = String.lowercase @@ norm s in
String.compare (lower_norm x) (lower_norm y) in String.compare (lower_norm x) (lower_norm y) in
let sort speclist = IList.sort compare_specs speclist in let sort speclist = List.sort ~cmp:compare_specs speclist in
align (sort speclist) align (sort speclist)
in in
let add_to_curr_speclist ?(add_help=false) ?header parse_action = let add_to_curr_speclist ?(add_help=false) ?header parse_action =

20
infer/src/base/Config.ml
Unescape View File

@ -31,7 +31,7 @@ let exes = [
let exe_name = let exe_name =
let exe_to_name = List.map ~f:(fun (n,a) -> (a,n)) exes in let exe_to_name = List.map ~f:(fun (n,a) -> (a,n)) exes in
fun exe -> IList.assoc equal_exe exe exe_to_name fun exe -> List.Assoc.find_exn ~equal:equal_exe exe_to_name exe
let frontend_parse_modes = CLOpt.(Infer [Clang]) let frontend_parse_modes = CLOpt.(Infer [Clang])
@ -262,8 +262,8 @@ let real_exe_name =
Utils.realpath Sys.executable_name Utils.realpath Sys.executable_name
let current_exe = let current_exe =
try IList.assoc String.equal (Filename.basename real_exe_name) exes List.Assoc.find ~equal:String.equal exes (Filename.basename real_exe_name) |>
with Not_found -> Driver Option.value ~default:Driver
let bin_dir = let bin_dir =
Filename.dirname real_exe_name Filename.dirname real_exe_name
@ -1381,9 +1381,9 @@ let post_parsing_initialization () =
Unix.close_process_full chans |> ignore; Unix.close_process_full chans |> ignore;
err in err in
let analyzer_name = let analyzer_name =
IList.assoc equal_analyzer List.Assoc.find_exn ~equal:equal_analyzer
(match !analyzer with Some a -> a | None -> Infer) (List.map ~f:(fun (n,a) -> (a,n)) string_to_analyzer)
(List.map ~f:(fun (n,a) -> (a,n)) string_to_analyzer) in (match !analyzer with Some a -> a | None -> Infer) in
let infer_version = Version.commit in let infer_version = Version.commit in
F.eprintf "%s/%s/%s@." javac_version analyzer_name infer_version F.eprintf "%s/%s/%s@." javac_version analyzer_name infer_version
| `Javac -> | `Javac ->
@ -1615,13 +1615,13 @@ and xml_specs = !xml_specs
(** Configuration values derived from command-line options *) (** Configuration values derived from command-line options *)
let analysis_path_regex_whitelist analyzer = let analysis_path_regex_whitelist analyzer =
IList.assoc equal_analyzer analyzer analysis_path_regex_whitelist_options List.Assoc.find_exn ~equal:equal_analyzer analysis_path_regex_whitelist_options analyzer
and analysis_path_regex_blacklist analyzer = and analysis_path_regex_blacklist analyzer =
IList.assoc equal_analyzer analyzer analysis_path_regex_blacklist_options List.Assoc.find_exn ~equal:equal_analyzer analysis_path_regex_blacklist_options analyzer
and analysis_blacklist_files_containing analyzer = and analysis_blacklist_files_containing analyzer =
IList.assoc equal_analyzer analyzer analysis_blacklist_files_containing_options List.Assoc.find_exn ~equal:equal_analyzer analysis_blacklist_files_containing_options analyzer
and analysis_suppress_errors analyzer = and analysis_suppress_errors analyzer =
IList.assoc equal_analyzer analyzer analysis_suppress_errors_options List.Assoc.find_exn ~equal:equal_analyzer analysis_suppress_errors_options analyzer
let checkers_enabled = not (eradicate || crashcontext || quandary || threadsafety) let checkers_enabled = not (eradicate || crashcontext || quandary || threadsafety)

6
infer/src/base/DB.ml
Unescape View File

@ -52,7 +52,7 @@ let find_source_dirs () =
let dir = Filename.concat captured_dir fname in let dir = Filename.concat captured_dir fname in
if Sys.is_directory dir = `Yes then add_cg_files_from_dir dir) if Sys.is_directory dir = `Yes then add_cg_files_from_dir dir)
files_in_results_dir; files_in_results_dir;
IList.rev !source_dirs List.rev !source_dirs
(** {2 Filename} *) (** {2 Filename} *)
@ -165,7 +165,7 @@ module Results_dir = struct
| [] -> base | [] -> base
| name:: names -> | name:: names ->
Filename.concat (f names) (if String.equal name ".." then Filename.parent_dir_name else name) in Filename.concat (f names) (if String.equal name ".." then Filename.parent_dir_name else name) in
f (IList.rev path) f (List.rev path)
(** convert a path to a filename *) (** convert a path to a filename *)
let path_to_filename pk path = let path_to_filename pk path =
@ -205,7 +205,7 @@ module Results_dir = struct
let new_path = Filename.concat (create names) name in let new_path = Filename.concat (create names) name in
Utils.create_dir new_path; Utils.create_dir new_path;
new_path in new_path in
let filename, dir_path = match IList.rev path with let filename, dir_path = match List.rev path with
| filename:: dir_path -> filename, dir_path | filename:: dir_path -> filename, dir_path
| [] -> raise (Failure "create_path") in | [] -> raise (Failure "create_path") in
let full_fname = Filename.concat (create dir_path) filename in let full_fname = Filename.concat (create dir_path) filename in

72
infer/src/base/IList.ml
Unescape View File

@ -7,25 +7,6 @@
* of patent rights can be found in the PATENTS file in the same directory. * of patent rights can be found in the PATENTS file in the same directory.
*) *)
let partition = List.partition
let rev = List.rev
let rev_append = List.rev_append
let sort = List.sort
let stable_sort = List.stable_sort
let rec last = function
| [] -> None
| [x] -> Some x
| _ :: xs -> last xs
let rec drop_first n = function
| xs when n == 0 -> xs
| _ :: xs -> drop_first (n - 1) xs
| [] -> []
let drop_last n list =
rev (drop_first n (rev list))
(** like map, but returns the original list if unchanged *) (** like map, but returns the original list if unchanged *)
let map_changed (f : 'a -> 'a) l = let map_changed (f : 'a -> 'a) l =
let l', changed = let l', changed =
@ -36,7 +17,7 @@ let map_changed (f : 'a -> 'a) l =
([], false) ([], false)
l in l in
if changed if changed
then rev l' then List.rev l'
else l else l
(** like filter, but returns the original list if unchanged *) (** like filter, but returns the original list if unchanged *)
@ -50,24 +31,15 @@ let filter_changed (f : 'a -> bool) l =
([], false) ([], false)
l in l in
if changed if changed
then rev l' then List.rev l'
else l else l
(** Remove consecutive equal elements from a list (according to the given comparison functions) *) (** Remove consecutive equal irrelevant elements from a list
let remove_duplicates compare l = (according to the given comparison and relevance functions) *)
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 remove_irrelevant_duplicates compare relevant l =
let rec remove compare acc = function let rec remove compare acc = function
| [] -> rev acc | [] -> List.rev acc
| [x] -> rev (x:: acc) | [x] -> List.rev (x:: acc)
| x:: ((y:: l'') as l') -> | x:: ((y:: l'') as l') ->
if compare x y = 0 then begin if compare x y = 0 then begin
match relevant x, relevant y with match relevant x, relevant y with
@ -82,9 +54,9 @@ let remove_irrelevant_duplicates compare relevant l =
let rec merge_sorted_nodup compare res xs1 xs2 = let rec merge_sorted_nodup compare res xs1 xs2 =
match xs1, xs2 with match xs1, xs2 with
| [], _ -> | [], _ ->
rev_append res xs2 List.rev_append res xs2
| _, [] -> | _, [] ->
rev_append res xs1 List.rev_append res xs1
| x1 :: xs1', x2 :: xs2' -> | x1 :: xs1', x2 :: xs2' ->
let n = compare x1 x2 in let n = compare x1 x2 in
if n = 0 then if n = 0 then
@ -95,8 +67,8 @@ let rec merge_sorted_nodup compare res xs1 xs2 =
merge_sorted_nodup compare (x2 :: res) xs1 xs2' merge_sorted_nodup compare (x2 :: res) xs1 xs2'
let intersect compare l1 l2 = let intersect compare l1 l2 =
let l1_sorted = sort compare l1 in let l1_sorted = List.sort compare l1 in
let l2_sorted = sort compare l2 in let l2_sorted = List.sort compare l2 in
let rec f l1 l2 = match l1, l2 with let rec f l1 l2 = match l1, l2 with
| ([], _) | (_,[]) -> false | ([], _) | (_,[]) -> false
| (x1:: l1', x2:: l2') -> | (x1:: l1', x2:: l2') ->
@ -107,7 +79,7 @@ let intersect compare l1 l2 =
f l1_sorted l2_sorted f l1_sorted l2_sorted
let inter compare xs ys = let inter compare xs ys =
let rev_sort xs = sort (fun x y -> compare y x) xs in let rev_sort xs = List.sort (fun x y -> compare y x) xs in
let rev_xs = rev_sort xs in let rev_xs = rev_sort xs in
let rev_ys = rev_sort ys in let rev_ys = rev_sort ys in
let rec inter_ is rev_xxs rev_yys = let rec inter_ is rev_xxs rev_yys =
@ -125,15 +97,6 @@ let inter compare xs ys =
in in
inter_ [] rev_xs rev_ys inter_ [] rev_xs rev_ys
(** Return the first non-None result found when applying f to elements of l *)
let rec find_map_opt f = function
| [] -> None
| e :: l' ->
let e' = f e in
if e' <> None
then e'
else find_map_opt f l'
let to_string f l = let to_string f l =
let rec aux l = let rec aux l =
match l with match l with
@ -141,16 +104,3 @@ let to_string f l =
| s:: [] -> (f s) | s:: [] -> (f s)
| s:: rest -> (f s)^", "^(aux rest) in | s:: rest -> (f s)^", "^(aux rest) in
"["^(aux l)^"]" "["^(aux l)^"]"
(** Like List.mem_assoc but without builtin equality *)
let mem_assoc equal a l =
List.exists (fun x -> equal a (fst x)) l
(** Like List.assoc but without builtin equality *)
let assoc equal a l =
snd (List.find (fun x -> equal a (fst x)) l)
let range i j =
let rec aux n acc =
if n < i then acc else aux (n-1) (n :: acc) in
aux j []

33
infer/src/base/IList.mli
Unescape View File

@ -13,25 +13,6 @@ val map_changed : ('a -> 'a) -> 'a list -> 'a list
(** like filter, but returns the original list if unchanged *) (** like filter, but returns the original list if unchanged *)
val filter_changed : ('a -> bool) -> 'a list -> 'a list val filter_changed : ('a -> bool) -> 'a list -> 'a list
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 sort : ('a -> 'a -> int) -> 'a list -> 'a list
val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
(** last element, if any *)
val last : 'a list -> 'a option
(* 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
(** 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) *) (** 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 val remove_irrelevant_duplicates : ('a -> 'a -> int) -> ('a -> bool) -> 'a list -> 'a list
@ -45,18 +26,4 @@ val intersect : ('a -> 'a -> int) -> 'a list -> 'a list -> bool
(** [inter cmp xs ys] are the elements in both [xs] and [ys], sorted according to [cmp]. *) (** [inter cmp xs ys] are the elements in both [xs] and [ys], sorted according to [cmp]. *)
val inter : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list val inter : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
(** 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
(** Return the first non-None result found when applying f to elements of l *)
val find_map_opt : ('a -> 'b option) -> 'a list -> 'b option
val to_string : ('a -> string) -> 'a list -> string val to_string : ('a -> string) -> 'a list -> string
(** Creates an list, inclusive. E.g. `range 2 4` -> [2, 3, 4].
Not tail-recursive.*)
val range : int -> int -> int list

2
infer/src/base/PrettyPrintable.ml
Unescape View File

@ -55,7 +55,7 @@ module MakePPCompareSet
let pp_element = Ord.pp let pp_element = Ord.pp
let pp fmt s = let pp fmt s =
let elements_alpha = IList.sort Ord.compare_pp (elements s) in let elements_alpha = List.sort ~cmp:Ord.compare_pp (elements s) in
pp_collection ~pp_item:pp_element fmt elements_alpha pp_collection ~pp_item:pp_element fmt elements_alpha
end end

2
infer/src/base/Utils.ml
Unescape View File

@ -38,7 +38,7 @@ let read_file fname =
with with
| End_of_file -> | End_of_file ->
cleanup (); cleanup ();
Some (IList.rev !res) Some (List.rev !res)
| Sys_error _ -> | Sys_error _ ->
cleanup (); cleanup ();
None None

2
infer/src/checkers/SiofDomain.ml
Unescape View File

@ -22,7 +22,7 @@ let normalize ((trace, initialized) as astate) = match trace with
| BottomSiofTrace.Bottom -> astate | BottomSiofTrace.Bottom -> astate
| BottomSiofTrace.NonBottom trace -> | BottomSiofTrace.NonBottom trace ->
let elems = SiofTrace.Sinks.elements (SiofTrace.sinks trace) in let elems = SiofTrace.Sinks.elements (SiofTrace.sinks trace) in
let (direct, indirect) = IList.partition SiofTrace.is_intraprocedural_access elems in let (direct, indirect) = List.partition_tf ~f:SiofTrace.is_intraprocedural_access elems in
match direct with match direct with
| [] | _::[] -> astate | [] | _::[] -> astate
| access::_ -> | access::_ ->

4
infer/src/checkers/SiofTrace.ml
Unescape View File

@ -84,7 +84,7 @@ let trace_of_error loc gname path =
(* the last element of the trace gotten by [to_sink_loc_trace] contains a set of procedure-local (* the last element of the trace gotten by [to_sink_loc_trace] contains a set of procedure-local
accesses to globals. We want to remove it in exchange for as many trace elems as there are accesses to globals. We want to remove it in exchange for as many trace elems as there are
accesses. *) accesses. *)
match (IList.rev trace_with_set_of_globals, snd path) with match (List.rev trace_with_set_of_globals, snd path) with
| telem::rest, ({TraceElem.kind = (`Access, globals)}, _)::_ -> | telem::rest, ({TraceElem.kind = (`Access, globals)}, _)::_ ->
let nesting = telem.Errlog.lt_level in let nesting = telem.Errlog.lt_level in
let add_trace_elem_of_access err_trace (global, loc) = let add_trace_elem_of_access err_trace (global, loc) =
@ -94,7 +94,7 @@ let trace_of_error loc gname path =
::err_trace in ::err_trace in
GlobalsAccesses.elements globals GlobalsAccesses.elements globals
|> List.fold ~f:add_trace_elem_of_access ~init:rest |> List.fold ~f:add_trace_elem_of_access ~init:rest
|> IList.rev |> List.rev
| _ -> trace_with_set_of_globals | _ -> trace_with_set_of_globals
in in
trace_elem_of_global::trace trace_elem_of_global::trace

2
infer/src/checkers/ThreadSafety.ml
Unescape View File

@ -150,7 +150,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
(* we don't want to warn on writes to the field if it is (a) thread-confined, or (b) volatile *) (* we don't want to warn on writes to the field if it is (a) thread-confined, or (b) volatile *)
let is_safe_write access_path tenv = let is_safe_write access_path tenv =
let is_thread_safe_write accesses tenv = let is_thread_safe_write accesses tenv =
match IList.rev accesses, match List.rev accesses,
AccessPath.Raw.get_typ (AccessPath.Raw.truncate access_path) tenv with AccessPath.Raw.get_typ (AccessPath.Raw.truncate access_path) tenv with
| AccessPath.FieldAccess fieldname :: _, | AccessPath.FieldAccess fieldname :: _,
Some (Typ.Tstruct typename | Tptr (Tstruct typename, _)) -> Some (Typ.Tstruct typename | Tptr (Tstruct typename, _)) ->

14
infer/src/checkers/Trace.ml
Unescape View File

@ -218,7 +218,7 @@ module Make (Spec : Spec) = struct
pp_sources sources_passthroughs pp_sources sources_passthroughs
Procname.pp cur_pname Procname.pp cur_pname
pp_passthroughs cur_passthroughs pp_passthroughs cur_passthroughs
pp_sinks (IList.rev sinks_passthroughs) pp_sinks (List.rev sinks_passthroughs)
type passthrough_kind = type passthrough_kind =
| Source (* passthroughs of a source *) | Source (* passthroughs of a source *)
@ -284,11 +284,11 @@ module Make (Spec : Spec) = struct
(Errlog.make_trace_element lt_level (CallSite.loc passthrough_site) desc []) :: acc in (Errlog.make_trace_element lt_level (CallSite.loc passthrough_site) desc []) :: acc in
(* sort passthroughs by ascending line number to create a coherent trace *) (* sort passthroughs by ascending line number to create a coherent trace *)
let sorted_passthroughs = let sorted_passthroughs =
IList.sort List.sort
(fun passthrough1 passthrough2 -> ~cmp:(fun passthrough1 passthrough2 ->
let loc1 = CallSite.loc (Passthrough.site passthrough1) in let loc1 = CallSite.loc (Passthrough.site passthrough1) in
let loc2 = CallSite.loc (Passthrough.site passthrough2) in let loc2 = CallSite.loc (Passthrough.site passthrough2) in
Int.compare loc1.Location.line loc2.Location.line) Int.compare loc1.Location.line loc2.Location.line)
(Passthroughs.elements passthroughs) in (Passthroughs.elements passthroughs) in
List.fold_right ~f:trace_elem_of_passthrough sorted_passthroughs ~init:acc0 in List.fold_right ~f:trace_elem_of_passthrough sorted_passthroughs ~init:acc0 in
@ -298,7 +298,7 @@ module Make (Spec : Spec) = struct
if should_nest elem if should_nest elem
then incr level; then incr level;
pair, !level in pair, !level in
List.map ~f:get_nesting_ (IList.rev elems) in List.map ~f:get_nesting_ (List.rev elems) in
let trace_elems_of_path_elem call_site desc ~is_source ((elem, passthroughs), lt_level) acc = let trace_elems_of_path_elem call_site desc ~is_source ((elem, passthroughs), lt_level) acc =
let desc = desc elem in let desc = desc elem in

4
infer/src/checkers/annotationReachability.ml
Unescape View File

@ -175,7 +175,7 @@ let string_of_pname =
let report_allocation_stack let report_allocation_stack
src_annot pname fst_call_loc trace stack_str constructor_pname call_loc = src_annot pname fst_call_loc trace stack_str constructor_pname call_loc =
let final_trace = IList.rev (update_trace call_loc trace) in let final_trace = List.rev (update_trace call_loc trace) in
let constr_str = string_of_pname constructor_pname in let constr_str = string_of_pname constructor_pname in
let description = let description =
Printf.sprintf Printf.sprintf
@ -193,7 +193,7 @@ let report_annotation_stack src_annot snk_annot src_pname loc trace stack_str sn
if String.equal snk_annot dummy_constructor_annot if String.equal snk_annot dummy_constructor_annot
then report_allocation_stack src_annot src_pname loc trace stack_str snk_pname call_loc then report_allocation_stack src_annot src_pname loc trace stack_str snk_pname call_loc
else else
let final_trace = IList.rev (update_trace call_loc trace) in let final_trace = List.rev (update_trace call_loc trace) in
let exp_pname_str = string_of_pname snk_pname in let exp_pname_str = string_of_pname snk_pname in
let description = let description =
Printf.sprintf Printf.sprintf

2
infer/src/checkers/checkers.ml
Unescape View File

@ -427,7 +427,7 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p
(fun n -> Procdesc.Node.get_sliced_preds n has_instr) in (fun n -> Procdesc.Node.get_sliced_preds n has_instr) in
let instrs = let instrs =
List.concat List.concat
(List.map ~f:(fun n -> IList.rev (Procdesc.Node.get_instrs n)) preds) in (List.map ~f:(fun n -> List.rev (Procdesc.Node.get_instrs n)) preds) in
List.find ~f instrs in List.find ~f instrs in
let get_return_const proc_name' = let get_return_const proc_name' =

4
infer/src/checkers/patternMatch.ml
Unescape View File

@ -205,7 +205,7 @@ let get_vararg_type_names tenv
| None -> type_names n) | None -> type_names n)
| _ -> raise Not_found in | _ -> raise Not_found in
IList.rev (type_names call_node) List.rev (type_names call_node)
let has_formal_proc_argument_type_names proc_desc argument_type_names = let has_formal_proc_argument_type_names proc_desc argument_type_names =
let formals = Procdesc.get_formals proc_desc in let formals = Procdesc.get_formals proc_desc in
@ -329,7 +329,7 @@ let proc_calls resolve_attributes pdesc filter : (Procname.t * ProcAttributes.t)
List.iter ~f:(do_instruction node) instrs in List.iter ~f:(do_instruction node) instrs in
let nodes = Procdesc.get_nodes pdesc in let nodes = Procdesc.get_nodes pdesc in
List.iter ~f:do_node nodes; List.iter ~f:do_node nodes;
IList.rev !res List.rev !res
let override_exists f tenv proc_name = let override_exists f tenv proc_name =
let rec super_type_exists tenv super_class_name = let rec super_type_exists tenv super_class_name =

12
infer/src/checkers/procCfg.ml
Unescape View File

@ -185,8 +185,8 @@ module Exceptional = struct
normal_succs normal_succs
| exceptional_succs -> | exceptional_succs ->
normal_succs @ exceptional_succs normal_succs @ exceptional_succs
|> IList.sort Procdesc.Node.compare |> List.sort ~cmp:Procdesc.Node.compare
|> IList.remove_duplicates Procdesc.Node.compare |> List.remove_consecutive_duplicates ~equal:Procdesc.Node.equal
(** get all normal and exceptional predecessors of [n]. *) (** get all normal and exceptional predecessors of [n]. *)
let preds t n = let preds t n =
@ -196,8 +196,8 @@ module Exceptional = struct
normal_preds normal_preds
| exceptional_preds -> | exceptional_preds ->
normal_preds @ exceptional_preds normal_preds @ exceptional_preds
|> IList.sort Procdesc.Node.compare |> List.sort ~cmp:Procdesc.Node.compare
|> IList.remove_duplicates Procdesc.Node.compare |> List.remove_consecutive_duplicates ~equal:Procdesc.Node.equal
let proc_desc (pdesc, _) = pdesc let proc_desc (pdesc, _) = pdesc
let start_node (pdesc, _) = Procdesc.get_start_node pdesc let start_node (pdesc, _) = Procdesc.get_start_node pdesc
@ -208,8 +208,8 @@ end
(** Wrapper that reverses the direction of the CFG *) (** Wrapper that reverses the direction of the CFG *)
module Backward (Base : S) = struct module Backward (Base : S) = struct
include Base include Base
let instrs n = IList.rev (Base.instrs n) let instrs n = List.rev (Base.instrs n)
let instr_ids n = IList.rev (Base.instr_ids n) let instr_ids n = List.rev (Base.instr_ids n)
let succs = Base.preds let succs = Base.preds
let preds = Base.succs let preds = Base.succs

10
infer/src/clang/ClangCommand.re
Unescape View File

@ -111,7 +111,7 @@ let clang_cc1_cmd_sanitizer cmd => {
arg arg
}; };
let post_args_rev = let post_args_rev =
[] |> IList.rev_append ["-include", Config.lib_dir ^\/ "clang_wrappers" ^\/ "global_defines.h"] |> [] |> List.rev_append ["-include", Config.lib_dir ^\/ "clang_wrappers" ^\/ "global_defines.h"] |>
/* Never error on warnings. Clang is often more strict than Apple's version. These arguments /* Never error on warnings. Clang is often more strict than Apple's version. These arguments
are appended at the end to override previous opposite settings. How it's done: suppress are appended at the end to override previous opposite settings. How it's done: suppress
all the warnings, since there are no warnings, compiler can't elevate them to error all the warnings, since there are no warnings, compiler can't elevate them to error
@ -121,7 +121,7 @@ let clang_cc1_cmd_sanitizer cmd => {
fun fun
| [] => | [] =>
/* return non-reversed list */ /* return non-reversed list */
IList.rev (post_args_rev @ res_rev) List.rev (post_args_rev @ res_rev)
| [flag, ...tl] when List.mem equal::String.equal flags_blacklist flag => | [flag, ...tl] when List.mem equal::String.equal flags_blacklist flag =>
filter_unsupported_args_and_swap_includes (flag, res_rev) tl filter_unsupported_args_and_swap_includes (flag, res_rev) tl
| [arg, ...tl] => { | [arg, ...tl] => {
@ -167,8 +167,8 @@ let with_plugin_args args => {
/* -cc1 has to be the first argument or clang will think it runs in driver mode */ /* -cc1 has to be the first argument or clang will think it runs in driver mode */
argv_cons "-cc1" |> argv_cons "-cc1" |>
/* It's important to place this option before other -isystem options. */ /* It's important to place this option before other -isystem options. */
argv_do_if infer_cxx_models (IList.rev_append ["-isystem", Config.cpp_extra_include_dir]) |> argv_do_if infer_cxx_models (List.rev_append ["-isystem", Config.cpp_extra_include_dir]) |>
IList.rev_append [ List.rev_append [
"-load", "-load",
plugin_path, plugin_path,
/* (t7400979) this is a workaround to avoid that clang crashes when the -fmodules flag and the /* (t7400979) this is a workaround to avoid that clang crashes when the -fmodules flag and the
@ -189,7 +189,7 @@ let with_plugin_args args => {
/* add -O0 option to avoid compiler obfuscation of AST */ /* add -O0 option to avoid compiler obfuscation of AST */
let args_after_rev = let args_after_rev =
[] |> argv_cons "-O0" |> argv_do_if Config.fcp_syntax_only (argv_cons "-fsyntax-only"); [] |> argv_cons "-O0" |> argv_do_if Config.fcp_syntax_only (argv_cons "-fsyntax-only");
{...args, argv: IList.rev_append args_before_rev (args.argv @ IList.rev args_after_rev)} {...args, argv: List.rev_append args_before_rev (args.argv @ List.rev args_after_rev)}
}; };
let prepend_arg arg clang_args => {...clang_args, argv: [arg, ...clang_args.argv]}; let prepend_arg arg clang_args => {...clang_args, argv: [arg, ...clang_args.argv]};

2
infer/src/clang/ClangWrapper.re
Unescape View File

@ -81,7 +81,7 @@ let normalize prog::prog args::args :list action_item => {
}; };
/* collect stdout and stderr output together (in reverse order) */ /* collect stdout and stderr output together (in reverse order) */
Utils.with_process_in clang_hashhashhash consume_input |> ignore; Utils.with_process_in clang_hashhashhash consume_input |> ignore;
normalized_commands := IList.rev !normalized_commands; normalized_commands := List.rev !normalized_commands;
!normalized_commands !normalized_commands
}; };

4
infer/src/clang/ComponentKit.ml
Unescape View File

@ -250,7 +250,7 @@ let component_with_multiple_factory_methods_advice context an =
Some "Instead, always expose all parameters in a single \ Some "Instead, always expose all parameters in a single \
designated initializer and document which are optional."; designated initializer and document which are optional.";
loc = CFrontend_checkers.location_from_decl context meth_decl loc = CFrontend_checkers.location_from_decl context meth_decl
}) (IList.drop_first 1 factory_methods) }) (List.drop factory_methods 1)
| _ -> assert false in | _ -> assert false in
match an with match an with
| Ctl_parser_types.Decl (Clang_ast_t.ObjCImplementationDecl (_, _, _, _, impl_decl_info)) -> | Ctl_parser_types.Decl (Clang_ast_t.ObjCImplementationDecl (_, _, _, _, impl_decl_info)) ->
@ -340,7 +340,7 @@ let component_file_line_count_info (context: CLintersContext.context) dec =
Location.file = source_file Location.file = source_file
} }
} }
) (IList.range 1 line_count) ) (List.range 1 line_count ~start:`inclusive ~stop:`inclusive)
| _ -> CTL.False, [] | _ -> CTL.False, []
(** Computes a component file's cyclomatic complexity. (** Computes a component file's cyclomatic complexity.

2
infer/src/clang/cEnum_decl.ml
Unescape View File

@ -43,7 +43,7 @@ let enum_decl decl =
| _ -> () in | _ -> () in
match decl with match decl with
| EnumDecl (_, _, _, type_ptr, decl_list, _, _) -> | EnumDecl (_, _, _, type_ptr, decl_list, _, _) ->
add_enum_constants_to_map (IList.rev decl_list); add_enum_constants_to_map (List.rev decl_list);
let sil_type = Typ.Tint Typ.IInt in let sil_type = Typ.Tint Typ.IInt in
CAst_utils.update_sil_types_map type_ptr sil_type; CAst_utils.update_sil_types_map type_ptr sil_type;
sil_type sil_type

2
infer/src/clang/cFrontend_decl.ml
Unescape View File

@ -264,7 +264,7 @@ struct
| CXXDestructorDecl _ | FunctionTemplateDecl _ -> | CXXDestructorDecl _ | FunctionTemplateDecl _ ->
true true
| _ -> false in | _ -> false in
let method_decls, no_method_decls = IList.partition is_method_decl decl_list in let method_decls, no_method_decls = List.partition_tf ~f:is_method_decl decl_list in
List.iter ~f:translate no_method_decls; List.iter ~f:translate no_method_decls;
ignore (CType_decl.add_types_from_decl_to_tenv tenv dec); ignore (CType_decl.add_types_from_decl_to_tenv tenv dec);
List.iter ~f:translate method_decls List.iter ~f:translate method_decls

2
infer/src/clang/cGeneral_utils.ml
Unescape View File

@ -71,7 +71,7 @@ let rec append_no_duplicates_fields list1 list2 =
let sort_fields fields = let sort_fields fields =
let compare (name1, _, _) (name2, _, _) = let compare (name1, _, _) (name2, _, _) =
Ident.compare_fieldname name1 name2 in Ident.compare_fieldname name1 name2 in
IList.sort compare fields List.sort ~cmp:compare fields
let sort_fields_tenv tenv = let sort_fields_tenv tenv =

4
infer/src/clang/cMethod_trans.ml
Unescape View File

@ -321,7 +321,7 @@ let get_return_type tenv ms =
let sil_func_attributes_of_attributes attrs = let sil_func_attributes_of_attributes attrs =
let rec do_translation acc al = match al with let rec do_translation acc al = match al with
| [] -> IList.rev acc | [] -> List.rev acc
| Clang_ast_t.SentinelAttr attribute_info:: tl -> | Clang_ast_t.SentinelAttr attribute_info:: tl ->
let (sentinel, null_pos) = match attribute_info.Clang_ast_t.ai_parameters with let (sentinel, null_pos) = match attribute_info.Clang_ast_t.ai_parameters with
| a:: b::[] -> (int_of_string a, int_of_string b) | a:: b::[] -> (int_of_string a, int_of_string b)
@ -370,7 +370,7 @@ let get_const_args_indices ~shift args =
let i = ref shift in let i = ref shift in
let rec aux result = function let rec aux result = function
| [] -> | [] ->
IList.rev result List.rev result
| (_, {Clang_ast_t.qt_type_ptr})::tl -> | (_, {Clang_ast_t.qt_type_ptr})::tl ->
incr i; incr i;
if is_pointer_to_const qt_type_ptr then if is_pointer_to_const qt_type_ptr then

4
infer/src/clang/cTL.ml
Unescape View File

@ -192,7 +192,7 @@ module Debug = struct
result in result in
let dotty_of_tree cluster_id tree = let dotty_of_tree cluster_id tree =
let get_root tree = match tree with Tree (root, _) -> root in let get_root tree = match tree with Tree (root, _) -> root in
let get_children tree = match tree with Tree (_, children) -> IList.rev children in let get_children tree = match tree with Tree (_, children) -> List.rev children in
(* shallow: emit dotty about root node and edges to its children *) (* shallow: emit dotty about root node and edges to its children *)
let shallow_dotty_of_tree tree = let shallow_dotty_of_tree tree =
let root_node = get_root tree in let root_node = get_root tree in
@ -246,7 +246,7 @@ module Debug = struct
let buf = Buffer.create 16 in let buf = Buffer.create 16 in
List.iteri List.iteri
~f:(fun cluster_id tree -> Buffer.add_string buf ((dotty_of_tree cluster_id tree) ^ "\n")) ~f:(fun cluster_id tree -> Buffer.add_string buf ((dotty_of_tree cluster_id tree) ^ "\n"))
(IList.rev t.forest); (List.rev t.forest);
Printf.sprintf "digraph CTL_Evaluation {\n%s\n}\n" (buffer_content buf) Printf.sprintf "digraph CTL_Evaluation {\n%s\n}\n" (buffer_content buf)
end end
end end

23
infer/src/clang/cTrans.ml
Unescape View File

@ -1147,7 +1147,7 @@ struct
let all_res_trans = [res_trans_b; tmp_var_res_trans] in let all_res_trans = [res_trans_b; tmp_var_res_trans] in
let res_trans = PriorityNode.compute_results_to_parent trans_state'' sil_loc let res_trans = PriorityNode.compute_results_to_parent trans_state'' sil_loc
"ConditinalStmt Branch" stmt_info all_res_trans in "ConditinalStmt Branch" stmt_info all_res_trans in
let prune_nodes_t, prune_nodes_f = IList.partition is_true_prune_node prune_nodes in let prune_nodes_t, prune_nodes_f = List.partition_tf ~f:is_true_prune_node prune_nodes in
let prune_nodes' = if branch then prune_nodes_t else prune_nodes_f in let prune_nodes' = if branch then prune_nodes_t else prune_nodes_f in
List.iter List.iter
~f:(fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans.root_nodes []) ~f:(fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans.root_nodes [])
@ -1254,7 +1254,7 @@ struct
let short_circuit binop s1 s2 = let short_circuit binop s1 s2 =
let res_trans_s1 = cond_trans trans_state s1 in let res_trans_s1 = cond_trans trans_state s1 in
let prune_nodes_t, prune_nodes_f = let prune_nodes_t, prune_nodes_f =
IList.partition is_true_prune_node res_trans_s1.leaf_nodes in List.partition_tf ~f:is_true_prune_node res_trans_s1.leaf_nodes in
let res_trans_s2 = cond_trans trans_state s2 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 *) (* prune_to_s2 is the prune node that is connected with the root node of the *)
(* translation of s2.*) (* translation of s2.*)
@ -1318,7 +1318,7 @@ struct
(Procdesc.Node.Stmt_node "IfStmt Branch") res_trans_b.instrs sil_loc context] (Procdesc.Node.Stmt_node "IfStmt Branch") res_trans_b.instrs sil_loc context]
| _ -> | _ ->
res_trans_b.root_nodes) in res_trans_b.root_nodes) in
let prune_nodes_t, prune_nodes_f = IList.partition is_true_prune_node prune_nodes in let prune_nodes_t, prune_nodes_f = List.partition_tf ~f:is_true_prune_node prune_nodes in
let prune_nodes' = if branch then prune_nodes_t else prune_nodes_f in let prune_nodes' = if branch then prune_nodes_t else prune_nodes_f in
List.iter List.iter
~f:(fun n -> Procdesc.node_set_succs_exn context.procdesc n nodes_branch []) ~f:(fun n -> Procdesc.node_set_succs_exn context.procdesc n nodes_branch [])
@ -1416,7 +1416,7 @@ struct
aux rest (x :: acc) cases aux rest (x :: acc) cases
| [] -> | [] ->
cases, acc) in cases, acc) in
aux (IList.rev stmt_list) [] [] in aux (List.rev stmt_list) [] [] in
let list_of_cases, pre_case_stmts = merge_into_cases 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 = let rec connected_instruction rev_instr_list successor_nodes =
(* returns the entry point of the translated set of instr *) (* returns the entry point of the translated set of instr *)
@ -1454,7 +1454,7 @@ struct
| CaseStmt(_, _ :: _ :: case_content) as case :: rest -> | CaseStmt(_, _ :: _ :: case_content) as case :: rest ->
let last_nodes, last_prune_nodes = let last_nodes, last_prune_nodes =
translate_and_connect_cases rest next_nodes next_prune_nodes in translate_and_connect_cases rest next_nodes next_prune_nodes in
let case_entry_point = connected_instruction (IList.rev case_content) last_nodes in let case_entry_point = connected_instruction (List.rev case_content) last_nodes in
(* connects between cases, then continuation has priority about breaks *) (* connects between cases, then continuation has priority about breaks *)
let prune_node_t, prune_node_f = create_prune_nodes_for_case case in let prune_node_t, prune_node_f = create_prune_nodes_for_case case in
Procdesc.node_set_succs_exn context.procdesc prune_node_t case_entry_point []; Procdesc.node_set_succs_exn context.procdesc prune_node_t case_entry_point [];
@ -1468,14 +1468,14 @@ struct
let last_nodes, last_prune_nodes = let last_nodes, last_prune_nodes =
translate_and_connect_cases rest next_nodes [placeholder_entry_point] in translate_and_connect_cases rest next_nodes [placeholder_entry_point] in
let default_entry_point = let default_entry_point =
connected_instruction (IList.rev default_content) last_nodes in connected_instruction (List.rev default_content) last_nodes in
Procdesc.node_set_succs_exn Procdesc.node_set_succs_exn
context.procdesc placeholder_entry_point default_entry_point []; context.procdesc placeholder_entry_point default_entry_point [];
default_entry_point, last_prune_nodes default_entry_point, last_prune_nodes
| _ -> assert false in | _ -> assert false in
let top_entry_point, top_prune_nodes = let top_entry_point, top_prune_nodes =
translate_and_connect_cases list_of_cases succ_nodes succ_nodes in translate_and_connect_cases list_of_cases succ_nodes succ_nodes in
let _ = connected_instruction (IList.rev pre_case_stmts) top_entry_point in let _ = connected_instruction (List.rev pre_case_stmts) top_entry_point in
Procdesc.node_set_succs_exn Procdesc.node_set_succs_exn
context.procdesc switch_special_cond_node top_prune_nodes []; context.procdesc switch_special_cond_node top_prune_nodes [];
let top_nodes = res_trans_decl.root_nodes in let top_nodes = res_trans_decl.root_nodes in
@ -1489,7 +1489,7 @@ struct
let stmt = let stmt =
extract_stmt_from_singleton stmt_list "ERROR: StmtExpr should have only one statement.\n" in 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 res_trans_stmt = instruction trans_state stmt in
let exps' = IList.rev res_trans_stmt.exps in let exps' = List.rev res_trans_stmt.exps in
match exps' with match exps' with
| last_exp :: _ -> | last_exp :: _ ->
{ res_trans_stmt with exps = [last_exp]; } { res_trans_stmt with exps = [last_exp]; }
@ -1553,7 +1553,7 @@ struct
| Loops.DoWhile _ -> res_trans_body.root_nodes in | Loops.DoWhile _ -> res_trans_body.root_nodes in
(* Note: prune nodes are by contruction the res_trans_cond.leaf_nodes *) (* Note: prune nodes are by contruction the res_trans_cond.leaf_nodes *)
let prune_nodes_t, prune_nodes_f = let prune_nodes_t, prune_nodes_f =
IList.partition is_true_prune_node res_trans_cond.leaf_nodes in List.partition_tf ~f:is_true_prune_node res_trans_cond.leaf_nodes in
let prune_t_succ_nodes = let prune_t_succ_nodes =
match loop_kind with match loop_kind with
| Loops.For _ | Loops.While _ -> res_trans_body.root_nodes | Loops.For _ | Loops.While _ -> res_trans_body.root_nodes
@ -1658,8 +1658,7 @@ struct
(* of literals the array is initialized with *) (* of literals the array is initialized with *)
let lh = let lh =
if is_array var_type && List.length lh > List.length rh_exps then if is_array var_type && List.length lh > List.length rh_exps then
let i = List.length lh - List.length rh_exps in List.take lh (List.length rh_exps)
IList.drop_last i lh
else lh in else lh in
if Int.equal (List.length rh_exps) (List.length lh) then if Int.equal (List.length rh_exps) (List.length lh) then
(* Creating new instructions by assigning right hand side to left hand side expressions *) (* Creating new instructions by assigning right hand side to left hand side expressions *)
@ -2723,7 +2722,7 @@ struct
exps = res_trans_tail.exps @ res_trans_s.exps; exps = res_trans_tail.exps @ res_trans_s.exps;
initd_exps = res_trans_tail.initd_exps @ res_trans_s.initd_exps; initd_exps = res_trans_tail.initd_exps @ res_trans_s.initd_exps;
} in } in
exec_trans_instrs_no_rev trans_state (IList.rev trans_stmt_fun_list) exec_trans_instrs_no_rev trans_state (List.rev trans_stmt_fun_list)
and get_clang_stmt_trans stmt = and get_clang_stmt_trans stmt =
fun trans_state -> exec_with_node_creation instruction trans_state stmt fun trans_state -> exec_with_node_creation instruction trans_state stmt

12
infer/src/clang/cTrans_utils.ml
Unescape View File

@ -175,16 +175,16 @@ let collect_res_trans pdesc l =
collect l' collect l'
{ root_nodes = root_nodes; { root_nodes = root_nodes;
leaf_nodes = leaf_nodes; leaf_nodes = leaf_nodes;
instrs = IList.rev_append rt'.instrs rt.instrs; instrs = List.rev_append rt'.instrs rt.instrs;
exps = IList.rev_append rt'.exps rt.exps; exps = List.rev_append rt'.exps rt.exps;
initd_exps = IList.rev_append rt'.initd_exps rt.initd_exps; initd_exps = List.rev_append rt'.initd_exps rt.initd_exps;
is_cpp_call_virtual = false; } in is_cpp_call_virtual = false; } in
let rt = collect l empty_res_trans in let rt = collect l empty_res_trans in
{ {
rt with rt with
instrs = IList.rev rt.instrs; instrs = List.rev rt.instrs;
exps = IList.rev rt.exps; exps = List.rev rt.exps;
initd_exps = IList.rev rt.initd_exps; initd_exps = List.rev rt.initd_exps;
} }
let extract_var_exp_or_fail transt_state = let extract_var_exp_or_fail transt_state =

2
infer/src/eradicate/AnnotatedSignature.ml
Unescape View File

@ -40,7 +40,7 @@ let get proc_attributes : t =
[] []
| _ :: _, [] -> | _ :: _, [] ->
assert false in assert false in
IList.rev (extract (IList.rev ial0) (IList.rev formals)) in List.rev (extract (List.rev ial0) (List.rev formals)) in
let annotated_signature = { ret = (ia, ret_type); params = natl } in let annotated_signature = { ret = (ia, ret_type); params = natl } in
annotated_signature annotated_signature

4
infer/src/eradicate/eradicate.ml
Unescape View File

@ -251,7 +251,7 @@ struct
final_typestates := (pname, final_typestate) :: !final_typestates final_typestates := (pname, final_typestate) :: !final_typestates
| _, None -> () in | _, None -> () in
List.iter ~f:get_final_typestate initializers_recursive; List.iter ~f:get_final_typestate initializers_recursive;
IList.rev !final_typestates List.rev !final_typestates
let pname_and_pdescs_with f = let pname_and_pdescs_with f =
let res = ref [] in let res = ref [] in
@ -265,7 +265,7 @@ struct
res := (pname, pdesc) :: !res res := (pname, pdesc) :: !res
| None -> () in | None -> () in
List.iter ~f:do_proc (get_procs_in_file curr_pname); List.iter ~f:do_proc (get_procs_in_file curr_pname);
IList.rev !res List.rev !res
let get_class pn = match pn with let get_class pn = match pn with
| Procname.Java pn_java -> | Procname.Java pn_java ->

2
infer/src/eradicate/eradicateChecks.ml
Unescape View File

@ -506,7 +506,7 @@ let check_call_parameters tenv
Specs.get_summary callee_pname <> None in Specs.get_summary callee_pname <> None in
if should_check_parameters then if should_check_parameters then
(* left to right to avoid guessing the different lengths *) (* left to right to avoid guessing the different lengths *)
check (IList.rev sig_params) (IList.rev call_params) check (List.rev sig_params) (List.rev call_params)
(** Checks if the annotations are consistent with the inherited class or with the (** Checks if the annotations are consistent with the inherited class or with the
implemented interfaces *) implemented interfaces *)

2
infer/src/eradicate/models.ml
Unescape View File

@ -91,7 +91,7 @@ module Inference = struct
| Some buf -> | Some buf ->
let boolvec = ref [] in let boolvec = ref [] in
String.iter ~f:(fun c -> boolvec := (Char.equal c '1') :: !boolvec) buf; String.iter ~f:(fun c -> boolvec := (Char.equal c '1') :: !boolvec) buf;
Some (IList.rev !boolvec) Some (List.rev !boolvec)
end (* Inference *) end (* Inference *)

8
infer/src/eradicate/typeCheck.ml
Unescape View File

@ -411,11 +411,11 @@ let typecheck_instr
| fp:: tail when is_hidden_parameter fp -> 1 + drop_n_args tail | fp:: tail when is_hidden_parameter fp -> 1 + drop_n_args tail
| _ -> 0 in | _ -> 0 in
let n = drop_n_args proc_attributes.ProcAttributes.formals in let n = drop_n_args proc_attributes.ProcAttributes.formals in
let visible_params = IList.drop_first n params in let visible_params = List.drop params n in
(* Drop the trailing hidden parameter if the constructor is synthetic. *) (* Drop the trailing hidden parameter if the constructor is synthetic. *)
if proc_attributes.ProcAttributes.is_synthetic_method then if proc_attributes.ProcAttributes.is_synthetic_method then
IList.drop_last 1 visible_params List.take visible_params (List.length visible_params - 1)
else else
visible_params visible_params
end end
@ -427,7 +427,9 @@ let typecheck_instr
let drop_unchecked_signature_params proc_attributes annotated_signature = let drop_unchecked_signature_params proc_attributes annotated_signature =
if Procname.is_constructor (proc_attributes.ProcAttributes.proc_name) && if Procname.is_constructor (proc_attributes.ProcAttributes.proc_name) &&
proc_attributes.ProcAttributes.is_synthetic_method then proc_attributes.ProcAttributes.is_synthetic_method then
IList.drop_last 1 annotated_signature.AnnotatedSignature.params List.take
annotated_signature.AnnotatedSignature.params
(List.length annotated_signature.AnnotatedSignature.params - 1)
else else
annotated_signature.AnnotatedSignature.params in annotated_signature.AnnotatedSignature.params in

4
infer/src/harness/inhabit.ml
Unescape View File

@ -242,7 +242,7 @@ let setup_harness_cfg harness_name env cg cfg =
Cfg.create_proc_desc cfg proc_attributes in Cfg.create_proc_desc cfg proc_attributes in
let harness_node = let harness_node =
(* important to reverse the list or there will be scoping issues! *) (* important to reverse the list or there will be scoping issues! *)
let instrs = (IList.rev env.instrs) in let instrs = (List.rev env.instrs) in
let nodekind = Procdesc.Node.Stmt_node "method_body" in let nodekind = Procdesc.Node.Stmt_node "method_body" in
Procdesc.create_node procdesc env.pc nodekind instrs in Procdesc.create_node procdesc env.pc nodekind instrs in
let (start_node, exit_node) = let (start_node, exit_node) =
@ -279,5 +279,5 @@ let inhabit_trace tenv trace harness_name cg cfg =
trace in trace in
try try
setup_harness_cfg harness_name env'' cg cfg; setup_harness_cfg harness_name env'' cg cfg;
write_harness_to_file (IList.rev env''.instrs) harness_filename write_harness_to_file (List.rev env''.instrs) harness_filename
with Not_found -> () with Not_found -> ()

2
infer/src/integration/CaptureCompilationDatabase.ml
Unescape View File

@ -97,7 +97,7 @@ let run_compilation_database compilation_database should_capture_file =
(** Computes the compilation database files. *) (** Computes the compilation database files. *)
let get_compilation_database_files_buck () = let get_compilation_database_files_buck () =
let cmd = List.rev_append Config.rest (IList.rev Config.buck_build_args) in let cmd = List.rev_append Config.rest (List.rev Config.buck_build_args) in
match cmd with match cmd with
| buck :: build :: args -> | buck :: build :: args ->
(check_args_for_targets args; (check_args_for_targets args;

2
infer/src/java/jClasspath.ml
Unescape View File

@ -259,7 +259,7 @@ let load_from_arguments classes_out_path =
let split cp_option = let split cp_option =
Option.value_map ~f:split_classpath ~default:[] cp_option in Option.value_map ~f:split_classpath ~default:[] cp_option in
let combine path_list classpath = let combine path_list classpath =
List.fold ~f:append_path ~init:classpath (IList.rev path_list) in List.fold ~f:append_path ~init:classpath (List.rev path_list) in
let classpath = let classpath =
combine (split Config.classpath) "" combine (split Config.classpath) ""
|> combine (String.Set.elements roots) |> combine (String.Set.elements roots)

6
infer/src/java/jTrans.ml
Unescape View File

@ -100,7 +100,7 @@ let retrieve_fieldname fieldname =
if Int.equal (List.length subs) 0 then if Int.equal (List.length subs) 0 then
assert false assert false
else else
List.hd_exn (IList.rev subs) List.last_exn subs
with _ -> assert false with _ -> assert false
@ -133,7 +133,7 @@ let formals_from_signature program tenv cn ms kind =
let init_arg_list = match kind with let init_arg_list = match kind with
| Procname.Static -> [] | Procname.Static -> []
| Procname.Non_Static -> [(JConfig.this, JTransType.get_class_type program tenv cn)] in | Procname.Non_Static -> [(JConfig.this, JTransType.get_class_type program tenv cn)] in
IList.rev (List.fold ~f:collect ~init:init_arg_list (JBasics.ms_args ms)) List.rev (List.fold ~f:collect ~init:init_arg_list (JBasics.ms_args ms))
(** Creates the list of formal variables from a procedure based on ... *) (** Creates the list of formal variables from a procedure based on ... *)
let translate_formals program tenv cn impl = let translate_formals program tenv cn impl =
@ -141,7 +141,7 @@ let translate_formals program tenv cn impl =
let name = Mangled.from_string (JBir.var_name_g var) in let name = Mangled.from_string (JBir.var_name_g var) in
let typ = JTransType.param_type program tenv cn var vt in let typ = JTransType.param_type program tenv cn var vt in
(name, typ):: l in (name, typ):: l in
IList.rev (List.fold ~f:collect ~init:[] (JBir.params impl)) List.rev (List.fold ~f:collect ~init:[] (JBir.params impl))
(** Creates the list of local variables from the bytecode and add the variables from (** Creates the list of local variables from the bytecode and add the variables from
the JBir representation *) the JBir representation *)

2
infer/src/java/jTransExn.ml
Unescape View File

@ -105,7 +105,7 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle
collect succ_nodes remove_temps handler in collect succ_nodes remove_temps handler in
let nodes_first_handler = let nodes_first_handler =
List.fold ~f:process_handler ~init:exit_nodes (IList.rev handler_list) in List.fold ~f:process_handler ~init:exit_nodes (List.rev handler_list) in
let loc = match nodes_first_handler with let loc = match nodes_first_handler with
| n:: _ -> Procdesc.Node.get_loc n | n:: _ -> Procdesc.Node.get_loc n
| [] -> Location.dummy in | [] -> Location.dummy in

2
infer/src/unit/TaintTests.ml
Unescape View File

@ -90,7 +90,7 @@ let tests =
else acc) else acc)
astate.MockTaintAnalysis.Domain.access_tree astate.MockTaintAnalysis.Domain.access_tree
[] in [] in
PrettyPrintable.pp_collection ~pp_item fmt (IList.rev trace_assocs) in PrettyPrintable.pp_collection ~pp_item fmt (List.rev trace_assocs) in
let assign_to_source ret_str = let assign_to_source ret_str =
let procname = Procname.from_string_c_fun "SOURCE" in let procname = Procname.from_string_c_fun "SOURCE" in
make_call ~procname (Some (ident_of_str ret_str, dummy_typ)) [] in make_call ~procname (Some (ident_of_str ret_str, dummy_typ)) [] in

2
infer/src/unit/analyzerTester.ml
Unescape View File

@ -268,7 +268,7 @@ module Make (CFG : ProcCfg.S with type node = Procdesc.Node.t) (T : TransferFunc
let mismatches_str = let mismatches_str =
F.pp_print_list F.pp_print_list
(fun fmt error_msg -> F.fprintf fmt "%s" error_msg) F.str_formatter (fun fmt error_msg -> F.fprintf fmt "%s" error_msg) F.str_formatter
(IList.rev error_msgs) (List.rev error_msgs)
|> F.flush_str_formatter in |> F.flush_str_formatter in
let assert_fail_message = let assert_fail_message =
F.fprintf F.str_formatter "Error while analyzing@.%a:@.%s@." F.fprintf F.str_formatter "Error while analyzing@.%a:@.%s@."

2
infer/src/unit/clang/CiOSVersionNumbersTests.ml
Unescape View File

@ -15,7 +15,7 @@ let test_correct_ios_version =
let output = CiOSVersionNumbers.version_of version in let output = CiOSVersionNumbers.version_of version in
let cmp = fun s1 s2 -> Option.equal String.equal s1 s2 in let cmp = fun s1 s2 -> Option.equal String.equal s1 s2 in
assert_equal ~pp_diff:CiOSVersionNumbers.pp_diff_of_version_opt assert_equal ~pp_diff:CiOSVersionNumbers.pp_diff_of_version_opt
~cmp:cmp expected_version output in ~cmp expected_version output in
[ [
( (
"test_correct_ios_version_some_version", "test_correct_ios_version_some_version",

2
infer/src/unit/procCfgTests.ml
Unescape View File

@ -48,7 +48,7 @@ let tests =
let open OUnit2 in let open OUnit2 in
let cmp l1 l2 = let cmp l1 l2 =
let sort = IList.sort Procdesc.Node.compare in let sort = List.sort ~cmp:Procdesc.Node.compare in
List.equal ~equal:Procdesc.Node.equal (sort l1) (sort l2) in List.equal ~equal:Procdesc.Node.equal (sort l1) (sort l2) in
let pp_diff fmt (actual, expected) = let pp_diff fmt (actual, expected) =
let pp_sep fmt _ = F.pp_print_char fmt ',' in let pp_sep fmt _ = F.pp_print_char fmt ',' in

2
infer/src/unit/schedulerTests.ml
Unescape View File

@ -78,7 +78,7 @@ let create_test test_graph expected_result _ =
match S.pop q with match S.pop q with
| Some (n, _, q') -> | Some (n, _, q') ->
pop_schedule_record (S.schedule_succs q' n) (n :: visited_acc) pop_schedule_record (S.schedule_succs q' n) (n :: visited_acc)
| None -> IList.rev visited_acc in | None -> List.rev visited_acc in
let pp_diff fmt (exp, actual) = let pp_diff fmt (exp, actual) =
let pp_sched fmt l = let pp_sched fmt l =
F.pp_print_list ~pp_sep:F.pp_print_space (fun fmt i -> F.fprintf fmt "%d" i) fmt l in F.pp_print_list ~pp_sep:F.pp_print_space (fun fmt i -> F.fprintf fmt "%d" i) fmt l in

Write Preview
Loading…
Cancel
Save