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

Deprecate more IList functions

Browse Source 
Reviewed By: jberdine

Differential Revision: D4597513

fbshipit-source-id: 42c11da
master
Cristiano Calcagno 8 years ago committed by Facebook Github Bot
parent 02ff6589ae
commit 41c5be9bad
78 changed files with 554 additions and 559 deletions
Show Stats Download Patch File Download Diff File

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

@ -83,5 +83,5 @@ let module Method = {
let empty = ([], []); let empty = ([], []);
/** Check if the method annodation is empty. */ /** Check if the method annodation is empty. */
let is_empty (ia, ial) => IList.for_all Item.is_empty [ia, ...ial]; let is_empty (ia, ial) => List.for_all f::Item.is_empty [ia, ...ial];
}; };

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

@ -44,7 +44,7 @@ let create_proc_desc cfg (proc_attributes: ProcAttributes.t) => {
/** Iterate over all the nodes in the cfg */ /** Iterate over all the nodes in the cfg */
let iter_all_nodes sorted::sorted=false f cfg => { let iter_all_nodes sorted::sorted=false f cfg => {
let do_proc_desc _ (pdesc: Procdesc.t) => let do_proc_desc _ (pdesc: Procdesc.t) =>
IList.iter (fun node => f pdesc node) (Procdesc.get_nodes pdesc); List.iter f::(fun node => f pdesc node) (Procdesc.get_nodes pdesc);
if (not sorted) { if (not sorted) {
iter_proc_desc cfg do_proc_desc iter_proc_desc cfg do_proc_desc
} else { } else {
@ -59,7 +59,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)] |> IList.sort [%compare : (Procdesc.t, Procdesc.Node.t)] |>
IList.iter (fun (d, n) => f d n) List.iter f::(fun (d, n) => f d n)
} }
}; };
@ -115,7 +115,7 @@ let check_cfg_connectedness cfg => {
} }
}; };
let pdescs = get_all_procs cfg; let pdescs = get_all_procs cfg;
IList.iter do_pdesc pdescs List.iter f::do_pdesc pdescs
}; };
@ -144,7 +144,7 @@ let save_attributes source_file cfg => {
}; };
AttributesTable.store_attributes attributes' AttributesTable.store_attributes attributes'
}; };
IList.iter save_proc (get_all_procs cfg) List.iter f::save_proc (get_all_procs cfg)
}; };
@ -295,7 +295,7 @@ let mark_unchanged_pdescs cfg_new cfg_old => {
equal::Procdesc.Node.equal (Procdesc.Node.get_preds n1) (Procdesc.Node.get_preds n2) && equal::Procdesc.Node.equal (Procdesc.Node.get_preds n1) (Procdesc.Node.get_preds n2) &&
instrs_eq (Procdesc.Node.get_instrs n1) (Procdesc.Node.get_instrs n2) instrs_eq (Procdesc.Node.get_instrs n1) (Procdesc.Node.get_instrs n2)
}; };
try (IList.for_all2 node_eq n1s n2s) { try (List.for_all2_exn f::node_eq n1s n2s) {
| Invalid_argument _ => false | Invalid_argument _ => false
} }
}; };

18
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;
IList.iter (fun (n, info) => f n info) (IList.sort cmp !table) List.iter f::(fun (n, info) => f n info) (IList.sort cmp !table)
}; };
let get_nodes (g: t) => { let get_nodes (g: t) => {
@ -344,8 +344,8 @@ let get_source (g: t) => g.source;
undefined nodes become defined if at least one side is. */ undefined nodes become defined if at least one side is. */
let extend cg_old cg_new => { let extend cg_old cg_new => {
let (nodes, edges) = get_nodes_and_edges cg_new; let (nodes, edges) = get_nodes_and_edges cg_new;
IList.iter (fun (node, defined) => add_node cg_old node defined::defined) nodes; List.iter f::(fun (node, defined) => add_node cg_old node defined::defined) nodes;
IList.iter (fun (nfrom, nto) => add_edge cg_old nfrom nto) edges List.iter f::(fun (nfrom, nto) => add_edge cg_old nfrom nto) edges
}; };
@ -359,15 +359,15 @@ let load_from_file (filename: DB.filename) :option t =>
| None => None | None => None
| Some (source, (nodes, edges)) => | Some (source, (nodes, edges)) =>
let g = create (Some source); let g = create (Some source);
IList.iter List.iter
( f::(
fun (node, defined) => fun (node, defined) =>
if defined { if defined {
add_defined_node g node add_defined_node g node
} }
) )
nodes; nodes;
IList.iter (fun (nfrom, nto) => add_edge g nfrom nto) edges; List.iter f::(fun (nfrom, nto) => add_edge g nfrom nto) edges;
Some g Some g
}; };
@ -406,8 +406,8 @@ let pp_graph_dotty get_specs (g: t) fmt => {
calls.out_calls calls.out_calls
(num_specs n); (num_specs n);
F.fprintf fmt "digraph {@\n"; F.fprintf fmt "digraph {@\n";
IList.iter List.iter
( f::(
fun nc => fun nc =>
F.fprintf F.fprintf
fmt fmt
@ -420,7 +420,7 @@ let pp_graph_dotty get_specs (g: t) fmt => {
(get_shape nc) (get_shape nc)
) )
nodes_with_calls; nodes_with_calls;
IList.iter (fun (s, d) => F.fprintf fmt "%a -> %a@\n" pp_node s pp_node d) (get_edges g); List.iter f::(fun (s, d) => F.fprintf fmt "%a -> %a@\n" pp_node s pp_node d) (get_edges g);
F.fprintf fmt "}@." F.fprintf fmt "}@."
}; };

2
infer/src/IR/Errlog.ml
Unescape View File

@ -287,7 +287,7 @@ module Err_table = struct
ErrLogHash.iter f err_table; ErrLogHash.iter f err_table;
let pp ekind (nodeidkey, _, loc, ml_loc_opt, _, _, _) fmt err_names = let pp ekind (nodeidkey, _, loc, ml_loc_opt, _, _, _) fmt err_names =
IList.iter (fun (err_name, desc) -> List.iter ~f:(fun (err_name, desc) ->
Exceptions.pp_err nodeidkey loc ekind err_name desc ml_loc_opt fmt ()) err_names in Exceptions.pp_err nodeidkey loc ekind err_name desc ml_loc_opt fmt ()) err_names in
F.fprintf fmt "@.Detailed errors during footprint phase:@."; F.fprintf fmt "@.Detailed errors during footprint phase:@.";
LocMap.iter (fun nslm err_names -> LocMap.iter (fun nslm err_names ->

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

@ -323,7 +323,7 @@ let make_unprimed id =>
/** Update the name generator so that the given id's are not generated again */ /** Update the name generator so that the given id's are not generated again */
let update_name_generator ids => { let update_name_generator ids => {
let upd id => ignore (create_with_stamp id.kind id.name id.stamp); let upd id => ignore (create_with_stamp id.kind id.name id.stamp);
IList.iter upd ids List.iter f::upd ids
}; };

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

@ -333,7 +333,7 @@ struct
| String s -> | String s ->
F.fprintf fmt "%s%s%s" indent s newline F.fprintf fmt "%s%s%s" indent s newline
and pp_forest newline indent fmt forest = and pp_forest newline indent fmt forest =
IList.iter (pp_node newline indent fmt) forest List.iter ~f:(pp_node newline indent fmt) forest
let pp_prelude fmt = pp fmt "%s" "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" let pp_prelude fmt = pp fmt "%s" "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"

2
infer/src/IR/Localise.ml
Unescape View File

@ -783,7 +783,7 @@ let desc_retain_cycle cycle loc cycle_dotty =
str_cycle := !str_cycle ^ step; str_cycle := !str_cycle ^ step;
ct:=!ct +1 ct:=!ct +1
| _ -> () in | _ -> () in
IList.iter do_edge cycle; List.iter ~f:do_edge cycle;
let desc = Format.sprintf "Retain cycle involving the following objects: %s %s" let desc = Format.sprintf "Retain cycle involving the following objects: %s %s"
!str_cycle (at_line tags loc) in !str_cycle (at_line tags loc) in
{ no_desc with descriptions = [desc]; tags = !tags; dotty = cycle_dotty } { no_desc with descriptions = [desc]; tags = !tags; dotty = cycle_dotty }

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

@ -324,7 +324,7 @@ let compute_distance_to_exit_node pdesc => {
node.dist_exit = Some dist; node.dist_exit = Some dist;
next_nodes := node.preds @ !next_nodes next_nodes := node.preds @ !next_nodes
}; };
IList.iter do_node nodes; List.iter f::do_node nodes;
if (!next_nodes != []) { if (!next_nodes != []) {
mark_distance (dist + 1) !next_nodes mark_distance (dist + 1) !next_nodes
} }
@ -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 => IList.iter f (IList.rev (get_nodes pdesc)); let iter_nodes f pdesc => List.iter f::f (IList.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 =>
@ -411,7 +411,7 @@ let fold_calls f acc pdesc => {
let iter_calls f pdesc => fold_calls (fun _ call => f call) () pdesc; let iter_calls f pdesc => fold_calls (fun _ call => f call) () pdesc;
let iter_instrs f pdesc => { let iter_instrs f pdesc => {
let do_node node => IList.iter (fun i => f node i) (Node.get_instrs node); let do_node node => List.iter f::(fun i => f node i) (Node.get_instrs node);
iter_nodes do_node pdesc iter_nodes do_node pdesc
}; };
@ -440,7 +440,7 @@ let iter_slope f pdesc => {
}; };
let iter_slope_calls f pdesc => { let iter_slope_calls f pdesc => {
let do_node node => IList.iter (fun callee_pname => f callee_pname) (Node.get_callees node); let do_node node => List.iter f::(fun callee_pname => f callee_pname) (Node.get_callees node);
iter_slope do_node pdesc iter_slope do_node pdesc
}; };
@ -485,7 +485,7 @@ let append_locals pdesc new_locals =>
let set_succs_exn_base (node: Node.t) succs exn => { let set_succs_exn_base (node: Node.t) succs exn => {
node.succs = succs; node.succs = succs;
node.exn = exn; node.exn = exn;
IList.iter (fun (n: Node.t) => n.preds = [node, ...n.preds]) succs List.iter f::(fun (n: Node.t) => n.preds = [node, ...n.preds]) succs
}; };

4
infer/src/IR/Pvar.re
Unescape View File

@ -157,8 +157,8 @@ let pp_list pe f pvl => F.fprintf f "%a" (Pp.seq (fun f e => F.fprintf f "%a" (p
/** Dump a list of program variables. */ /** Dump a list of program variables. */
let d_list pvl => let d_list pvl =>
IList.iter List.iter
( f::(
fun pv => { fun pv => {
d pv; d pv;
L.d_str " " L.d_str " "

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

@ -660,19 +660,19 @@ let module Predicates: {
let rec process_sexp env => let rec process_sexp env =>
fun fun
| Eexp _ => () | Eexp _ => ()
| Earray _ esel _ => IList.iter (fun (_, se) => process_sexp env se) esel | Earray _ esel _ => List.iter f::(fun (_, se) => process_sexp env se) esel
| Estruct fsel _ => IList.iter (fun (_, se) => process_sexp env se) fsel; | Estruct fsel _ => List.iter f::(fun (_, se) => process_sexp env se) fsel;
/** Process one hpred, updating env */ /** Process one hpred, updating env */
let rec process_hpred env => let rec process_hpred env =>
fun fun
| Hpointsto _ se _ => process_sexp env se | Hpointsto _ se _ => process_sexp env se
| Hlseg _ hpara _ _ _ => { | Hlseg _ hpara _ _ _ => {
IList.iter (process_hpred env) hpara.body; List.iter f::(process_hpred env) hpara.body;
process_hpara env hpara process_hpara env hpara
} }
| Hdllseg _ hpara_dll _ _ _ _ _ => { | Hdllseg _ hpara_dll _ _ _ _ _ => {
IList.iter (process_hpred env) hpara_dll.body_dll; List.iter f::(process_hpred env) hpara_dll.body_dll;
process_hpara_dll env hpara_dll process_hpara_dll env hpara_dll
}; };
@ -1324,7 +1324,7 @@ let fav_is_empty fav =>
/** Check whether a predicate holds for all elements. */ /** Check whether a predicate holds for all elements. */
let fav_for_all fav predicate => IList.for_all predicate !fav; let fav_for_all fav predicate => List.for_all f::predicate !fav;
/** Check whether a predicate holds for some elements. */ /** Check whether a predicate holds for some elements. */
@ -1344,7 +1344,7 @@ let (++) fav id =>
/** extend [fav] with ident list [idl] */ /** extend [fav] with ident list [idl] */
let (+++) fav idl => IList.iter (fun id => fav ++ id) idl; let (+++) fav idl => List.iter f::(fun id => fav ++ id) idl;
/** add identity lists to fav */ /** add identity lists to fav */
@ -1354,7 +1354,7 @@ let ident_list_fav_add idl fav => fav +++ idl;
/** Convert a list to a fav. */ /** Convert a list to a fav. */
let fav_from_list l => { let fav_from_list l => {
let fav = fav_new (); let fav = fav_new ();
let _ = IList.iter (fun id => fav ++ id) l; let _ = List.iter f::(fun id => fav ++ id) l;
fav fav
}; };
@ -1426,7 +1426,7 @@ let rec exp_fav_add fav e =>
switch (e: Exp.t) { switch (e: Exp.t) {
| Var id => fav ++ id | Var id => fav ++ id
| Exn e => exp_fav_add fav e | Exn e => exp_fav_add fav e
| Closure {captured_vars} => IList.iter (fun (e, _, _) => exp_fav_add fav e) captured_vars | Closure {captured_vars} => List.iter f::(fun (e, _, _) => exp_fav_add fav e) captured_vars
| Const (Cint _ | Cfun _ | Cstr _ | Cfloat _ | Cclass _ | Cptr_to_fld _) => () | Const (Cint _ | Cfun _ | Cstr _ | Cfloat _ | Cclass _ | Cptr_to_fld _) => ()
| Cast _ e | Cast _ e
| UnOp _ e _ => exp_fav_add fav e | UnOp _ e _ => exp_fav_add fav e
@ -1462,7 +1462,7 @@ let atom_fav_add fav =>
exp_fav_add fav e2 exp_fav_add fav e2
} }
| Apred _ es | Apred _ es
| Anpred _ es => IList.iter (fun e => exp_fav_add fav e) es; | Anpred _ es => List.iter f::(fun e => exp_fav_add fav e) es;
let atom_fav = fav_imperative_to_functional atom_fav_add; let atom_fav = fav_imperative_to_functional atom_fav_add;
@ -1473,11 +1473,11 @@ let atom_av_add = atom_fav_add;
let rec strexp_fav_add fav => let rec strexp_fav_add fav =>
fun fun
| Eexp e _ => exp_fav_add fav e | Eexp e _ => exp_fav_add fav e
| Estruct fld_se_list _ => IList.iter (fun (_, se) => strexp_fav_add fav se) fld_se_list | Estruct fld_se_list _ => List.iter f::(fun (_, se) => strexp_fav_add fav se) fld_se_list
| Earray len idx_se_list _ => { | Earray len idx_se_list _ => {
exp_fav_add fav len; exp_fav_add fav len;
IList.iter List.iter
( f::(
fun (e, se) => { fun (e, se) => {
exp_fav_add fav e; exp_fav_add fav e;
strexp_fav_add fav se strexp_fav_add fav se
@ -1496,14 +1496,14 @@ let hpred_fav_add fav =>
| Hlseg _ _ e1 e2 elist => { | Hlseg _ _ e1 e2 elist => {
exp_fav_add fav e1; exp_fav_add fav e1;
exp_fav_add fav e2; exp_fav_add fav e2;
IList.iter (exp_fav_add fav) elist List.iter f::(exp_fav_add fav) elist
} }
| Hdllseg _ _ e1 e2 e3 e4 elist => { | Hdllseg _ _ e1 e2 e3 e4 elist => {
exp_fav_add fav e1; exp_fav_add fav e1;
exp_fav_add fav e2; exp_fav_add fav e2;
exp_fav_add fav e3; exp_fav_add fav e3;
exp_fav_add fav e4; exp_fav_add fav e4;
IList.iter (exp_fav_add fav) elist List.iter f::(exp_fav_add fav) elist
}; };
let hpred_fav = fav_imperative_to_functional hpred_fav_add; let hpred_fav = fav_imperative_to_functional hpred_fav_add;
@ -1539,14 +1539,14 @@ let exp_av_add = exp_fav_add; /** Expressions do not bind variables */
let strexp_av_add = strexp_fav_add; /** Structured expressions do not bind variables */ let strexp_av_add = strexp_fav_add; /** Structured expressions do not bind variables */
let rec hpara_av_add fav para => { let rec hpara_av_add fav para => {
IList.iter (hpred_av_add fav) para.body; List.iter f::(hpred_av_add fav) para.body;
fav ++ para.root; fav ++ para.root;
fav ++ para.next; fav ++ para.next;
fav +++ para.svars; fav +++ para.svars;
fav +++ para.evars fav +++ para.evars
} }
and hpara_dll_av_add fav para => { and hpara_dll_av_add fav para => {
IList.iter (hpred_av_add fav) para.body_dll; List.iter f::(hpred_av_add fav) para.body_dll;
fav ++ para.cell; fav ++ para.cell;
fav ++ para.blink; fav ++ para.blink;
fav ++ para.flink; fav ++ para.flink;
@ -1564,7 +1564,7 @@ and hpred_av_add fav =>
hpara_av_add fav para; hpara_av_add fav para;
exp_av_add fav e1; exp_av_add fav e1;
exp_av_add fav e2; exp_av_add fav e2;
IList.iter (exp_av_add fav) elist List.iter f::(exp_av_add fav) elist
} }
| Hdllseg _ para e1 e2 e3 e4 elist => { | Hdllseg _ para e1 e2 e3 e4 elist => {
hpara_dll_av_add fav para; hpara_dll_av_add fav para;
@ -1572,11 +1572,11 @@ and hpred_av_add fav =>
exp_av_add fav e2; exp_av_add fav e2;
exp_av_add fav e3; exp_av_add fav e3;
exp_av_add fav e4; exp_av_add fav e4;
IList.iter (exp_av_add fav) elist List.iter f::(exp_av_add fav) elist
}; };
let hpara_shallow_av_add fav para => { let hpara_shallow_av_add fav para => {
IList.iter (hpred_fav_add fav) para.body; List.iter f::(hpred_fav_add fav) para.body;
fav ++ para.root; fav ++ para.root;
fav ++ para.next; fav ++ para.next;
fav +++ para.svars; fav +++ para.svars;
@ -1584,7 +1584,7 @@ let hpara_shallow_av_add fav para => {
}; };
let hpara_dll_shallow_av_add fav para => { let hpara_dll_shallow_av_add fav para => {
IList.iter (hpred_fav_add fav) para.body_dll; List.iter f::(hpred_fav_add fav) para.body_dll;
fav ++ para.cell; fav ++ para.cell;
fav ++ para.blink; fav ++ para.blink;
fav ++ para.flink; fav ++ para.flink;
@ -1787,8 +1787,8 @@ let extend_sub sub id exp :option subst => {
/** Free auxilary variables in the domain and range of the /** Free auxilary variables in the domain and range of the
substitution. */ substitution. */
let sub_fav_add fav (sub: subst) => let sub_fav_add fav (sub: subst) =>
IList.iter List.iter
( f::(
fun (id, e) => { fun (id, e) => {
fav ++ id; fav ++ id;
exp_fav_add fav e exp_fav_add fav e

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

@ -64,7 +64,7 @@ let add_or_replace tenv prop atom =
let get_all (prop: 'a Prop.t) = 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
IList.iter do_atom prop.pi; List.iter ~f:do_atom prop.pi;
IList.rev !res IList.rev !res
(** Get all the attributes of the prop *) (** Get all the attributes of the prop *)
@ -289,7 +289,7 @@ let deallocate_stack_vars tenv (p: 'a Prop.t) pvars =
let pred = Sil.Apred (Adangling DAaddr_stack_var, [Exp.Var freshv]) in let pred = Sil.Apred (Adangling DAaddr_stack_var, [Exp.Var freshv]) in
res := add_or_replace tenv !res pred res := add_or_replace tenv !res pred
end in end in
IList.iter do_var !fresh_address_vars; List.iter ~f:do_var !fresh_address_vars;
!res in !res in
!stack_vars_address_in_post, List.fold ~f:(Prop.prop_atom_and tenv) ~init:p'' pi !stack_vars_address_in_post, List.fold ~f:(Prop.prop_atom_and tenv) ~init:p'' pi

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

@ -134,7 +134,7 @@ let execute___print_value { Builtin.tenv; pdesc; prop_; path; args; }
let do_arg (lexp, _) = let do_arg (lexp, _) =
let n_lexp, _ = check_arith_norm_exp tenv pname lexp prop_ in let n_lexp, _ = check_arith_norm_exp tenv pname lexp prop_ in
L.err "%a " Exp.pp n_lexp in L.err "%a " Exp.pp n_lexp in
IList.iter do_arg args; List.iter ~f:do_arg args;
L.err "@."; L.err "@.";
[(prop_, path)] [(prop_, path)]

2
infer/src/backend/InferAnalyze.re
Unescape View File

@ -115,7 +115,7 @@ let main makefile => {
if (makefile != "") { if (makefile != "") {
ClusterMakefile.create_cluster_makefile clusters makefile ClusterMakefile.create_cluster_makefile clusters makefile
} else { } else {
IList.iteri (fun i cluster => analyze_cluster i cluster) clusters; List.iteri f::(fun i cluster => analyze_cluster i cluster) clusters;
L.stdout "@\nAnalysis finished in %as@." Pp.elapsed_time () L.stdout "@\nAnalysis finished in %as@." Pp.elapsed_time ()
}; };
output_json_makefile_stats clusters output_json_makefile_stats clusters

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

@ -156,10 +156,10 @@ let summary_values summary => {
let (nr_nodes_visited, lines_visited) = { let (nr_nodes_visited, lines_visited) = {
let visited = ref Specs.Visitedset.empty; let visited = ref Specs.Visitedset.empty;
let do_spec spec => visited := Specs.Visitedset.union spec.Specs.visited !visited; let do_spec spec => visited := Specs.Visitedset.union spec.Specs.visited !visited;
IList.iter do_spec specs; List.iter f::do_spec specs;
let visited_lines = ref Int.Set.empty; let visited_lines = ref Int.Set.empty;
Specs.Visitedset.iter Specs.Visitedset.iter
(fun (_, ls) => IList.iter (fun l => visited_lines := Int.Set.add !visited_lines l) ls) (fun (_, ls) => List.iter f::(fun l => visited_lines := Int.Set.add !visited_lines l) ls)
!visited; !visited;
(Specs.Visitedset.cardinal !visited, Int.Set.elements !visited_lines) (Specs.Visitedset.cardinal !visited, Int.Set.elements !visited_lines)
}; };
@ -552,7 +552,7 @@ let pp_tests_of_report fmt report => {
jsonbug.bug_type jsonbug.bug_type
pp_trace pp_trace
jsonbug.bug_trace; jsonbug.bug_trace;
IList.iter pp_row report List.iter f::pp_row report
}; };
let tests_jsonbug_compare bug1 bug2 => let tests_jsonbug_compare bug1 bug2 =>
@ -592,7 +592,7 @@ let pp_text_of_report fmt report => {
jsonbug.bug_type jsonbug.bug_type
jsonbug.qualifier jsonbug.qualifier
); );
IList.iter pp_row report List.iter f::pp_row report
}; };
let module IssuesXml = { let module IssuesXml = {
@ -770,7 +770,7 @@ let module Stats = {
}; };
res := [line, "", ...!res] res := [line, "", ...!res]
}; };
IList.iter loc_to_string ltr; List.iter f::loc_to_string ltr;
IList.rev !res IList.rev !res
}; };
let process_err_log error_filter linereader err_log stats => { let process_err_log error_filter linereader err_log stats => {
@ -844,7 +844,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";
IList.iter (fun s => F.fprintf fmt "%s@\n" s) (IList.rev stats.saved_errors) List.iter f::(fun s => F.fprintf fmt "%s@\n" s) (IList.rev stats.saved_errors)
}; };
}; };
@ -1041,7 +1041,7 @@ let pp_summary_in_format (format_kind, outf: Utils.outfile) =>
let pp_issues_of_error_log error_filter linereader proc_loc_opt procname err_log bug_format_list => { let pp_issues_of_error_log error_filter linereader proc_loc_opt procname err_log bug_format_list => {
let pp_issues_in_format format => let pp_issues_in_format format =>
pp_issues_in_format format error_filter linereader proc_loc_opt procname err_log; pp_issues_in_format format error_filter linereader proc_loc_opt procname err_log;
IList.iter pp_issues_in_format bug_format_list List.iter f::pp_issues_in_format bug_format_list
}; };
let pp_issues error_filter linereader summary bug_format_list => { let pp_issues error_filter linereader summary bug_format_list => {
@ -1056,7 +1056,7 @@ let pp_procs summary procs_format_list => {
let pp_procs = pp_procs_in_format format; let pp_procs = pp_procs_in_format format;
pp_procs summary pp_procs summary
}; };
IList.iter pp_procs_in_format procs_format_list List.iter f::pp_procs_in_format procs_format_list
}; };
let pp_calls summary calls_format_list => { let pp_calls summary calls_format_list => {
@ -1064,7 +1064,7 @@ let pp_calls summary calls_format_list => {
let pp_calls = pp_calls_in_format format; let pp_calls = pp_calls_in_format format;
pp_calls summary pp_calls summary
}; };
IList.iter pp_calls_in_format calls_format_list List.iter f::pp_calls_in_format calls_format_list
}; };
let pp_stats error_filter linereader summary stats stats_format_list => { let pp_stats error_filter linereader summary stats stats_format_list => {
@ -1072,7 +1072,7 @@ let pp_stats error_filter linereader summary stats stats_format_list => {
let pp_stats = pp_stats_in_format format; let pp_stats = pp_stats_in_format format;
pp_stats error_filter summary linereader stats pp_stats error_filter summary linereader stats
}; };
IList.iter pp_stats_in_format stats_format_list List.iter f::pp_stats_in_format stats_format_list
}; };
let pp_summary summary fname summary_format_list => { let pp_summary summary fname summary_format_list => {
@ -1080,7 +1080,7 @@ let pp_summary summary fname summary_format_list => {
let pp_summary = pp_summary_in_format format; let pp_summary = pp_summary_in_format format;
pp_summary summary pp_summary summary
}; };
IList.iter pp_summary_in_format summary_format_list; List.iter f::pp_summary_in_format summary_format_list;
Summary.pp_summary_out summary; Summary.pp_summary_out summary;
Summary.pp_summary_xml summary fname; Summary.pp_summary_xml summary fname;
Summary.print_summary_dot_svg summary fname Summary.print_summary_dot_svg summary fname
@ -1103,7 +1103,7 @@ let pp_summary_by_report_kind
| (Summary, _) => pp_summary summary fname format_list | (Summary, _) => pp_summary summary fname format_list
| _ => () | _ => ()
}; };
IList.iter pp_summary_by_report_kind formats_by_report_kind List.iter f::pp_summary_by_report_kind formats_by_report_kind
}; };
let pp_json_report_by_report_kind formats_by_report_kind fname => let pp_json_report_by_report_kind formats_by_report_kind fname =>
@ -1119,7 +1119,7 @@ let pp_json_report_by_report_kind formats_by_report_kind fname =>
| Xml => failwith "Printing issues from json does not support xml output" | Xml => failwith "Printing issues from json does not support xml output"
| Latex => failwith "Printing issues from json does not support latex output" | Latex => failwith "Printing issues from json does not support latex output"
}; };
IList.iter pp_json_issue format_list List.iter f::pp_json_issue format_list
}; };
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);
@ -1130,7 +1130,7 @@ let pp_json_report_by_report_kind formats_by_report_kind fname =>
| (Issues, [_, ..._]) => pp_json_issues format_list sorted_report | (Issues, [_, ..._]) => pp_json_issues format_list sorted_report
| _ => () | _ => ()
}; };
IList.iter pp_report_by_report_kind formats_by_report_kind List.iter f::pp_report_by_report_kind formats_by_report_kind
| None => failwithf "Error reading %s. Does the file exist?" fname | None => failwithf "Error reading %s. Does the file exist?" fname
}; };
@ -1141,7 +1141,7 @@ let pp_lint_issues_by_report_kind formats_by_report_kind error_filter linereader
pp_issues_of_error_log error_filter linereader None procname error_log format_list pp_issues_of_error_log error_filter linereader None procname error_log format_list
| _ => () | _ => ()
}; };
IList.iter pp_summary_by_report_kind formats_by_report_kind List.iter f::pp_summary_by_report_kind formats_by_report_kind
}; };
@ -1173,8 +1173,8 @@ let module AnalysisResults = {
if CLOpt.is_originator { if CLOpt.is_originator {
/* Find spec files specified by command-line arguments. Not run at init time since the specs /* Find spec files specified by command-line arguments. Not run at init time since the specs
files may be generated between init and report time. */ files may be generated between init and report time. */
IList.iter List.iter
( f::(
fun arg => fun arg =>
if (not (Filename.check_suffix arg Config.specs_files_suffix) && arg != ".") { if (not (Filename.check_suffix arg Config.specs_files_suffix) && arg != ".") {
print_usage_exit ("file " ^ arg ^ ": arguments must be .specs files") print_usage_exit ("file " ^ arg ^ ": arguments must be .specs files")
@ -1214,7 +1214,7 @@ let module AnalysisResults = {
exit 0 exit 0
| Some summary => summaries := [(fname, summary), ...!summaries] | Some summary => summaries := [(fname, summary), ...!summaries]
}; };
apply_without_gc (IList.iter load_file) (spec_files_from_cmdline ()); apply_without_gc (List.iter f::load_file) (spec_files_from_cmdline ());
let summ_cmp (_, summ1) (_, summ2) => { let summ_cmp (_, summ1) (_, summ2) => {
let n = let n =
SourceFile.compare SourceFile.compare
@ -1241,7 +1241,7 @@ let module AnalysisResults = {
exit 0 exit 0
| Some summary => f (fname, summary) | Some summary => f (fname, summary)
}; };
let iterate f => IList.iter (do_spec f) sorted_spec_files; let iterate f => List.iter f::(do_spec f) sorted_spec_files;
iterate iterate
}; };
@ -1260,7 +1260,7 @@ let module AnalysisResults = {
If options - load_results or - save_results are used, If options - load_results or - save_results are used,
all the summaries are loaded in memory */ all the summaries are loaded in memory */
let get_summary_iterator () => { let get_summary_iterator () => {
let iterator_of_summary_list r f => IList.iter f r; let iterator_of_summary_list r f => List.iter f::f r;
switch Config.load_analysis_results { switch Config.load_analysis_results {
| None => | None =>
switch Config.save_analysis_results { switch Config.save_analysis_results {
@ -1334,9 +1334,9 @@ let init_files format_list_by_kind => {
| (Latex, Summary) => begin_latex_file outfile.fmt | (Latex, Summary) => begin_latex_file outfile.fmt
| (Csv | Json | Latex | Tests | Text | Xml, _) => () | (Csv | Json | Latex | Tests | Text | Xml, _) => ()
}; };
IList.iter init_files_of_format format_list List.iter f::init_files_of_format format_list
}; };
IList.iter init_files_of_report_kind format_list_by_kind List.iter f::init_files_of_report_kind format_list_by_kind
}; };
let finalize_and_close_files format_list_by_kind stats pdflatex => { let finalize_and_close_files format_list_by_kind stats pdflatex => {
@ -1361,10 +1361,10 @@ let finalize_and_close_files format_list_by_kind stats pdflatex => {
ignore (Sys.command ("open " ^ pdf_name)) ignore (Sys.command ("open " ^ pdf_name))
} }
}; };
IList.iter close_files_of_format format_list; List.iter f::close_files_of_format format_list;
() ()
}; };
IList.iter close_files_of_report_kind format_list_by_kind List.iter f::close_files_of_report_kind format_list_by_kind
}; };
let pp_summary_and_issues formats_by_report_kind => { let pp_summary_and_issues formats_by_report_kind => {

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

@ -478,7 +478,7 @@ let discover_para_candidates tenv p =
match nextse with match nextse with
| Sil.Eexp (next, _) -> add_edge (root, next) | Sil.Eexp (next, _) -> add_edge (root, next)
| _ -> assert false in | _ -> assert false in
IList.iter process fsel' in List.iter ~f:process fsel' in
let rec get_edges_sigma = function let rec get_edges_sigma = function
| [] -> () | [] -> ()
| Sil.Hlseg _ :: sigma_rest | Sil.Hdllseg _ :: sigma_rest -> | Sil.Hlseg _ :: sigma_rest | Sil.Hdllseg _ :: sigma_rest ->
@ -517,7 +517,7 @@ let discover_para_dll_candidates tenv p =
let links = IList.rev (List.fold ~f:convert_to_exp ~init:[] fsel') in let links = IList.rev (List.fold ~f:convert_to_exp ~init:[] fsel') in
let rec iter_pairs = function let rec iter_pairs = function
| [] -> () | [] -> ()
| x:: l -> (IList.iter (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
iter_pairs links in iter_pairs links in
let rec get_edges_sigma = function let rec get_edges_sigma = function
| [] -> () | [] -> ()
@ -852,8 +852,8 @@ let sigma_reachable root_fav sigma =
let do_hpred hpred = let do_hpred hpred =
let hp_fav_set = fav_to_set (Sil.hpred_fav hpred) in let hp_fav_set = fav_to_set (Sil.hpred_fav hpred) in
let add_entry e = edges := (e, hp_fav_set) :: !edges in let add_entry e = edges := (e, hp_fav_set) :: !edges in
IList.iter add_entry (hpred_entries hpred) in List.iter ~f:add_entry (hpred_entries hpred) in
IList.iter do_hpred sigma; List.iter ~f:do_hpred sigma;
let edge_fires (e, _) = match e with let edge_fires (e, _) = match e with
| Exp.Var id -> | Exp.Var id ->
if (Ident.is_primed id || Ident.is_footprint id) then Ident.IdentSet.mem id !reach_set if (Ident.is_primed id || Ident.is_footprint id) then Ident.IdentSet.mem id !reach_set
@ -890,7 +890,7 @@ let get_cycle root prop =
| _ -> None in | _ -> None in
let print_cycle cyc = let print_cycle cyc =
(L.d_str "Cycle= "; (L.d_str "Cycle= ";
IList.iter (fun ((e, t), f, e') -> List.iter ~f:(fun ((e, t), f, e') ->
match e, e' with match e, e' with
| Sil.Eexp (e, _), Sil.Eexp (e', _) -> | Sil.Eexp (e, _), Sil.Eexp (e', _) ->
L.d_str ("("^(Exp.to_string e)^": "^(Typ.to_string t)^", " L.d_str ("("^(Exp.to_string e)^": "^(Typ.to_string t)^", "
@ -1063,7 +1063,7 @@ let check_junk ?original_prop pname tenv prop =
(Ident.is_primed id || Ident.is_footprint id) (Ident.is_primed id || Ident.is_footprint id)
&& not (Sil.fav_mem fav_root id) && not (id_considered_reachable id) && not (Sil.fav_mem fav_root id) && not (id_considered_reachable id)
| _ -> false in | _ -> false in
IList.for_all predicate entries in List.for_all ~f:predicate entries in
let hpred_in_cycle hpred = (* check if the predicate belongs to a cycle in the heap *) let hpred_in_cycle hpred = (* check if the predicate belongs to a cycle in the heap *)
let id_in_cycle id = let id_in_cycle id =
let set1 = sigma_reachable (Sil.fav_from_list [id]) sigma in let set1 = sigma_reachable (Sil.fav_from_list [id]) sigma in
@ -1111,7 +1111,7 @@ let check_junk ?original_prop pname tenv prop =
| Some (Apred (Aundef _ as a, _)) -> | Some (Apred (Aundef _ as a, _)) ->
res := Some a res := Some a
| _ -> ()) in | _ -> ()) in
IList.iter do_entry entries; List.iter ~f:do_entry entries;
!res in !res in
L.d_decrease_indent 1; L.d_decrease_indent 1;
let is_undefined = let is_undefined =

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

@ -542,11 +542,13 @@ let check_after_array_abstraction tenv prop =
| Sil.Earray (_, esel, _) -> (* check that no more than 2 elements are in the array *) | Sil.Earray (_, esel, _) -> (* check that no more than 2 elements are in the array *)
let typ_elem = Typ.array_elem (Some Typ.Tvoid) typ in let typ_elem = Typ.array_elem (Some Typ.Tvoid) typ in
if IList.length esel > 2 && array_typ_can_abstract typ then if IList.length esel > 2 && array_typ_can_abstract typ then
if IList.for_all (check_index root offs) esel then () if List.for_all ~f:(check_index root offs) esel then ()
else report_error prop else report_error prop
else IList.iter (fun (ind, se) -> check_se root (offs @ [Sil.Off_index ind]) typ_elem se) esel else List.iter
~f:(fun (ind, se) -> check_se root (offs @ [Sil.Off_index ind]) typ_elem se)
esel
| Sil.Estruct (fsel, _) -> | Sil.Estruct (fsel, _) ->
IList.iter (fun (f, se) -> List.iter ~f:(fun (f, se) ->
let typ_f = StructTyp.fld_typ ~lookup ~default:Tvoid f typ in let typ_f = StructTyp.fld_typ ~lookup ~default:Tvoid f typ in
check_se root (offs @ [Sil.Off_fld (f, typ)]) typ_f se) fsel in check_se root (offs @ [Sil.Off_fld (f, typ)]) typ_f se) fsel in
let check_hpred = function let check_hpred = function
@ -554,7 +556,7 @@ let check_after_array_abstraction tenv prop =
let typ = Exp.texp_to_typ (Some Typ.Tvoid) texp in let typ = Exp.texp_to_typ (Some Typ.Tvoid) texp in
check_se root [] typ se check_se root [] typ se
| Sil.Hlseg _ | Sil.Hdllseg _ -> () in | Sil.Hlseg _ | Sil.Hdllseg _ -> () in
let check_sigma sigma = IList.iter check_hpred sigma in let check_sigma sigma = List.iter ~f:check_hpred sigma in
(* check_footprint_pure prop; *) (* check_footprint_pure prop; *)
check_sigma prop.Prop.sigma; check_sigma prop.Prop.sigma;
check_sigma prop.Prop.sigma_fp check_sigma prop.Prop.sigma_fp
@ -580,8 +582,6 @@ let remove_redundant_elements tenv prop =
let favl_curr = Sil.fav_to_list fav_curr in let favl_curr = Sil.fav_to_list fav_curr in
let favl_foot = Sil.fav_to_list fav_foot in let favl_foot = Sil.fav_to_list fav_foot in
Sil.fav_duplicates := false; Sil.fav_duplicates := false;
(* L.d_str "favl_curr "; IList.iter (fun id -> Sil.d_exp (Exp.Var id)) favl_curr; L.d_ln();
L.d_str "favl_foot "; IList.iter (fun id -> Sil.d_exp (Exp.Var id)) favl_foot; L.d_ln(); *)
let num_occur l id = IList.length (List.filter ~f:(fun id' -> Ident.equal id id') l) in let num_occur l id = IList.length (List.filter ~f:(fun id' -> Ident.equal id id') l) in
let at_most_once v = let at_most_once v =
num_occur favl_curr v <= 1 && num_occur favl_foot v <= 1 in num_occur favl_curr v <= 1 && num_occur favl_foot v <= 1 in

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

@ -70,7 +70,7 @@ let check_access access_opt de_opt =
Config.curr_language_is Config.Java && Pvar.is_this pvar in Config.curr_language_is Config.Java && Pvar.is_this pvar in
if not is_java_this && is_formal pvar then formal_ids := id :: !formal_ids if not is_java_this && is_formal pvar then formal_ids := id :: !formal_ids
| _ -> () in | _ -> () in
IList.iter process_formal_letref node_instrs; List.iter ~f:process_formal_letref node_instrs;
!formal_ids in !formal_ids in
let formal_param_used_in_call = ref false in let formal_param_used_in_call = ref false in
let has_call_or_sets_null node = let has_call_or_sets_null node =

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

@ -58,7 +58,7 @@ let pp_registered fmt () =
builtin_names := IList.sort Procname.compare !builtin_names; builtin_names := IList.sort Procname.compare !builtin_names;
let pp pname = Format.fprintf fmt "%a@\n" Procname.pp pname in let pp pname = Format.fprintf fmt "%a@\n" Procname.pp pname in
Format.fprintf fmt "Registered builtins:@\n @["; Format.fprintf fmt "Registered builtins:@\n @[";
IList.iter pp !builtin_names; List.iter ~f:pp !builtin_names;
Format.fprintf fmt "@]@." Format.fprintf fmt "@]@."
(** print the builtin functions and exit *) (** print the builtin functions and exit *)

62
infer/src/backend/callbacks.ml
Unescape View File

@ -83,26 +83,26 @@ let iterate_procedure_callbacks exe_env caller_pname =
Option.iter Option.iter
~f:(fun (idenv, tenv, proc_name, proc_desc, _) -> ~f:(fun (idenv, tenv, proc_name, proc_desc, _) ->
IList.iter List.iter
(fun (language_opt, proc_callback) -> ~f:(fun (language_opt, proc_callback) ->
let language_matches = match language_opt with let language_matches = match language_opt with
| Some language -> Config.equal_language language procedure_language | Some language -> Config.equal_language language procedure_language
| None -> true in | None -> true in
if language_matches then if language_matches then
begin begin
let init_time = Unix.gettimeofday () in let init_time = Unix.gettimeofday () in
proc_callback proc_callback
{ {
get_proc_desc; get_proc_desc;
get_procs_in_file; get_procs_in_file;
idenv; idenv;
tenv; tenv;
proc_name; proc_name;
proc_desc; proc_desc;
}; };
let elapsed = Unix.gettimeofday () -. init_time in let elapsed = Unix.gettimeofday () -. init_time in
update_time proc_name elapsed update_time proc_name elapsed
end) end)
!procedure_callbacks) !procedure_callbacks)
(get_procedure_definition exe_env caller_pname) (get_procedure_definition exe_env caller_pname)
@ -126,11 +126,11 @@ let iterate_cluster_callbacks all_procs exe_env proc_names =
~default:proc_names ~default:proc_names
language_opt in language_opt in
IList.iter List.iter
(fun (language_opt, cluster_callback) -> ~f:(fun (language_opt, cluster_callback) ->
let proc_names = relevant_procedures language_opt in let proc_names = relevant_procedures language_opt in
if IList.length proc_names > 0 then if IList.length proc_names > 0 then
cluster_callback exe_env all_procs get_procdesc environment) cluster_callback exe_env all_procs get_procdesc environment)
!cluster_callbacks !cluster_callbacks
(** Invoke all procedure and cluster callbacks on a given environment. *) (** Invoke all procedure and cluster callbacks on a given environment. *)
@ -168,17 +168,17 @@ let iterate_callbacks store_summary call_graph exe_env =
then Specs.reset_summary call_graph proc_name attributes_opt None in then Specs.reset_summary call_graph proc_name attributes_opt None in
(* Make sure summaries exists. *) (* Make sure summaries exists. *)
IList.iter reset_summary procs_to_analyze; List.iter ~f:reset_summary procs_to_analyze;
(* Invoke callbacks. *) (* Invoke callbacks. *)
IList.iter List.iter
(iterate_procedure_callbacks exe_env) ~f:(iterate_procedure_callbacks exe_env)
procs_to_analyze; procs_to_analyze;
IList.iter List.iter
(iterate_cluster_callbacks originally_defined_procs exe_env) ~f:(iterate_cluster_callbacks originally_defined_procs exe_env)
(cluster procs_to_analyze); (cluster procs_to_analyze);
IList.iter store_summary procs_to_analyze; List.iter ~f:store_summary procs_to_analyze;
Config.curr_language := saved_language Config.curr_language := saved_language

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

@ -51,10 +51,10 @@ let pp_prolog fmt clusters =
compilation_dbs_cmd; compilation_dbs_cmd;
F.fprintf fmt "CLUSTERS="; F.fprintf fmt "CLUSTERS=";
IList.iteri List.iteri
(fun i cl -> ~f:(fun i cl ->
if cluster_should_be_analyzed cl if cluster_should_be_analyzed cl
then F.fprintf fmt "%a " Cluster.pp_cluster_name (i+1)) then F.fprintf fmt "%a " Cluster.pp_cluster_name (i+1))
clusters; clusters;
F.fprintf fmt "@.@.default: test@.@.all: test@.@."; F.fprintf fmt "@.@.default: test@.@.all: test@.@.";
@ -71,6 +71,6 @@ let create_cluster_makefile (clusters: Cluster.t list) (fname: string) =
F.fprintf fmt "#%s@\n" (DB.source_dir_to_string cluster); F.fprintf fmt "#%s@\n" (DB.source_dir_to_string cluster);
Cluster.pp_cluster fmt (cluster_nr + 1, cluster) in Cluster.pp_cluster fmt (cluster_nr + 1, cluster) in
pp_prolog fmt clusters; pp_prolog fmt clusters;
IList.iteri do_cluster clusters; List.iteri ~f:do_cluster clusters;
pp_epilog fmt () ; pp_epilog fmt () ;
Out_channel.close outc Out_channel.close outc

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

@ -111,7 +111,7 @@ let collect_all_summaries root_summaries_dir stacktrace_file stacktraces_dir =
| Some pair -> pair :: pairs_for_stactrace_dir in | Some pair -> pair :: pairs_for_stactrace_dir in
let process_stacktrace (stacktrace_file, out_file) = let process_stacktrace (stacktrace_file, out_file) =
stitch_summaries stacktrace_file method_summaries out_file in stitch_summaries stacktrace_file method_summaries out_file in
IList.iter process_stacktrace input_output_file_pairs List.iter ~f:process_stacktrace input_output_file_pairs
let crashcontext_epilogue ~in_buck_mode = let crashcontext_epilogue ~in_buck_mode =
(* if we are the top-level process, then find the output directory and (* if we are the top-level process, then find the output directory and

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

@ -185,8 +185,8 @@ end = struct
| v:: vars', _ -> | v:: vars', _ ->
let r = find' tbl v in let r = find' tbl v in
let set = lookup_const' const_tbl r in let set = lookup_const' const_tbl r in
(IList.for_all (fun v' -> Exp.equal (find' tbl v') r) vars') && (List.for_all ~f:(fun v' -> Exp.equal (find' tbl v') r) vars') &&
(IList.for_all (fun c -> Exp.Set.mem c set) nonvars) (List.for_all ~f:(fun c -> Exp.Set.mem c set) nonvars)
end end
@ -578,7 +578,7 @@ end = struct
lost_little side e assoc_es in lost_little side e assoc_es in
let lhs_es = IList.map (fun (e1, _, _) -> e1) !tbl in let lhs_es = IList.map (fun (e1, _, _) -> e1) !tbl in
let rhs_es = IList.map (fun (_, e2, _) -> e2) !tbl in let rhs_es = IList.map (fun (_, e2, _) -> e2) !tbl in
(IList.for_all (f Rhs) rhs_es) && (IList.for_all (f Lhs) lhs_es) (List.for_all ~f:(f Rhs) rhs_es) && (List.for_all ~f:(f Lhs) lhs_es)
let lookup_side' side e = let lookup_side' side e =
let f (e1, e2, _) = Exp.equal e (select side e1 e2) in let f (e1, e2, _) = Exp.equal e (select side e1 e2) in
@ -599,7 +599,7 @@ end = struct
res := v'::!res res := v'::!res
| _ -> () in | _ -> () in
begin begin
IList.iter f !tbl; List.iter ~f:f !tbl;
IList.rev !res IList.rev !res
end end
@ -715,11 +715,11 @@ end = struct
build_other_atoms (fun e0 -> Prop.mk_neq tenv e0 e') side e build_other_atoms (fun e0 -> Prop.mk_neq tenv e0 e') side e
| Sil.Apred (a, (Var id as e) :: es) | Sil.Apred (a, (Var id as e) :: es)
when not (Ident.is_normal id) && IList.for_all exp_contains_only_normal_ids es -> when not (Ident.is_normal id) && List.for_all ~f:exp_contains_only_normal_ids es ->
build_other_atoms (fun e0 -> Prop.mk_pred tenv a (e0 :: es)) side e build_other_atoms (fun e0 -> Prop.mk_pred tenv a (e0 :: es)) side e
| Sil.Anpred (a, (Var id as e) :: es) | Sil.Anpred (a, (Var id as e) :: es)
when not (Ident.is_normal id) && IList.for_all exp_contains_only_normal_ids es -> when not (Ident.is_normal id) && List.for_all ~f:exp_contains_only_normal_ids es ->
build_other_atoms (fun e0 -> Prop.mk_npred tenv a (e0 :: es)) side e build_other_atoms (fun e0 -> Prop.mk_npred tenv a (e0 :: es)) side e
| Sil.Aeq((Exp.Var id as e), e') | Sil.Aeq(e', (Exp.Var id as e)) | Sil.Aeq((Exp.Var id as e), e') | Sil.Aeq(e', (Exp.Var id as e))
@ -1571,7 +1571,7 @@ let pi_partial_join tenv mode
| Sil.Hpointsto (_, Sil.Earray (Exp.Const (Const.Cint n), _, _), _) -> | Sil.Hpointsto (_, Sil.Earray (Exp.Const (Const.Cint n), _, _), _) ->
(if IntLit.geq n IntLit.one then len_list := n :: !len_list) (if IntLit.geq n IntLit.one then len_list := n :: !len_list)
| _ -> () in | _ -> () in
IList.iter do_hpred prop.Prop.sigma; List.iter ~f:do_hpred prop.Prop.sigma;
!len_list in !len_list in
let bounds = let bounds =
let bounds1 = get_array_len ep1 in let bounds1 = get_array_len ep1 in
@ -1686,7 +1686,7 @@ let pi_partial_meet tenv (p: Prop.normal Prop.t) (ep1: 'a Prop.t) (ep2: 'b Prop.
let handle_atom sub dom atom = let handle_atom sub dom atom =
let fav_list = Sil.fav_to_list (Sil.atom_fav atom) in let fav_list = Sil.fav_to_list (Sil.atom_fav atom) in
if IList.for_all (fun id -> Ident.IdentSet.mem id dom) fav_list then if List.for_all ~f:(fun id -> Ident.IdentSet.mem id dom) fav_list then
Sil.atom_sub sub atom Sil.atom_sub sub atom
else (L.d_str "handle_atom failed on "; Sil.d_atom atom; L.d_ln (); raise IList.Fail) in else (L.d_str "handle_atom failed on "; Sil.d_atom atom; L.d_ln (); raise IList.Fail) in
let f1 p' atom = let f1 p' atom =
@ -1719,13 +1719,13 @@ 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 && IList.for_all f range1 in Sil.equal_subst sub1 sub2 && List.for_all ~f:f range1 in
if not (sub_check ()) then if not (sub_check ()) then
(L.d_strln "sub_check() failed"; raise IList.Fail) (L.d_strln "sub_check() failed"; raise IList.Fail)
else begin else begin
let todos = IList.map (fun x -> (x, x, x)) es in let todos = IList.map (fun x -> (x, x, x)) es in
IList.iter Todo.push todos; List.iter ~f:Todo.push todos;
let sigma_new = sigma_partial_meet tenv sigma1 sigma2 in let sigma_new = sigma_partial_meet tenv sigma1 sigma2 in
let ep = Prop.set ep1 ~sigma:sigma_new in let ep = Prop.set ep1 ~sigma:sigma_new in
let ep' = Prop.set ep ~pi:[] in let ep' = Prop.set ep ~pi:[] in
@ -1785,7 +1785,7 @@ let eprop_partial_join' tenv mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed
raise IList.Fail raise IList.Fail
end; end;
let todos = IList.map (fun x -> (x, x, x)) es1 in let todos = IList.map (fun x -> (x, x, x)) es1 in
IList.iter Todo.push todos; List.iter ~f:Todo.push todos;
match sigma_partial_join tenv mode sigma1 sigma2 with match sigma_partial_join tenv mode sigma1 sigma2 with
| sigma_new, [], [] -> | sigma_new, [], [] ->
L.d_strln "sigma_partial_join succeeded"; L.d_strln "sigma_partial_join succeeded";

58
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 := [];
IList.iter f pi List.iter ~f: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
@ -357,8 +357,8 @@ let compute_fields_struct sigma =
let rec do_strexp se in_struct = let rec do_strexp se in_struct =
match se with match se with
| Sil.Eexp (e, _) -> if in_struct then fields_structs:= e ::!fields_structs else () | Sil.Eexp (e, _) -> if in_struct then fields_structs:= e ::!fields_structs else ()
| Sil.Estruct (l, _) -> IList.iter (fun e -> do_strexp e true) (snd (List.unzip l)) | Sil.Estruct (l, _) -> List.iter ~f:(fun e -> do_strexp e true) (snd (List.unzip l))
| Sil.Earray (_, l, _) -> IList.iter (fun e -> do_strexp e false) (snd (List.unzip l)) in | Sil.Earray (_, l, _) -> List.iter ~f:(fun e -> do_strexp e false) (snd (List.unzip l)) in
let rec fs s = let rec fs s =
match s with match s with
| [] -> () | [] -> ()
@ -512,7 +512,7 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle =
(match src with (match src with
| [] -> assert false | [] -> assert false
| nl -> | nl ->
(* L.out "@\n@\n List of nl= "; IList.iter (L.out " %i ") nl; L.out "@.@.@."; *) (* L.out "@\n@\n List of nl= "; List.iter ~f:(L.out " %i ") nl; L.out "@.@.@."; *)
let target_list = compute_target_struct_fields dotnodes lfld p f lambda cycle in let target_list = compute_target_struct_fields dotnodes lfld p f lambda cycle in
let ff n = IList.map (fun (k, lab_src, m, lab_trg) -> let ff n = IList.map (fun (k, lab_src, m, lab_trg) ->
mk_link k (mk_coordinate n lambda) lab_src (mk_coordinate m lambda) lab_trg mk_link k (mk_coordinate n lambda) lab_src (mk_coordinate m lambda) lab_trg
@ -679,7 +679,7 @@ let filter_useless_spec_dollar_box (nodes: dotty_node list) (links: link list) =
end end
end end
| _ -> () in | _ -> () in
IList.iter handle_one_node nodes; List.iter ~f:handle_one_node nodes;
(!tmp_nodes,!tmp_links) (!tmp_nodes,!tmp_links)
(* print a struct node *) (* print a struct node *)
@ -793,10 +793,10 @@ and build_visual_graph f pe p cycle =
compute_fields_struct sigma; compute_fields_struct sigma;
compute_struct_exp_nodes sigma; compute_struct_exp_nodes sigma;
(* L.out "@\n@\n Computed fields structs: "; (* L.out "@\n@\n Computed fields structs: ";
IList.iter (fun e -> L.out " %a " (Sil.pp_exp_printenv pe) e) !fields_structs; List.iter ~f:(fun e -> L.out " %a " (Sil.pp_exp_printenv pe) e) !fields_structs;
L.out "@\n@."; L.out "@\n@.";
L.out "@\n@\n Computed exp structs nodes: "; L.out "@\n@\n Computed exp structs nodes: ";
IList.iter (fun e -> L.out " %a " (Sil.pp_exp_printenv pe) e) !struct_exp_nodes; List.iter ~f:(fun e -> L.out " %a " (Sil.pp_exp_printenv pe) e) !struct_exp_nodes;
L.out "@\n@."; *) L.out "@\n@."; *)
let sigma_lambda = IList.map (fun hp -> (hp,!lambda_counter)) sigma in let sigma_lambda = IList.map (fun hp -> (hp,!lambda_counter)) sigma in
let nodes = (dotty_mk_node pe) sigma_lambda in let nodes = (dotty_mk_node pe) sigma_lambda in
@ -853,11 +853,11 @@ and pp_dotty f kind (_prop: Prop.normal Prop.t) cycle =
let (nodes, links) = build_visual_graph f pe prop cycle in let (nodes, links) = build_visual_graph f pe prop cycle in
let all_nodes = (nodes @ !dangling_dotboxes @ !nil_dotboxes) in let all_nodes = (nodes @ !dangling_dotboxes @ !nil_dotboxes) in
if !print_full_prop then if !print_full_prop then
IList.iter ((dotty_pp_state f pe) cycle) all_nodes List.iter ~f:((dotty_pp_state f pe) cycle) all_nodes
else else
IList.iter (fun node -> List.iter ~f:(fun node ->
if node_in_cycle cycle node then (dotty_pp_state f pe) cycle node) all_nodes; if node_in_cycle cycle node then (dotty_pp_state f pe) cycle node) all_nodes;
IList.iter (dotty_pp_link f) links; List.iter ~f:(dotty_pp_link f) links;
(* F.fprintf f "\n } \n"; *) (* F.fprintf f "\n } \n"; *)
F.fprintf f "\n } \n" F.fprintf f "\n } \n"
@ -873,16 +873,16 @@ let pp_dotty_one_spec f pre posts =
invisible_arrows:= true; invisible_arrows:= true;
pp_dotty f Spec_precondition pre None; pp_dotty f Spec_precondition pre None;
invisible_arrows:= false; invisible_arrows:= false;
IList.iter (fun (po, _) -> incr post_counter ; pp_dotty f (Spec_postcondition pre) po None; List.iter ~f:(fun (po, _) -> incr post_counter ; pp_dotty f (Spec_postcondition pre) po None;
for j = 1 to 4 do for j = 1 to 4 do
F.fprintf f " inv_%i%i%i%i -> state_pi_%i [style=invis]\n" F.fprintf f " inv_%i%i%i%i -> state_pi_%i [style=invis]\n"
!spec_counter !spec_counter
j j
j j
j j
!target_invisible_arrow_pre; !target_invisible_arrow_pre;
done done
) posts; ) posts;
F.fprintf f "\n } \n" F.fprintf f "\n } \n"
(* this is used to print a list of proposition when considered in a path of nodes *) (* this is used to print a list of proposition when considered in a path of nodes *)
@ -893,8 +893,8 @@ let pp_dotty_prop_list_in_path f plist prev_n curr_n =
F.fprintf f "\n subgraph cluster_%i { color=blue \n" !dotty_state_count; F.fprintf f "\n subgraph cluster_%i { color=blue \n" !dotty_state_count;
incr dotty_state_count; incr dotty_state_count;
F.fprintf f "\n state%iN [label=\"NODE %i \", style=filled, color= lightblue]\n" curr_n curr_n; F.fprintf f "\n state%iN [label=\"NODE %i \", style=filled, color= lightblue]\n" curr_n curr_n;
IList.iter (fun po -> incr proposition_counter ; List.iter ~f:(fun po -> incr proposition_counter ;
pp_dotty f Generic_proposition po None) plist; pp_dotty f Generic_proposition po None) plist;
if prev_n <> - 1 then F.fprintf f "\n state%iN ->state%iN\n" prev_n curr_n; if prev_n <> - 1 then F.fprintf f "\n state%iN ->state%iN\n" prev_n curr_n;
F.fprintf f "\n } \n" F.fprintf f "\n } \n"
with exn when SymOp.exn_not_failure exn -> with exn when SymOp.exn_not_failure exn ->
@ -947,11 +947,11 @@ let pp_cfgnodename pname fmt (n : Procdesc.Node.t) =
F.fprintf fmt "\"%s_%d\"" (Procname.to_filename pname) (Procdesc.Node.get_id n :> int) F.fprintf fmt "\"%s_%d\"" (Procname.to_filename pname) (Procdesc.Node.get_id n :> int)
let pp_etlist fmt etl = let pp_etlist fmt etl =
IList.iter (fun (id, ty) -> List.iter ~f:(fun (id, ty) ->
Format.fprintf fmt " %a:%a" Mangled.pp id (Typ.pp_full Pp.text) ty) etl Format.fprintf fmt " %a:%a" Mangled.pp id (Typ.pp_full Pp.text) ty) etl
let pp_local_list fmt etl = let pp_local_list fmt etl =
IList.iter (fun (id, ty) -> List.iter ~f:(fun (id, ty) ->
Format.fprintf fmt " %a:%a" Mangled.pp id (Typ.pp_full Pp.text) ty) etl Format.fprintf fmt " %a:%a" Mangled.pp id (Typ.pp_full Pp.text) ty) etl
let pp_cfgnodelabel pdesc fmt (n : Procdesc.Node.t) = let pp_cfgnodelabel pdesc fmt (n : Procdesc.Node.t) =
@ -983,7 +983,7 @@ let pp_cfgnodelabel pdesc fmt (n : Procdesc.Node.t) =
let str = F.asprintf "%t" pp in let str = F.asprintf "%t" pp in
Escape.escape_dotty str in Escape.escape_dotty str in
let pp_instrs fmt instrs = let pp_instrs fmt instrs =
IList.iter (fun i -> F.fprintf fmt " %s\\n " (instr_string i)) instrs in List.iter ~f:(fun i -> F.fprintf fmt " %s\\n " (instr_string i)) instrs in
let instrs = Procdesc.Node.get_instrs n in let instrs = Procdesc.Node.get_instrs n in
F.fprintf fmt "%d: %a \\n %a" (Procdesc.Node.get_id n :> int) pp_label n pp_instrs instrs F.fprintf fmt "%d: %a \\n %a" (Procdesc.Node.get_id n :> int) pp_label n pp_instrs instrs
@ -1013,8 +1013,8 @@ let pp_cfgnode pdesc fmt (n: Procdesc.Node.t) =
(pp_cfgnodename pname) n1 (pp_cfgnodename pname) n1
(pp_cfgnodename pname) n2 (pp_cfgnodename pname) n2
color in color in
IList.iter (fun n' -> print_edge n n' false) (Procdesc.Node.get_succs n); List.iter ~f:(fun n' -> print_edge n n' false) (Procdesc.Node.get_succs n);
IList.iter (fun n' -> print_edge n n' true) (Procdesc.Node.get_exn n) List.iter ~f:(fun n' -> print_edge n n' true) (Procdesc.Node.get_exn n)
(* * print control flow graph (in dot form) for fundec to channel let *) (* * print control flow graph (in dot form) for fundec to channel let *)
(* print_cfg_channel (chan : out_channel) (fd : fundec) = let pnode (s: *) (* print_cfg_channel (chan : out_channel) (fd : fundec) = let pnode (s: *)
@ -1066,7 +1066,9 @@ let pp_speclist_dotty f (splist: Prop.normal Specs.spec list) =
F.fprintf f "@\n@\n\ndigraph main { \nnode [shape=box]; @\n"; F.fprintf f "@\n@\n\ndigraph main { \nnode [shape=box]; @\n";
F.fprintf f "@\n compound = true; @\n"; F.fprintf f "@\n compound = true; @\n";
(* F.fprintf f "\n size=\"12,7\"; ratio=fill; \n"; *) (* F.fprintf f "\n size=\"12,7\"; ratio=fill; \n"; *)
IList.iter (fun s -> pp_dotty_one_spec f (Specs.Jprop.to_prop s.Specs.pre) s.Specs.posts) splist; List.iter
~f:(fun s -> pp_dotty_one_spec f (Specs.Jprop.to_prop s.Specs.pre) s.Specs.posts)
splist;
F.fprintf f "@\n}"; F.fprintf f "@\n}";
Config.pp_simple := pp_simple_saved Config.pp_simple := pp_simple_saved

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

@ -20,7 +20,7 @@ let vector_class = ["std"; "vector"]
let is_one_of_classes class_name classes = let is_one_of_classes class_name classes =
List.exists ~f:(fun wrapper_class -> List.exists ~f:(fun wrapper_class ->
IList.for_all (fun wrapper_class_substring -> List.for_all ~f:(fun wrapper_class_substring ->
String.is_substring ~substring:wrapper_class_substring class_name) wrapper_class) String.is_substring ~substring:wrapper_class_substring class_name) wrapper_class)
classes classes
@ -447,9 +447,9 @@ let leak_from_list_abstraction hpred prop =
| Some texp' when Exp.equal texp texp' -> found := true | Some texp' when Exp.equal texp texp' -> found := true
| _ -> () in | _ -> () in
let check_hpara texp _ hpara = let check_hpara texp _ hpara =
IList.iter (check_hpred texp) hpara.Sil.body in List.iter ~f:(check_hpred texp) hpara.Sil.body in
let check_hpara_dll texp _ hpara = let check_hpara_dll texp _ hpara =
IList.iter (check_hpred texp) hpara.Sil.body_dll in List.iter ~f:(check_hpred texp) hpara.Sil.body_dll in
match hpred_type hpred with match hpred_type hpred with
| Some texp -> | Some texp ->
let env = Prop.prop_pred_env prop in let env = Prop.prop_pred_env prop in
@ -473,7 +473,7 @@ let find_typ_without_ptr prop pvar =
| Sil.Hpointsto (e, _, te) when Exp.equal e (Exp.Lvar pvar) -> | Sil.Hpointsto (e, _, te) when Exp.equal e (Exp.Lvar pvar) ->
res := Some te res := Some te
| _ -> () in | _ -> () in
IList.iter do_hpred prop.Prop.sigma; List.iter ~f:do_hpred prop.Prop.sigma;
!res !res
(** Produce a description of a leak by looking at the current state. (** Produce a description of a leak by looking at the current state.
@ -620,7 +620,7 @@ let vpath_find tenv prop _exp : DExp.t option * Typ.t option =
None, None) None, None)
| Sil.Estruct (fsel, _) -> | Sil.Estruct (fsel, _) ->
let res = ref (None, None) in let res = ref (None, None) in
IList.iter (do_fse res sigma_acc' sigma_todo' lexp texp) fsel; List.iter ~f:(do_fse res sigma_acc' sigma_todo' lexp texp) fsel;
!res !res
| _ -> | _ ->
None, None in None, None in
@ -673,7 +673,7 @@ let explain_dexp_access prop dexp is_nullable =
| Sil.Hpointsto (e', se, _) when Exp.equal e e' -> | Sil.Hpointsto (e', se, _) when Exp.equal e e' ->
res := Some se res := Some se
| _ -> () in | _ -> () in
IList.iter do_hpred sigma; List.iter ~f:do_hpred sigma;
!res in !res in
let rec lookup_fld fsel f = match fsel with let rec lookup_fld fsel f = match fsel with
| [] -> | [] ->
@ -986,7 +986,7 @@ let find_with_exp prop exp =
| 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
| Sil.Estruct (fsel, _) -> | Sil.Estruct (fsel, _) ->
IList.iter (fun (f, se) -> search_struct pv (f:: fld_lst) se) fsel List.iter ~f:(fun (f, se) -> search_struct pv (f:: fld_lst) se) fsel
| _ -> () in | _ -> () in
let do_hpred_pointed_by_pvar pv e = function let do_hpred_pointed_by_pvar pv e = function
| Sil.Hpointsto(e1, se, _) -> | Sil.Hpointsto(e1, se, _) ->
@ -995,9 +995,9 @@ let find_with_exp prop exp =
let do_hpred = function let do_hpred = function
| Sil.Hpointsto(Exp.Lvar pv, Sil.Eexp (e, _), _) -> | Sil.Hpointsto(Exp.Lvar pv, Sil.Eexp (e, _), _) ->
if Exp.equal e exp then found_in_pvar pv if Exp.equal e exp then found_in_pvar pv
else IList.iter (do_hpred_pointed_by_pvar pv e) prop.Prop.sigma else List.iter ~f:(do_hpred_pointed_by_pvar pv e) prop.Prop.sigma
| _ -> () in | _ -> () in
IList.iter do_hpred prop.Prop.sigma; List.iter ~f:do_hpred prop.Prop.sigma;
!res !res
(** return a description explaining value [exp] in [prop] in terms of a source expression (** return a description explaining value [exp] in [prop] in terms of a source expression

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

@ -95,8 +95,8 @@ let add_cg (exe_env: t) (source_dir : DB.source_dir) =
exe_env.source_files <- SourceFile.Set.add source exe_env.source_files; exe_env.source_files <- SourceFile.Set.add source exe_env.source_files;
let defined_procs = Cg.get_defined_nodes cg in let defined_procs = Cg.get_defined_nodes cg in
IList.iter List.iter
(fun pname -> ~f:(fun pname ->
(match AttributesTable.find_file_capturing_procedure pname with (match AttributesTable.find_file_capturing_procedure pname with
| None -> | None ->
() ()

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

@ -291,8 +291,8 @@ let propagate_nodes_divergence
Propgraph.d_proplist Prop.prop_emp (Paths.PathSet.to_proplist prop_incons); L.d_ln (); Propgraph.d_proplist Prop.prop_emp (Paths.PathSet.to_proplist prop_incons); L.d_ln ();
propagate wl pname ~is_exception:false prop_incons exit_node propagate wl pname ~is_exception:false prop_incons exit_node
end; end;
IList.iter (propagate wl pname ~is_exception:false pset_ok) succ_nodes; List.iter ~f:(propagate wl pname ~is_exception:false pset_ok) succ_nodes;
IList.iter (propagate wl pname ~is_exception:true pset_exn) exn_nodes List.iter ~f:(propagate wl pname ~is_exception:true pset_exn) exn_nodes
(* ===================== END of symbolic execution ===================== *) (* ===================== END of symbolic execution ===================== *)
@ -306,7 +306,7 @@ let do_symexec_join pname tenv wl curr_node (edgeset_todo : Paths.PathSet.t) =
let old_dset = Join_table.find wl.Worklist.join_table curr_node_id in let old_dset = Join_table.find wl.Worklist.join_table curr_node_id in
let old_dset', new_dset' = Dom.pathset_join pname tenv old_dset new_dset in let old_dset', new_dset' = Dom.pathset_join pname tenv old_dset new_dset in
Join_table.add wl.Worklist.join_table curr_node_id (Paths.PathSet.union old_dset' new_dset'); Join_table.add wl.Worklist.join_table curr_node_id (Paths.PathSet.union old_dset' new_dset');
IList.iter (fun node -> List.iter ~f:(fun node ->
Paths.PathSet.iter (fun prop path -> Paths.PathSet.iter (fun prop path ->
State.set_path path None; State.set_path path None;
propagate wl pname ~is_exception:false propagate wl pname ~is_exception:false
@ -350,8 +350,8 @@ let instrs_get_normal_vars instrs =
let do_instr instr = let do_instr instr =
let do_e e = Sil.exp_fav_add fav e in let do_e e = Sil.exp_fav_add fav e in
let exps = Sil.instr_get_exps instr in let exps = Sil.instr_get_exps instr in
IList.iter do_e exps in List.iter ~f:do_e exps in
IList.iter do_instr instrs; List.iter ~f:do_instr instrs;
Sil.fav_filter_ident fav Ident.is_normal; Sil.fav_filter_ident fav Ident.is_normal;
Sil.fav_to_list fav Sil.fav_to_list fav
@ -407,17 +407,17 @@ let check_assignement_guard pdesc node =
[e'] [e']
| _ -> [] in | _ -> [] in
let prune_vars = List.concat(IList.map (fun n -> prune_var n) succs) in let prune_vars = List.concat(IList.map (fun n -> prune_var n) succs) in
IList.for_all (fun e' -> Exp.equal e' e) prune_vars in List.for_all ~f:(fun e' -> Exp.equal e' e) prune_vars in
let succs_loc = IList.map (fun n -> Procdesc.Node.get_loc n) succs in let succs_loc = IList.map (fun n -> Procdesc.Node.get_loc n) succs in
let succs_are_all_prune_nodes () = let succs_are_all_prune_nodes () =
IList.for_all (fun n -> match Procdesc.Node.get_kind n with List.for_all ~f:(fun n -> match Procdesc.Node.get_kind n with
| Procdesc.Node.Prune_node(_) -> true | Procdesc.Node.Prune_node(_) -> true
| _ -> false) succs in | _ -> false) succs in
let succs_same_loc_as_node () = let succs_same_loc_as_node () =
if verbose then if verbose then
(L.d_str ("LOCATION NODE: line: " ^ (string_of_int l_node.Location.line)); (L.d_str ("LOCATION NODE: line: " ^ (string_of_int l_node.Location.line));
L.d_strln " "); L.d_strln " ");
IList.for_all (fun l -> List.for_all ~f:(fun l ->
if verbose then if verbose then
(L.d_str ("LOCATION l: line: " ^ (string_of_int l.Location.line)); (L.d_str ("LOCATION l: line: " ^ (string_of_int l.Location.line));
L.d_strln " "); L.d_strln " ");
@ -430,8 +430,8 @@ let check_assignement_guard pdesc node =
| Sil.Prune _ -> false | Sil.Prune _ -> false
| _ -> true in | _ -> true in
let check_guard n = let check_guard n =
IList.for_all check_instr (Procdesc.Node.get_instrs n) in List.for_all ~f:check_instr (Procdesc.Node.get_instrs n) in
IList.for_all check_guard succs in List.for_all ~f:check_guard succs in
if Config.curr_language_is Config.Clang && if Config.curr_language_is Config.Clang &&
succs_are_all_prune_nodes () && succs_are_all_prune_nodes () &&
succs_same_loc_as_node () && succs_same_loc_as_node () &&
@ -654,17 +654,17 @@ let report_context_leaks pname sigma tenv =
let reachable_hpreds, reachable_exps = let reachable_hpreds, reachable_exps =
Prop.compute_reachable_hpreds sigma fld_exps in Prop.compute_reachable_hpreds sigma fld_exps in
(* raise an error if any Context expression is in [reachable_exps] *) (* raise an error if any Context expression is in [reachable_exps] *)
IList.iter List.iter
(fun (context_exp, name) -> ~f:(fun (context_exp, name) ->
if Exp.Set.mem context_exp reachable_exps then if Exp.Set.mem context_exp reachable_exps then
let leak_path = let leak_path =
match get_fld_typ_path_opt fld_exps context_exp reachable_hpreds with match get_fld_typ_path_opt fld_exps context_exp reachable_hpreds with
| Some path -> path | Some path -> path
| None -> assert false (* a path must exist in order for a leak to be reported *) in | None -> assert false (* a path must exist in order for a leak to be reported *) in
let err_desc = let err_desc =
Errdesc.explain_context_leak pname (Typ.Tstruct name) fld_name leak_path in Errdesc.explain_context_leak pname (Typ.Tstruct name) fld_name leak_path in
let exn = Exceptions.Context_leak (err_desc, __POS__) in let exn = Exceptions.Context_leak (err_desc, __POS__) in
Reporting.log_error pname exn) Reporting.log_error pname exn)
context_exps in context_exps in
(* get the set of pointed-to expressions of type T <: Context *) (* get the set of pointed-to expressions of type T <: Context *)
let context_exps = let context_exps =
@ -678,15 +678,15 @@ let report_context_leaks pname sigma tenv =
| _ -> exps) | _ -> exps)
~init:[] ~init:[]
sigma in sigma in
IList.iter List.iter
(function ~f:(function
| Sil.Hpointsto (Exp.Lvar pv, Sil.Estruct (static_flds, _), _) | Sil.Hpointsto (Exp.Lvar pv, Sil.Estruct (static_flds, _), _)
when Pvar.is_global pv -> when Pvar.is_global pv ->
IList.iter List.iter
(fun (f_name, f_strexp) -> ~f:(fun (f_name, f_strexp) ->
check_reachable_context_from_fld (f_name, f_strexp) context_exps) check_reachable_context_from_fld (f_name, f_strexp) context_exps)
static_flds static_flds
| _ -> ()) | _ -> ())
sigma sigma
(** Remove locals and formals, (** Remove locals and formals,
@ -700,7 +700,7 @@ let remove_locals_formals_and_check tenv pdesc p =
let desc = Errdesc.explain_stack_variable_address_escape loc pvar dexp_opt in let desc = Errdesc.explain_stack_variable_address_escape loc pvar dexp_opt in
let exn = Exceptions.Stack_variable_address_escape (desc, __POS__) in let exn = Exceptions.Stack_variable_address_escape (desc, __POS__) in
Reporting.log_warning pname exn in Reporting.log_warning pname exn in
IList.iter check_pvar pvars; List.iter ~f:check_pvar pvars;
p' p'
(** Collect the analysis results for the exit node. *) (** Collect the analysis results for the exit node. *)
@ -970,12 +970,12 @@ let get_procs_and_defined_children call_graph =
let pp_intra_stats wl proc_desc fmt _ = let pp_intra_stats wl proc_desc fmt _ =
let nstates = ref 0 in let nstates = ref 0 in
let nodes = Procdesc.get_nodes proc_desc in let nodes = Procdesc.get_nodes proc_desc in
IList.iter List.iter
(fun node -> ~f:(fun node ->
nstates := nstates :=
!nstates + !nstates +
Paths.PathSet.size Paths.PathSet.size
(htable_retrieve wl.Worklist.path_set_visited (Procdesc.Node.get_id node))) (htable_retrieve wl.Worklist.path_set_visited (Procdesc.Node.get_id node)))
nodes; nodes;
F.fprintf fmt "(%d nodes containing %d states)" (IList.length nodes) !nstates F.fprintf fmt "(%d nodes containing %d states)" (IList.length nodes) !nstates
@ -1199,7 +1199,7 @@ let report_runtime_exceptions tenv pdesc summary =
let exn_desc = Localise.java_unchecked_exn_desc pname runtime_exception pre_str in let exn_desc = Localise.java_unchecked_exn_desc pname runtime_exception pre_str in
let exn = Exceptions.Java_runtime_exception (runtime_exception, pre_str, exn_desc) in let exn = Exceptions.Java_runtime_exception (runtime_exception, pre_str, exn_desc) in
Reporting.log_error pname exn in Reporting.log_error pname exn in
IList.iter report exn_preconditions List.iter ~f:report exn_preconditions
let report_custom_errors tenv summary = let report_custom_errors tenv summary =
@ -1212,7 +1212,7 @@ let report_custom_errors tenv summary =
let err_desc = Localise.desc_custom_error loc in let err_desc = Localise.desc_custom_error loc in
let exn = Exceptions.Custom_error (custom_error, err_desc) in let exn = Exceptions.Custom_error (custom_error, err_desc) in
Reporting.log_error pname exn in Reporting.log_error pname exn in
IList.iter report error_preconditions List.iter ~f:report error_preconditions
module SpecMap = Caml.Map.Make (struct module SpecMap = Caml.Map.Make (struct
type t = Prop.normal Specs.Jprop.t type t = Prop.normal Specs.Jprop.t
@ -1277,8 +1277,8 @@ let update_specs tenv proc_name phase (new_specs : Specs.NormSpec.t list)
{ Specs.pre = pre; { Specs.pre = pre;
Specs.posts = Paths.PathSet.elements post_set; Specs.posts = Paths.PathSet.elements post_set;
Specs.visited = visited }:: !res in Specs.visited = visited }:: !res in
IList.iter re_exe_filter old_specs; (* filter out pre's which failed re-exe *) List.iter ~f:re_exe_filter old_specs; (* filter out pre's which failed re-exe *)
IList.iter add_spec new_specs; (* add new specs *) List.iter ~f:add_spec new_specs; (* add new specs *)
SpecMap.iter convert !current_specs; SpecMap.iter convert !current_specs;
!res,!changed !res,!changed
@ -1444,13 +1444,13 @@ let do_analysis exe_env =
else None in else None in
Specs.init_summary (nodes, proc_flags, calls, None, attributes, proc_desc_option) in Specs.init_summary (nodes, proc_flags, calls, None, attributes, proc_desc_option) in
IList.iter List.iter
(fun (pn, _) -> ~f:(fun (pn, _) ->
let should_init () = let should_init () =
Config.models_mode || Config.models_mode ||
is_none (Specs.get_summary pn) in is_none (Specs.get_summary pn) in
if should_init () if should_init ()
then init_proc pn) then init_proc pn)
procs_and_defined_children; procs_and_defined_children;
let callbacks = let callbacks =
@ -1592,7 +1592,7 @@ let print_stats_cfg proc_shadowed source cfg =
print_file_stats fmt (); print_file_stats fmt ();
Out_channel.close outc Out_channel.close outc
with Sys_error _ -> () in with Sys_error _ -> () in
IList.iter compute_stats_proc (Cfg.get_defined_procs cfg); List.iter ~f:compute_stats_proc (Cfg.get_defined_procs cfg);
L.out "%a" print_file_stats (); L.out "%a" print_file_stats ();
save_file_stats () save_file_stats ()

18
infer/src/backend/mergeCapture.ml
Unescape View File

@ -142,11 +142,11 @@ let should_link ~target ~target_results_dir ~stats infer_out_src infer_out_dst =
let symlinks_up_to_date captured_file = let symlinks_up_to_date captured_file =
if Sys.is_directory captured_file = `Yes then if Sys.is_directory captured_file = `Yes then
let contents = Array.to_list (Sys.readdir captured_file) in let contents = Array.to_list (Sys.readdir captured_file) in
IList.for_all List.for_all
(fun file -> ~f:(fun file ->
let file_path = Filename.concat captured_file file in let file_path = Filename.concat captured_file file in
Sys.file_exists file_path = `Yes && Sys.file_exists file_path = `Yes &&
(not check_timestamp_of_symlinks || symlink_up_to_date file_path)) (not check_timestamp_of_symlinks || symlink_up_to_date file_path))
contents contents
else true in else true in
let check_file captured_file = let check_file captured_file =
@ -161,9 +161,9 @@ let should_link ~target ~target_results_dir ~stats infer_out_src infer_out_dst =
begin begin
let captured_files = Array.to_list (Sys.readdir captured_src) in let captured_files = Array.to_list (Sys.readdir captured_src) in
num_captured_files := IList.length captured_files; num_captured_files := IList.length captured_files;
IList.for_all List.for_all
(fun file -> ~f:(fun file ->
check_file (Filename.concat captured_dst file)) check_file (Filename.concat captured_dst file))
captured_files captured_files
end end
else else
@ -199,7 +199,7 @@ let process_merge_file deps_file =
| _ -> | _ ->
() in () in
Option.iter Option.iter
~f:(fun lines -> IList.iter process_line lines) ~f:(fun lines -> List.iter ~f:process_line lines)
(Utils.read_file deps_file); (Utils.read_file deps_file);
create_multilinks (); create_multilinks ();
L.stdout "Captured results merged.@."; L.stdout "Captured results merged.@.";

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

@ -324,8 +324,8 @@ end = struct
| [] -> [] in | [] -> [] in
remove_until_seen inverse_sequence remove_until_seen inverse_sequence
else IList.rev inverse_sequence in else IList.rev inverse_sequence in
IList.iter List.iter
(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
(** return the node visited most, and number of visits, in the shortest linear sequence *) (** return the node visited most, and number of visits, in the shortest linear sequence *)
@ -595,14 +595,16 @@ end = struct
PropMap.iter (fun p _ -> elements := p :: !elements) ps; PropMap.iter (fun p _ -> elements := p :: !elements) ps;
elements := List.filter ~f:(fun p -> not (f p)) !elements; elements := List.filter ~f:(fun p -> not (f p)) !elements;
let filtered_map = ref ps in let filtered_map = ref ps in
IList.iter (fun p -> filtered_map := PropMap.remove p !filtered_map) !elements; List.iter ~f:(fun p -> filtered_map := PropMap.remove p !filtered_map) !elements;
!filtered_map !filtered_map
let partition f ps = let partition f ps =
let elements = ref [] in let elements = ref [] in
PropMap.iter (fun p _ -> elements := p :: !elements) ps; PropMap.iter (fun p _ -> elements := p :: !elements) ps;
let el1, el2 = ref ps, ref ps in let el1, el2 = ref ps, ref ps in
IList.iter (fun p -> if f p then el2 := PropMap.remove p !el2 else el1 := PropMap.remove p !el1) !elements; List.iter
~f:(fun p -> if f p then el2 := PropMap.remove p !el2 else el1 := PropMap.remove p !el1)
!elements;
!el1, !el2 !el1, !el2
(** It's the caller's resposibility to ensure that Prop.prop_rename_primed_footprint_vars was called on the prop *) (** It's the caller's resposibility to ensure that Prop.prop_rename_primed_footprint_vars was called on the prop *)

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

@ -47,8 +47,8 @@ let add_dispatch_calls pdesc cg tenv =
(* if sound dispatch is turned off, consider only the first target. we do this (* if sound dispatch is turned off, consider only the first target. we do this
because choosing all targets is too expensive for everyday use *) because choosing all targets is too expensive for everyday use *)
[target_pname] in [target_pname] in
IList.iter List.iter
(fun target_pname -> Cg.add_edge cg caller_pname target_pname) ~f:(fun target_pname -> Cg.add_edge cg caller_pname target_pname)
targets_to_add; targets_to_add;
let call_flags' = { call_flags with CallFlags.cf_targets = targets_to_add; } in let call_flags' = { call_flags with CallFlags.cf_targets = targets_to_add; } in
Sil.Call (ret_id, call_exp, args, loc, call_flags') Sil.Call (ret_id, call_exp, args, loc, call_flags')
@ -222,24 +222,24 @@ let add_nullify_instrs pdesc tenv liveness_inv_map =
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 (IList.rev ids, loc)] in
IList.iter List.iter
(fun node -> ~f:(fun node ->
match NullifyAnalysis.extract_post (ProcCfg.Exceptional.id node) nullify_inv_map with match NullifyAnalysis.extract_post (ProcCfg.Exceptional.id node) nullify_inv_map with
| Some (_, to_nullify) -> | Some (_, to_nullify) ->
let pvars_to_nullify, ids_to_remove = let pvars_to_nullify, ids_to_remove =
Var.Set.fold Var.Set.fold
(fun var (pvars_acc, ids_acc) -> match Var.to_exp var with (fun var (pvars_acc, ids_acc) -> match Var.to_exp var with
(* we nullify all address taken variables at the end of the procedure *) (* we nullify all address taken variables at the end of the procedure *)
| Exp.Lvar pvar when not (AddressTaken.Domain.mem pvar address_taken_vars) -> | Exp.Lvar pvar when not (AddressTaken.Domain.mem pvar address_taken_vars) ->
pvar :: pvars_acc, ids_acc pvar :: pvars_acc, ids_acc
| Exp.Var id -> | Exp.Var id ->
pvars_acc, id :: ids_acc pvars_acc, id :: ids_acc
| _ -> pvars_acc, ids_acc) | _ -> pvars_acc, ids_acc)
to_nullify to_nullify
([], []) in ([], []) in
node_add_removetmps_instructions node ids_to_remove; node_add_removetmps_instructions node ids_to_remove;
node_add_nullify_instructions node pvars_to_nullify node_add_nullify_instructions node pvars_to_nullify
| None -> ()) | None -> ())
(ProcCfg.Exceptional.nodes nullify_proc_cfg); (ProcCfg.Exceptional.nodes nullify_proc_cfg);
(* nullify all address taken variables *) (* nullify all address taken variables *)
if not (AddressTaken.Domain.is_empty address_taken_vars) if not (AddressTaken.Domain.is_empty address_taken_vars)
@ -290,11 +290,11 @@ let do_copy_propagation pdesc tenv =
~init:([], false) ~init:([], false)
(ExceptionalOneInstrPerNodeCfg.instr_ids node) in (ExceptionalOneInstrPerNodeCfg.instr_ids node) in
IList.iter List.iter
(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 (IList.rev instrs))
(Procdesc.get_nodes pdesc) (Procdesc.get_nodes pdesc)
let do_liveness pdesc tenv = let do_liveness pdesc tenv =

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

@ -126,7 +126,7 @@ end = struct
(Escape.escape_xml (Procname.to_string proc_name)) (Escape.escape_xml (Procname.to_string proc_name))
(Io_infer.Html.pp_line_link source [".."]) loc.Location.line; (Io_infer.Html.pp_line_link source [".."]) loc.Location.line;
F.fprintf fmt "<br>PREDS:@\n"; F.fprintf fmt "<br>PREDS:@\n";
IList.iter (fun node -> List.iter ~f:(fun node ->
Io_infer.Html.pp_node_link Io_infer.Html.pp_node_link
[".."] [".."]
(Procdesc.Node.get_proc_name node) (Procdesc.Node.get_proc_name node)
@ -138,7 +138,7 @@ end = struct
~isproof:false ~isproof:false
fmt (Procdesc.Node.get_id node :> int)) preds; fmt (Procdesc.Node.get_id node :> int)) preds;
F.fprintf fmt "<br>SUCCS: @\n"; F.fprintf fmt "<br>SUCCS: @\n";
IList.iter (fun node -> List.iter ~f:(fun node ->
Io_infer.Html.pp_node_link Io_infer.Html.pp_node_link
[".."] [".."]
(Procdesc.Node.get_proc_name node) (Procdesc.Node.get_proc_name node)
@ -150,7 +150,7 @@ end = struct
~isproof:false ~isproof:false
fmt (Procdesc.Node.get_id node :> int)) succs; fmt (Procdesc.Node.get_id node :> int)) succs;
F.fprintf fmt "<br>EXN: @\n"; F.fprintf fmt "<br>EXN: @\n";
IList.iter (fun node -> List.iter ~f:(fun node ->
Io_infer.Html.pp_node_link Io_infer.Html.pp_node_link
[".."] [".."]
(Procdesc.Node.get_proc_name node) (Procdesc.Node.get_proc_name node)
@ -365,8 +365,8 @@ let () = L.printer_hook := force_delayed_print
let force_delayed_prints () = let force_delayed_prints () =
Config.forcing_delayed_prints := true; Config.forcing_delayed_prints := true;
F.fprintf !curr_html_formatter "@?"; (* flush html stream *) F.fprintf !curr_html_formatter "@?"; (* flush html stream *)
IList.iter List.iter
(force_delayed_print !curr_html_formatter) ~f:(force_delayed_print !curr_html_formatter)
(IList.rev (L.get_delayed_prints ())); (IList.rev (L.get_delayed_prints ()));
F.fprintf !curr_html_formatter "@?"; F.fprintf !curr_html_formatter "@?";
L.reset_delayed_prints (); L.reset_delayed_prints ();
@ -429,18 +429,18 @@ let write_proc_html source whole_seconds pdesc =
~text: (Some (Escape.escape_xml (Procname.to_string pname))) ~text: (Some (Escape.escape_xml (Procname.to_string pname)))
[]) [])
linenum; linenum;
IList.iter List.iter
(fun n -> ~f:(fun n ->
Io_infer.Html.pp_node_link Io_infer.Html.pp_node_link
[] []
(Procdesc.Node.get_proc_name n) (Procdesc.Node.get_proc_name n)
~description:(Procdesc.Node.get_description (Pp.html Black) n) ~description:(Procdesc.Node.get_description (Pp.html Black) n)
~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list) ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list)
~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list) ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list)
~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list) ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list)
~isvisited:(is_visited n) ~isvisited:(is_visited n)
~isproof:false ~isproof:false
fmt (Procdesc.Node.get_id n :> int)) fmt (Procdesc.Node.get_id n :> int))
nodes; nodes;
(match Specs.get_summary pname with (match Specs.get_summary pname with
| None -> | None ->
@ -488,14 +488,14 @@ let write_html_proc source proof_cover table_nodes_at_linenum global_err_log pro
SourceFile.equal source_captured (Procdesc.get_loc proc_desc).file in SourceFile.equal source_captured (Procdesc.get_loc proc_desc).file in
if process_proc then if process_proc then
begin begin
IList.iter process_node (Procdesc.get_nodes proc_desc); List.iter ~f:process_node (Procdesc.get_nodes proc_desc);
match Specs.get_summary proc_name with match Specs.get_summary proc_name with
| None -> | None ->
() ()
| Some summary -> | Some summary ->
IList.iter List.iter
(fun sp -> ~f:(fun sp ->
proof_cover := Specs.Visitedset.union sp.Specs.visited !proof_cover) proof_cover := Specs.Visitedset.union sp.Specs.visited !proof_cover)
(Specs.get_specs_from_payload summary); (Specs.get_specs_from_payload summary);
Errlog.update global_err_log summary.Specs.attributes.ProcAttributes.err_log Errlog.update global_err_log summary.Specs.attributes.ProcAttributes.err_log
end end
@ -535,38 +535,38 @@ let write_html_file linereader filename procs =
"</td><td class=\"line\">" ^ "</td><td class=\"line\">" ^
line_html in line_html in
F.fprintf fmt "%s" str; F.fprintf fmt "%s" str;
IList.iter List.iter
(fun n -> ~f:(fun n ->
let isproof = let isproof =
Specs.Visitedset.mem (Procdesc.Node.get_id n, []) !proof_cover in Specs.Visitedset.mem (Procdesc.Node.get_id n, []) !proof_cover in
Io_infer.Html.pp_node_link Io_infer.Html.pp_node_link
[fname_encoding] [fname_encoding]
(Procdesc.Node.get_proc_name n) (Procdesc.Node.get_proc_name n)
~description:(Procdesc.Node.get_description (Pp.html Black) n) ~description:(Procdesc.Node.get_description (Pp.html Black) n)
~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list) ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list)
~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list) ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list)
~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list) ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list)
~isvisited:(is_visited n) ~isvisited:(is_visited n)
~isproof ~isproof
fmt (Procdesc.Node.get_id n :> int)) fmt (Procdesc.Node.get_id n :> int))
nodes_at_linenum; nodes_at_linenum;
IList.iter List.iter
(fun n -> ~f:(fun n ->
match Procdesc.Node.get_kind n with match Procdesc.Node.get_kind n with
| Procdesc.Node.Start_node proc_name -> | Procdesc.Node.Start_node proc_name ->
let num_specs = IList.length (Specs.get_specs proc_name) in let num_specs = IList.length (Specs.get_specs proc_name) in
let label = let label =
(Escape.escape_xml (Procname.to_string proc_name)) ^ (Escape.escape_xml (Procname.to_string proc_name)) ^
": " ^ ": " ^
(string_of_int num_specs) ^ (string_of_int num_specs) ^
" specs" in " specs" in
Io_infer.Html.pp_proc_link [fname_encoding] proc_name fmt label Io_infer.Html.pp_proc_link [fname_encoding] proc_name fmt label
| _ -> | _ ->
()) ())
nodes_at_linenum; nodes_at_linenum;
IList.iter List.iter
(fun err_string -> ~f:(fun err_string ->
F.fprintf fmt "%s" (create_err_message err_string)) F.fprintf fmt "%s" (create_err_message err_string))
errors_at_linenum; errors_at_linenum;
F.fprintf fmt "%s" "</td></tr>\n" in F.fprintf fmt "%s" "</td></tr>\n" in
@ -574,7 +574,7 @@ let write_html_file linereader filename procs =
let global_err_log = Errlog.empty () in let global_err_log = Errlog.empty () in
let table_nodes_at_linenum = Hashtbl.create 11 in let table_nodes_at_linenum = Hashtbl.create 11 in
let proof_cover = ref Specs.Visitedset.empty in let proof_cover = ref Specs.Visitedset.empty in
IList.iter (write_html_proc filename proof_cover table_nodes_at_linenum global_err_log) procs; List.iter ~f:(write_html_proc filename proof_cover table_nodes_at_linenum global_err_log) procs;
let table_err_per_line = create_table_err_per_line global_err_log in let table_err_per_line = create_table_err_per_line global_err_log in
let linenum = ref 0 in let linenum = ref 0 in

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

@ -269,7 +269,7 @@ let create_pvar_env (sigma: sigma) : (Exp.t -> Exp.t) =
| Sil.Hpointsto (Lvar pvar, Eexp (Var v, _), _) -> | Sil.Hpointsto (Lvar pvar, Eexp (Var v, _), _) ->
if not (Pvar.is_global pvar) then env := (Exp.Var v, Exp.Lvar pvar) :: !env if not (Pvar.is_global pvar) then env := (Exp.Var v, Exp.Lvar pvar) :: !env
| _ -> () in | _ -> () in
IList.iter filter sigma; List.iter ~f:filter sigma;
let find e = let find e =
List.find ~f:(fun (e1, _) -> Exp.equal e1 e) !env |> List.find ~f:(fun (e1, _) -> Exp.equal e1 e) !env |>
Option.map ~f:snd |> Option.map ~f:snd |>
@ -296,8 +296,8 @@ let pp_footprint_simple _pe env f fp =
(** Create a predicate environment for a prop *) (** Create a predicate environment for a prop *)
let prop_pred_env prop = let prop_pred_env prop =
let env = Sil.Predicates.empty_env () in let env = Sil.Predicates.empty_env () in
IList.iter (Sil.Predicates.process_hpred env) prop.sigma; List.iter ~f:(Sil.Predicates.process_hpred env) prop.sigma;
IList.iter (Sil.Predicates.process_hpred env) prop.sigma_fp; List.iter ~f:(Sil.Predicates.process_hpred env) prop.sigma_fp;
env env
(** Pretty print a proposition. *) (** Pretty print a proposition. *)
@ -364,13 +364,13 @@ let d_proplist_with_typ (pl: 'a t list) =
(** {1 Functions for computing free non-program variables} *) (** {1 Functions for computing free non-program variables} *)
let pi_fav_add fav pi = let pi_fav_add fav pi =
IList.iter (Sil.atom_fav_add fav) pi List.iter ~f:(Sil.atom_fav_add fav) pi
let pi_fav = let pi_fav =
Sil.fav_imperative_to_functional pi_fav_add Sil.fav_imperative_to_functional pi_fav_add
let sigma_fav_add fav sigma = let sigma_fav_add fav sigma =
IList.iter (Sil.hpred_fav_add fav) sigma List.iter ~f:(Sil.hpred_fav_add fav) sigma
let sigma_fav = let sigma_fav =
Sil.fav_imperative_to_functional sigma_fav_add Sil.fav_imperative_to_functional sigma_fav_add
@ -409,7 +409,7 @@ let hpred_fav_in_pvars_add fav (hpred : Sil.hpred) = match hpred with
() ()
let sigma_fav_in_pvars_add fav sigma = let sigma_fav_in_pvars_add fav sigma =
IList.iter (hpred_fav_in_pvars_add fav) sigma List.iter ~f:(hpred_fav_in_pvars_add fav) sigma
let sigma_fpv sigma = let sigma_fpv sigma =
List.concat (IList.map Sil.hpred_fpv sigma) List.concat (IList.map Sil.hpred_fpv sigma)
@ -533,7 +533,7 @@ let sigma_get_unsigned_exps sigma =
when Typ.ikind_is_unsigned ik -> when Typ.ikind_is_unsigned ik ->
uexps := e :: !uexps uexps := e :: !uexps
| _ -> () in | _ -> () in
IList.iter do_hpred sigma; List.iter ~f:do_hpred sigma;
!uexps !uexps
(** Collapse consecutive indices that should be added. For instance, (** Collapse consecutive indices that should be added. For instance,
@ -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;
IList.iter (fun e -> Stack.push stack e) (IList.rev es) List.iter ~f:(fun e -> Stack.push stack e) (IList.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
@ -1794,9 +1794,9 @@ let sigma_dfs_sort tenv sigma =
| Eexp (e, _) -> | Eexp (e, _) ->
ExpStack.push e ExpStack.push e
| Estruct (fld_se_list, _) -> | Estruct (fld_se_list, _) ->
IList.iter (fun (_, se) -> handle_strexp se) fld_se_list List.iter ~f:(fun (_, se) -> handle_strexp se) fld_se_list
| Earray (_, idx_se_list, _) -> | Earray (_, idx_se_list, _) ->
IList.iter (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, IList.rev seen)
@ -1807,11 +1807,11 @@ let sigma_dfs_sort tenv sigma =
handle_strexp se; handle_strexp se;
(hpred:: visited, IList.rev_append cur seen) (hpred:: visited, IList.rev_append cur seen)
| Hlseg (_, _, root, next, shared) when Exp.equal e root -> | Hlseg (_, _, root, next, shared) when Exp.equal e root ->
IList.iter ExpStack.push (next:: shared); List.iter ~f:ExpStack.push (next:: shared);
(hpred:: visited, IList.rev_append cur seen) (hpred:: visited, IList.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 ->
IList.iter ExpStack.push (oB:: oF:: shared); List.iter ~f:ExpStack.push (oB:: oF:: shared);
(hpred:: visited, IList.rev_append cur seen) (hpred:: visited, IList.rev_append cur seen)
| _ -> | _ ->
handle_e visited (hpred:: seen) e cur handle_e visited (hpred:: seen) e cur
@ -1875,8 +1875,8 @@ let compute_reindexing fav_add get_id_offset list =
| None -> list_passed | None -> list_passed
| Some (id, _) -> | Some (id, _) ->
let fav = Sil.fav_new () in let fav = Sil.fav_new () in
IList.iter (fav_add fav) list_seen; List.iter ~f:(fav_add fav) list_seen;
IList.iter (fav_add fav) list_passed; List.iter ~f:(fav_add fav) list_passed;
if (Sil.fav_exists fav (Ident.equal id)) if (Sil.fav_exists fav (Ident.equal id))
then list_passed then list_passed
else (x:: list_passed) in else (x:: list_passed) in
@ -2508,7 +2508,7 @@ end = struct
and sigma_size sigma = and sigma_size sigma =
let size = ref 0 in let size = ref 0 in
IList.iter (fun hpred -> size := hpred_size hpred + !size) sigma; !size List.iter ~f:(fun hpred -> size := hpred_size hpred + !size) sigma; !size
let pi_size pi = pi_weight * IList.length pi let pi_size pi = pi_weight * IList.length pi
@ -2557,7 +2557,7 @@ module CategorizePreconditions = struct
| Eexp (Var _, _) -> | Eexp (Var _, _) ->
true true
| Estruct (fsel, _) -> | Estruct (fsel, _) ->
IList.for_all (fun (_, se) -> rhs_only_vars se) fsel List.for_all ~f:(fun (_, se) -> rhs_only_vars se) fsel
| Earray _ -> | Earray _ ->
true true
| _ -> | _ ->
@ -2576,7 +2576,7 @@ module CategorizePreconditions = struct
let check_pi pi = let check_pi pi =
List.is_empty pi in List.is_empty pi in
let check_sigma sigma = let check_sigma sigma =
IList.for_all hpred_filter sigma in List.for_all ~f:hpred_filter sigma in
check_pi pre.pi && check_sigma pre.sigma in check_pi pre.pi && check_sigma pre.sigma in
let pres_no_constraints = List.filter ~f:(check_pre hpred_is_var) preconditions in let pres_no_constraints = List.filter ~f:(check_pre hpred_is_var) preconditions in
let pres_only_allocation = List.filter ~f:(check_pre hpred_only_allocation) preconditions in let pres_only_allocation = List.filter ~f:(check_pre hpred_only_allocation) preconditions in

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

@ -111,7 +111,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 =
IList.iter f (get_edges footprint_part g) (* For now simple iterator; later might use a specific traversal *) List.iter ~f: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 =
@ -190,7 +190,7 @@ let compute_diff default_color oldgraph newgraph : diff =
) )
| None -> | None ->
() in () in
IList.iter build_changed newedges; List.iter ~f:build_changed newedges;
let colormap (o: Obj.t) = let colormap (o: Obj.t) =
if List.exists ~f:(fun x -> phys_equal x o) !changed then Pp.Red if List.exists ~f:(fun x -> phys_equal x o) !changed then Pp.Red
else default_color in else default_color in

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

@ -370,7 +370,7 @@ end = struct
lts := (e1, e2) :: !lts (* < *) lts := (e1, e2) :: !lts (* < *)
| Sil.Aeq _ | Sil.Aeq _
| Sil.Apred _ | Anpred _ -> () in | Sil.Apred _ | Anpred _ -> () in
IList.iter process_atom pi; List.iter ~f:process_atom pi;
saturate { leqs = !leqs; lts = !lts; neqs = !neqs } saturate { leqs = !leqs; lts = !lts; neqs = !neqs }
let from_sigma tenv sigma = let from_sigma tenv sigma =
@ -397,13 +397,13 @@ end = struct
Option.bind t (fun t' -> Option.bind t (fun t' ->
Option.map ~f:fst @@ StructTyp.get_field_type_and_annotation ~lookup f t' Option.map ~f:fst @@ StructTyp.get_field_type_and_annotation ~lookup f t'
) in ) in
IList.iter (fun (f, se) -> strexp_extract (se, get_field_type f)) fsel List.iter ~f:(fun (f, se) -> strexp_extract (se, get_field_type f)) fsel
| Sil.Earray (len, isel, _), t -> | Sil.Earray (len, isel, _), t ->
let elt_t = match t with let elt_t = match t with
| Some Typ.Tarray (t, _) -> Some t | Some Typ.Tarray (t, _) -> Some t
| _ -> None in | _ -> None in
add_lt_minus1_e len; add_lt_minus1_e len;
IList.iter (fun (idx, se) -> List.iter ~f:(fun (idx, se) ->
add_lt_minus1_e idx; add_lt_minus1_e idx;
strexp_extract (se, elt_t)) isel in strexp_extract (se, elt_t)) isel in
let hpred_extract = function let hpred_extract = function
@ -411,7 +411,7 @@ end = struct
if texp_is_unsigned texp then strexp_lt_minus1 se; if texp_is_unsigned texp then strexp_lt_minus1 se;
strexp_extract (se, type_of_texp texp) strexp_extract (se, type_of_texp texp)
| Sil.Hlseg _ | Sil.Hdllseg _ -> () in | Sil.Hlseg _ | Sil.Hdllseg _ -> () in
IList.iter hpred_extract sigma; List.iter ~f:hpred_extract sigma;
saturate { leqs = !leqs; lts = !lts; neqs = [] } saturate { leqs = !leqs; lts = !lts; neqs = [] }
let join ineq1 ineq2 = let join ineq1 ineq2 =
@ -942,7 +942,7 @@ type check =
let d_typings typings = let d_typings typings =
let d_elem (exp, texp) = let d_elem (exp, texp) =
Sil.d_exp exp; L.d_str ": "; Sil.d_texp_full texp; L.d_str " " in Sil.d_exp exp; L.d_str ": "; Sil.d_texp_full texp; L.d_str " " in
IList.iter d_elem typings List.iter ~f:d_elem typings
(** Module to encapsulate operations on the internal state of the prover *) (** Module to encapsulate operations on the internal state of the prover *)
module ProverState : sig module ProverState : sig
@ -998,7 +998,7 @@ end = struct
| Sil.Hpointsto (_, Sil.Earray (Exp.Var _ as len, _, _), _) -> | Sil.Hpointsto (_, Sil.Earray (Exp.Var _ as len, _, _), _) ->
Sil.exp_fav_add fav len Sil.exp_fav_add fav len
| _ -> () in | _ -> () in
IList.iter do_hpred prop.Prop.sigma; List.iter ~f:do_hpred prop.Prop.sigma;
fav fav
let reset lhs rhs = let reset lhs rhs =
@ -2069,7 +2069,7 @@ let imply_pi tenv calc_missing (sub1, sub2) prop pi2 =
| IMPL_EXC _ when calc_missing -> | IMPL_EXC _ when calc_missing ->
L.d_str "imply_pi: adding missing atom "; Sil.d_atom a; L.d_ln (); L.d_str "imply_pi: adding missing atom "; Sil.d_atom a; L.d_ln ();
ProverState.add_missing_pi a in ProverState.add_missing_pi a in
IList.iter do_atom pi2 List.iter ~f:do_atom pi2
let imply_atom tenv calc_missing (sub1, sub2) prop a = let imply_atom tenv calc_missing (sub1, sub2) prop a =
imply_pi tenv calc_missing (sub1, sub2) prop [a] imply_pi tenv calc_missing (sub1, sub2) prop [a]
@ -2128,12 +2128,12 @@ let check_array_bounds tenv (sub1, sub2) prop =
Sil.d_exp len1; L.d_str " "; Sil.d_exp len2; L.d_ln(); *) Sil.d_exp len1; L.d_str " "; Sil.d_exp len2; L.d_ln(); *)
let indices_to_check = match len2 with let indices_to_check = match len2 with
| _ -> [Exp.BinOp(Binop.PlusA, len2, Exp.minus_one)] (* only check len *) in | _ -> [Exp.BinOp(Binop.PlusA, len2, Exp.minus_one)] (* only check len *) in
IList.iter (fail_if_le len1) indices_to_check List.iter ~f:(fail_if_le len1) indices_to_check
| ProverState.BCfrom_pre _atom -> | ProverState.BCfrom_pre _atom ->
let atom_neg = atom_negate tenv (Sil.atom_sub sub2 _atom) in let atom_neg = atom_negate tenv (Sil.atom_sub sub2 _atom) in
(* L.d_strln_color Orange "BCFrom_pre"; Sil.d_atom atom_neg; L.d_ln (); *) (* L.d_strln_color Orange "BCFrom_pre"; Sil.d_atom atom_neg; L.d_ln (); *)
if check_atom tenv prop atom_neg then check_failed atom_neg in if check_atom tenv prop atom_neg then check_failed atom_neg in
IList.iter check_bound (ProverState.get_bounds_checks ()) List.iter ~f:check_bound (ProverState.get_bounds_checks ())
(** [check_implication_base] returns true if [prop1|-prop2], (** [check_implication_base] returns true if [prop1|-prop2],
ignoring the footprint part of the props *) ignoring the footprint part of the props *)
@ -2149,7 +2149,7 @@ let check_implication_base pname tenv check_frame_empty calc_missing prop1 prop2
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 IList.partition ProverState.atom_is_array_bounds_check pi2 in
IList.iter (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:";
L.d_increase_indent 1; Prop.d_pi pi1; L.d_decrease_indent 1; L.d_ln (); L.d_increase_indent 1; Prop.d_pi pi1; L.d_decrease_indent 1; L.d_ln ();
@ -2230,7 +2230,7 @@ let is_cover tenv cases =
match cases with match cases with
| [] -> check_inconsistency_pi tenv acc_pi | [] -> check_inconsistency_pi tenv acc_pi
| (pi, _):: cases' -> | (pi, _):: cases' ->
IList.for_all (fun a -> _is_cover ((atom_negate tenv a) :: acc_pi) cases') pi in List.for_all ~f:(fun a -> _is_cover ((atom_negate tenv a) :: acc_pi) cases') pi in
_is_cover [] cases _is_cover [] cases
exception NO_COVER exception NO_COVER

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

@ -487,7 +487,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
IList.iter f (Sil.fav_to_list fav); List.iter ~f: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
@ -1291,45 +1291,45 @@ let check_dereference_error tenv pdesc (prop : Prop.normal Prop.t) lexp loc =
(* return true if deref_exp is only pointed to by fields/params with @Nullable annotations *) (* return true if deref_exp is only pointed to by fields/params with @Nullable annotations *)
let is_only_pt_by_nullable_fld_or_param deref_exp = let is_only_pt_by_nullable_fld_or_param deref_exp =
let ann_sig = Models.get_modelled_annotated_signature (Specs.pdesc_resolve_attributes pdesc) in let ann_sig = Models.get_modelled_annotated_signature (Specs.pdesc_resolve_attributes pdesc) in
IList.for_all List.for_all
(fun hpred -> ~f:(fun hpred ->
match hpred with match hpred with
| Sil.Hpointsto (Exp.Lvar pvar, Sil.Eexp (Exp.Var _ as exp, _), _) | Sil.Hpointsto (Exp.Lvar pvar, Sil.Eexp (Exp.Var _ as exp, _), _)
when Exp.equal exp deref_exp -> when Exp.equal exp deref_exp ->
let is_weak_captured_var = is_weak_captured_var pdesc pvar in let is_weak_captured_var = is_weak_captured_var pdesc pvar in
let is_nullable = let is_nullable =
if AnnotatedSignature.param_is_nullable pvar ann_sig || is_weak_captured_var if AnnotatedSignature.param_is_nullable pvar ann_sig || is_weak_captured_var
then then
begin begin
nullable_obj_str := Some (Pvar.to_string pvar); nullable_obj_str := Some (Pvar.to_string pvar);
nullable_str_is_weak_captured_var := is_weak_captured_var; nullable_str_is_weak_captured_var := is_weak_captured_var;
true true
end end
else else
let is_nullable_attr = function let is_nullable_attr = function
| Sil.Apred ((Aretval (pname, ret_attr) | Aundef (pname, ret_attr, _, _)), _) | Sil.Apred ((Aretval (pname, ret_attr) | Aundef (pname, ret_attr, _, _)), _)
when Annotations.ia_is_nullable ret_attr -> when Annotations.ia_is_nullable ret_attr ->
nullable_obj_str := Some (Procname.to_string pname); nullable_obj_str := Some (Procname.to_string pname);
true true
| _ -> false in | _ -> false in
List.exists ~f:is_nullable_attr (Attribute.get_for_exp tenv prop exp) in List.exists ~f:is_nullable_attr (Attribute.get_for_exp tenv prop exp) in
(* it's ok for a non-nullable local to point to deref_exp *) (* it's ok for a non-nullable local to point to deref_exp *)
is_nullable || Pvar.is_local pvar is_nullable || Pvar.is_local pvar
| Sil.Hpointsto (_, Sil.Estruct (flds, _), Exp.Sizeof (typ, _, _)) -> | Sil.Hpointsto (_, Sil.Estruct (flds, _), Exp.Sizeof (typ, _, _)) ->
let fld_is_nullable fld = let fld_is_nullable fld =
match StructTyp.get_field_type_and_annotation ~lookup fld typ with match StructTyp.get_field_type_and_annotation ~lookup fld typ with
| Some (_, annot) -> Annotations.ia_is_nullable annot | Some (_, annot) -> Annotations.ia_is_nullable annot
| _ -> false in | _ -> false in
let is_strexp_pt_by_nullable_fld (fld, strexp) = let is_strexp_pt_by_nullable_fld (fld, strexp) =
match strexp with match strexp with
| Sil.Eexp (Exp.Var _ as exp, _) when Exp.equal exp deref_exp -> | Sil.Eexp (Exp.Var _ as exp, _) when Exp.equal exp deref_exp ->
let is_nullable = fld_is_nullable fld in let is_nullable = fld_is_nullable fld in
if is_nullable then if is_nullable then
nullable_obj_str := Some (Ident.fieldname_to_simplified_string fld); nullable_obj_str := Some (Ident.fieldname_to_simplified_string fld);
is_nullable is_nullable
| _ -> true in | _ -> true in
IList.for_all is_strexp_pt_by_nullable_fld flds List.for_all ~f:is_strexp_pt_by_nullable_fld flds
| _ -> true) | _ -> true)
prop.Prop.sigma && prop.Prop.sigma &&
!nullable_obj_str <> None in !nullable_obj_str <> None in
let root = Exp.root_of_lexp lexp in let root = Exp.root_of_lexp lexp in

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

@ -151,10 +151,10 @@ let visited_str vis =
(* if IList.length ns > 1 then (* if IList.length ns > 1 then
begin begin
let ss = ref "" in let ss = ref "" in
IList.iter (fun n -> ss := !ss ^ " " ^ string_of_int n) ns; List.iter ~f:(fun n -> ss := !ss ^ " " ^ string_of_int n) ns;
L.err "Node %d has lines %s@." node !ss L.err "Node %d has lines %s@." node !ss
end; *) end; *)
IList.iter (fun n -> lines := Int.Set.add !lines n) ns in List.iter ~f:(fun n -> lines := Int.Set.add !lines n) ns in
Visitedset.iter do_one vis; Visitedset.iter do_one vis;
Int.Set.iter ~f:(fun n -> s := !s ^ " " ^ string_of_int n) !lines; Int.Set.iter ~f:(fun n -> s := !s ^ " " ^ string_of_int n) !lines;
!s !s
@ -184,7 +184,7 @@ end = struct
let spec_fav tenv (spec: Prop.normal spec) : Sil.fav = let spec_fav tenv (spec: Prop.normal spec) : Sil.fav =
let fav = Sil.fav_new () in let fav = Sil.fav_new () in
Jprop.fav_add_dfs tenv fav spec.pre; Jprop.fav_add_dfs tenv fav spec.pre;
IList.iter (fun (p, _) -> Prop.prop_fav_add_dfs tenv fav p) spec.posts; List.iter ~f:(fun (p, _) -> Prop.prop_fav_add_dfs tenv fav p) spec.posts;
fav fav
let spec_sub tenv sub spec = let spec_sub tenv sub spec =
@ -247,7 +247,7 @@ module CallStats = struct (** module for tracing stats of function calls *)
let init calls = let init calls =
let hash = PnameLocHash.create 1 in let hash = PnameLocHash.create 1 in
let do_call pn_loc = PnameLocHash.add hash pn_loc empty_trace in let do_call pn_loc = PnameLocHash.add hash pn_loc empty_trace in
IList.iter do_call calls; List.iter ~f:do_call calls;
hash hash
let trace t proc_name loc res in_footprint = let trace t proc_name loc res in_footprint =
@ -279,7 +279,7 @@ module CallStats = struct (** module for tracing stats of function calls *)
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 IList.sort compare !elems in
IList.iter (fun (x, tr) -> f x tr) sorted_elems List.iter ~f:(fun (x, tr) -> f x tr) sorted_elems
(* (*
let pp fmt t = let pp fmt t =
@ -396,15 +396,15 @@ let pp_specs pe fmt specs =
let cnt = ref 0 in let cnt = ref 0 in
match pe.Pp.kind with match pe.Pp.kind with
| TEXT -> | TEXT ->
IList.iter (fun spec -> incr cnt; List.iter ~f:(fun spec -> incr cnt;
F.fprintf fmt "%a" (pp_spec pe (Some (!cnt, total))) spec) specs F.fprintf fmt "%a" (pp_spec pe (Some (!cnt, total))) spec) specs
| HTML -> | HTML ->
IList.iter (fun spec -> incr cnt; List.iter ~f:(fun spec -> incr cnt;
F.fprintf fmt "%a<br>@\n" (pp_spec pe (Some (!cnt, total))) spec) specs F.fprintf fmt "%a<br>@\n" (pp_spec pe (Some (!cnt, total))) spec) specs
| LATEX -> | LATEX ->
IList.iter (fun spec -> incr cnt; List.iter ~f:(fun spec -> incr cnt;
F.fprintf fmt "\\subsection*{Spec %d of %d}@\n\\(%a\\)@\n" F.fprintf fmt "\\subsection*{Spec %d of %d}@\n\\(%a\\)@\n"
!cnt total (pp_spec pe None) spec) specs !cnt total (pp_spec pe None) spec) specs
let describe_timestamp summary = let describe_timestamp summary =
("Timestamp", Printf.sprintf "%d" summary.timestamp) ("Timestamp", Printf.sprintf "%d" summary.timestamp)
@ -418,8 +418,8 @@ let describe_phase summary =
(** Return the signature of a procedure declaration as a string *) (** Return the signature of a procedure declaration as a string *)
let get_signature summary = let get_signature summary =
let s = ref "" in let s = ref "" in
IList.iter List.iter
(fun (p, typ) -> ~f:(fun (p, typ) ->
let pp f = F.fprintf f "%a %a" (Typ.pp_full Pp.text) typ Mangled.pp p in let pp f = F.fprintf f "%a %a" (Typ.pp_full Pp.text) typ Mangled.pp p in
let decl = F.asprintf "%t" pp in let decl = F.asprintf "%t" pp in
s := if String.equal !s "" then decl else !s ^ ", " ^ decl) s := if String.equal !s "" then decl else !s ^ ", " ^ decl)

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

@ -133,7 +133,7 @@ let node_simple_key node =
| Sil.Abstract _ -> add_key 6 | Sil.Abstract _ -> add_key 6
| Sil.Remove_temps _ -> add_key 7 | Sil.Remove_temps _ -> add_key 7
| Sil.Declare_locals _ -> add_key 8 in | Sil.Declare_locals _ -> add_key 8 in
IList.iter do_instr (Procdesc.Node.get_instrs node); List.iter ~f:do_instr (Procdesc.Node.get_instrs node);
Hashtbl.hash !key Hashtbl.hash !key
(** key for a node: look at the current node, successors and predecessors *) (** key for a node: look at the current node, successors and predecessors *)
@ -198,7 +198,7 @@ let mk_find_duplicate_nodes proc_desc : (Procdesc.Node.t -> Procdesc.NodeSet.t)
let nodes = Procdesc.get_nodes proc_desc in let nodes = Procdesc.get_nodes proc_desc in
try try
IList.iter do_node nodes; List.iter ~f:do_node nodes;
!m !m
with E.Threshold -> with E.Threshold ->
M.empty in M.empty in

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

@ -467,7 +467,7 @@ let check_deallocate_static_memory prop_after =
raise (Exceptions.Deallocate_static_memory freed_desc) raise (Exceptions.Deallocate_static_memory freed_desc)
| _ -> () in | _ -> () in
let exp_att_list = Attribute.get_all prop_after in let exp_att_list = Attribute.get_all prop_after in
IList.iter check_deallocated_attribute exp_att_list; List.iter ~f:check_deallocated_attribute exp_att_list;
prop_after prop_after
let method_exists right_proc_name methods = let method_exists right_proc_name methods =
@ -1230,7 +1230,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
| Sil.Abstract _ -> | Sil.Abstract _ ->
let node = State.get_node () in let node = State.get_node () in
let blocks_nullified = get_blocks_nullified node in let blocks_nullified = get_blocks_nullified node in
IList.iter (check_block_retain_cycle tenv current_pname prop_) blocks_nullified; List.iter ~f:(check_block_retain_cycle tenv current_pname prop_) blocks_nullified;
if Prover.check_inconsistency tenv prop_ if Prover.check_inconsistency tenv prop_
then then
ret_old_path [] ret_old_path []

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

@ -104,7 +104,7 @@ let spec_rename_vars pname spec =
Specs.Jprop.Joined (n, prop_add_callee_suffix p, jp1, jp2) in Specs.Jprop.Joined (n, prop_add_callee_suffix p, jp1, jp2) in
let fav = Sil.fav_new () in let fav = Sil.fav_new () in
Specs.Jprop.fav_add fav spec.Specs.pre; Specs.Jprop.fav_add fav spec.Specs.pre;
IList.iter (fun (p, _) -> Prop.prop_fav_add fav p) spec.Specs.posts; List.iter ~f:(fun (p, _) -> Prop.prop_fav_add fav p) spec.Specs.posts;
let ids = Sil.fav_to_list fav in let ids = Sil.fav_to_list fav in
let ids' = IList.map (fun i -> (i, Ident.create_fresh Ident.kprimed)) ids in let ids' = IList.map (fun i -> (i, Ident.create_fresh Ident.kprimed)) ids in
let ren_sub = Sil.sub_of_list (IList.map (fun (i, i') -> (i, Exp.Var i')) ids') in let ren_sub = Sil.sub_of_list (IList.map (fun (i, i') -> (i, Exp.Var i')) ids') in
@ -165,7 +165,7 @@ let process_splitting
let fav_actual_pre = let fav_actual_pre =
let fav_sub2 = (* vars which represent expansions of fields *) let fav_sub2 = (* vars which represent expansions of fields *)
let fav = Sil.fav_new () in let fav = Sil.fav_new () in
IList.iter (Sil.exp_fav_add fav) (Sil.sub_range sub2); List.iter ~f:(Sil.exp_fav_add fav) (Sil.sub_range sub2);
let filter id = Int.equal (Ident.get_stamp id) (-1) in let filter id = Int.equal (Ident.get_stamp id) (-1) in
Sil.fav_filter_ident fav filter; Sil.fav_filter_ident fav filter;
fav in fav in
@ -192,7 +192,7 @@ let process_splitting
let sub_list = Sil.sub_to_list sub in let sub_list = Sil.sub_to_list sub in
let fav_sub_list = let fav_sub_list =
let fav_sub = Sil.fav_new () in let fav_sub = Sil.fav_new () in
IList.iter (fun (_, e) -> Sil.exp_fav_add fav_sub e) sub_list; List.iter ~f:(fun (_, e) -> Sil.exp_fav_add fav_sub e) sub_list;
Sil.fav_to_list fav_sub in Sil.fav_to_list fav_sub in
let sub1 = let sub1 =
let f id = let f id =
@ -377,7 +377,7 @@ let check_path_errors_in_post tenv caller_pname post post_path =
let exn = Exceptions.Divide_by_zero (desc, __POS__) in let exn = Exceptions.Divide_by_zero (desc, __POS__) in
Reporting.log_warning caller_pname exn Reporting.log_warning caller_pname exn
| _ -> () in | _ -> () in
IList.iter check_attr (Attribute.get_all post) List.iter ~f:check_attr (Attribute.get_all post)
(** Post process the instantiated post after the function call so that (** Post process the instantiated post after the function call so that
x.f |-> se becomes x |-> \{ f: se \}. x.f |-> se becomes x |-> \{ f: se \}.
@ -848,7 +848,7 @@ let check_taint_on_variadic_function tenv callee_pname caller_pname actual_param
" onwards."); " onwards.");
let actual_params' = n_tail actual_params tp_abs in let actual_params' = n_tail actual_params tp_abs in
L.d_str "Paramters to be checked: [ "; L.d_str "Paramters to be checked: [ ";
IList.iter(fun (e,_) -> List.iter ~f:(fun (e,_) ->
L.d_str (" " ^ (Exp.to_string e) ^ " "); L.d_str (" " ^ (Exp.to_string e) ^ " ");
match Attribute.get_taint tenv calling_prop e with match Attribute.get_taint tenv calling_prop e with
| Some (Apred (Ataint taint_info, _)) -> | Some (Apred (Ataint taint_info, _)) ->
@ -973,7 +973,7 @@ let do_taint_check tenv caller_pname callee_pname calling_prop missing_pi sub ac
| Apred (Ataint taint_info, _) -> taint_info | Apred (Ataint taint_info, _) -> taint_info
| _ -> failwith "Expected to get taint attr on atom" in | _ -> failwith "Expected to get taint attr on atom" in
report_taint_error e taint_info callee_pname caller_pname calling_prop in report_taint_error e taint_info callee_pname caller_pname calling_prop in
IList.iter report_one_error taint_atoms in List.iter ~f:report_one_error taint_atoms in
Exp.Map.iter report_taint_errors taint_untaint_exp_map; Exp.Map.iter report_taint_errors taint_untaint_exp_map;
(* filter out UNTAINT(e) atoms from [missing_pi] such that we have already reported a taint (* filter out UNTAINT(e) atoms from [missing_pi] such that we have already reported a taint
error on e. without doing this, we will get PRECONDITION_NOT_MET (and failed spec error on e. without doing this, we will get PRECONDITION_NOT_MET (and failed spec
@ -1008,7 +1008,7 @@ let get_check_exn tenv check callee_pname loc ml_loc = match check with
class_cast_exn tenv (Some callee_pname) texp1 texp2 exp ml_loc class_cast_exn tenv (Some callee_pname) texp1 texp2 exp ml_loc
let check_uninitialize_dangling_deref tenv callee_pname actual_pre sub formal_params props = let check_uninitialize_dangling_deref tenv callee_pname actual_pre sub formal_params props =
IList.iter (fun (p, _ ) -> List.iter ~f:(fun (p, _ ) ->
match check_dereferences tenv callee_pname actual_pre sub p formal_params with match check_dereferences tenv callee_pname actual_pre sub p formal_params with
| Some (Deref_undef_exp, desc) -> | Some (Deref_undef_exp, desc) ->
raise (Exceptions.Dangling_pointer_dereference (Some PredSymb.DAuninit, desc, __POS__)) raise (Exceptions.Dangling_pointer_dereference (Some PredSymb.DAuninit, desc, __POS__))
@ -1065,7 +1065,7 @@ let exe_spec
vr_cons_res = consistent_results; vr_cons_res = consistent_results;
vr_incons_res = inconsistent_results } in vr_incons_res = inconsistent_results } in
begin begin
IList.iter log_check_exn checks; List.iter ~f:log_check_exn checks;
let subbed_pre = (Prop.prop_sub sub1 actual_pre) in let subbed_pre = (Prop.prop_sub sub1 actual_pre) in
match check_dereferences tenv callee_pname subbed_pre sub2 spec_pre formal_params with match check_dereferences tenv callee_pname subbed_pre sub2 spec_pre formal_params with
| Some (Deref_undef _, _) when Config.angelic_execution -> | Some (Deref_undef _, _) when Config.angelic_execution ->
@ -1243,7 +1243,7 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re
else else
begin begin
L.d_strln "Missing pure facts for the function call:"; L.d_strln "Missing pure facts for the function call:";
IList.iter print_pi (IList.map (fun vr -> vr.vr_pi) valid_res_miss_pi); List.iter ~f:print_pi (IList.map (fun vr -> vr.vr_pi) valid_res_miss_pi);
match match
Prover.find_minimum_pure_cover tenv Prover.find_minimum_pure_cover tenv
(IList.map (fun vr -> (vr.vr_pi, vr.vr_cons_res)) valid_res_miss_pi) with (IList.map (fun vr -> (vr.vr_pi, vr.vr_cons_res)) valid_res_miss_pi) with
@ -1252,7 +1252,7 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re
raise (Exceptions.Precondition_not_met (call_desc None, __POS__)) raise (Exceptions.Precondition_not_met (call_desc None, __POS__))
| Some cover -> | Some cover ->
L.d_strln "Found minimum cover"; L.d_strln "Found minimum cover";
IList.iter print_pi (IList.map fst cover); List.iter ~f:print_pi (IList.map fst cover);
List.concat (IList.map snd cover) List.concat (IList.map snd cover)
end in end in
trace_call Specs.CallStats.CR_success; trace_call Specs.CallStats.CR_success;

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

@ -395,8 +395,8 @@ let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b)
let mk_bool_group ?(deprecated_no=[]) ?(default=false) let mk_bool_group ?(deprecated_no=[]) ?(default=false)
?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc children no_children = ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc children no_children =
let f b = let f b =
IList.iter (fun child -> child := b) children ; List.iter ~f:(fun child -> child := b) children ;
IList.iter (fun child -> child := not b) no_children ; List.iter ~f:(fun child -> child := not b) no_children ;
b b
in in
mk_bool ~deprecated ~deprecated_no ~default ~long ?short ~f ?parse_mode ~meta doc mk_bool ~deprecated ~deprecated_no ~default ~long ?short ~f ?parse_mode ~meta doc
@ -630,7 +630,7 @@ let set_curr_speclist_for_parse_action ~incomplete ~usage parse_action =
and that instance is the one that has a non-empty docstring if there is one. *) and that instance is the one that has a non-empty docstring if there is one. *)
let is_not_dup_with_doc speclist (opt, _, doc) = let is_not_dup_with_doc speclist (opt, _, doc) =
opt = "" || opt = "" ||
IList.for_all (fun (opt', _, doc') -> List.for_all ~f:(fun (opt', _, doc') ->
(doc <> "" && doc' = "") || (not (String.equal opt opt'))) speclist in (doc <> "" && doc' = "") || (not (String.equal opt opt'))) speclist in
let unique_exe_speclist = List.filter ~f:(is_not_dup_with_doc !curr_speclist) exe_speclist in let unique_exe_speclist = List.filter ~f:(is_not_dup_with_doc !curr_speclist) exe_speclist in
curr_speclist := List.filter ~f:(is_not_dup_with_doc unique_exe_speclist) !curr_speclist @ curr_speclist := List.filter ~f:(is_not_dup_with_doc unique_exe_speclist) !curr_speclist @

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

@ -1195,7 +1195,7 @@ and specs_library =
failwith ("Failing because path " ^ path ^ " is not absolute") in failwith ("Failing because path " ^ path ^ " is not absolute") in
match Utils.read_file (resolve fname) with match Utils.read_file (resolve fname) with
| Some pathlist -> | Some pathlist ->
IList.iter validate_path pathlist; List.iter ~f:validate_path pathlist;
pathlist pathlist
| None -> failwith ("cannot read file " ^ fname ^ " from cwd " ^ (Sys.getcwd ())) | None -> failwith ("cannot read file " ^ fname ^ " from cwd " ^ (Sys.getcwd ()))
in in
@ -1671,7 +1671,7 @@ let specs_library =
let dest_file = dest_dir ^/ (Filename.basename entry.filename) in let dest_file = dest_dir ^/ (Filename.basename entry.filename) in
if Filename.check_suffix entry.filename specs_files_suffix if Filename.check_suffix entry.filename specs_files_suffix
then Zip.copy_entry_to_file zip_channel entry dest_file in then Zip.copy_entry_to_file zip_channel entry dest_file in
IList.iter extract_entry entries; List.iter ~f:extract_entry entries;
Zip.close_in zip_channel in Zip.close_in zip_channel in
extract_specs key_dir filename; extract_specs key_dir filename;
key_dir :: specs_library in key_dir :: specs_library in

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

@ -44,11 +44,11 @@ let find_source_dirs () =
let files_in_results_dir = Array.to_list (Sys.readdir captured_dir) in let files_in_results_dir = Array.to_list (Sys.readdir captured_dir) in
let add_cg_files_from_dir dir = let add_cg_files_from_dir dir =
let files = Array.to_list (Sys.readdir dir) in let files = Array.to_list (Sys.readdir dir) in
IList.iter (fun fname -> List.iter ~f:(fun fname ->
let path = Filename.concat dir fname in let path = Filename.concat dir fname in
if Filename.check_suffix path ".cg" then source_dirs := dir :: !source_dirs) if Filename.check_suffix path ".cg" then source_dirs := dir :: !source_dirs)
files in files in
IList.iter (fun fname -> List.iter ~f:(fun fname ->
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;

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

@ -9,11 +9,6 @@
let exists = List.exists let exists = List.exists
let fold_left = List.fold_left let fold_left = List.fold_left
let for_all = List.for_all
let for_all2 = List.for_all2
let iter = List.iter
let iter2 = List.iter2
let iteri = List.iteri
let length = List.length let length = List.length
let nth = List.nth let nth = List.nth
let partition = List.partition let partition = List.partition

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

@ -10,11 +10,6 @@
(** Remove all None elements from the list. *) (** Remove all None elements from the list. *)
val flatten_options : ('a option) list -> 'a list val flatten_options : ('a option) list -> 'a list
val for_all : ('a -> bool) -> 'a list -> bool
val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
val iter : ('a -> unit) -> 'a list -> unit
val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit
val iteri : (int -> 'a -> unit) -> 'a list -> unit
val length : 'a list -> int val length : 'a list -> int
(** tail-recursive variant of List.map *) (** tail-recursive variant of List.map *)

3
infer/src/base/Multilinks.re
Unescape View File

@ -33,7 +33,8 @@ let read dir::dir :option t => {
| None => None | None => None
| Some lines => | Some lines =>
let links = create (); let links = create ();
IList.iter (fun line => String.Table.set links key::(Filename.basename line) data::line) lines; List.iter
f::(fun line => String.Table.set links key::(Filename.basename line) data::line) lines;
String.Table.set multilink_files_cache key::dir data::links; String.Table.set multilink_files_cache key::dir data::links;
Some links Some links
} }

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

@ -222,7 +222,7 @@ let report_siof trace pdesc gname loc =
SiofTrace.get_reportable_sink_paths trace ~trace_of_pname SiofTrace.get_reportable_sink_paths trace ~trace_of_pname
|> List.filter ~f:has_foreign_sink |> List.filter ~f:has_foreign_sink
|> IList.iter report_one_path |> List.iter ~f:report_one_path
let siof_check pdesc gname = function let siof_check pdesc gname = function
| Some ((SiofDomain.BottomSiofTrace.NonBottom post, _)) -> | Some ((SiofDomain.BottomSiofTrace.NonBottom post, _)) ->

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

@ -873,8 +873,8 @@ let report_thread_safety_violations ( _, tenv, pname, pdesc) make_description tr
let exn = Exceptions.Checkers (msg, Localise.verbatim_desc description) in let exn = Exceptions.Checkers (msg, Localise.verbatim_desc description) in
Reporting.log_error pname ~loc ~ltr exn in Reporting.log_error pname ~loc ~ltr exn in
IList.iter List.iter
report_one_path ~f:report_one_path
(PathDomain.get_reportable_sink_paths (de_dup trace) ~trace_of_pname) (PathDomain.get_reportable_sink_paths (de_dup trace) ~trace_of_pname)
@ -888,18 +888,18 @@ let make_unprotected_write_description
(calculate_addendum_message tenv pname) (calculate_addendum_message tenv pname)
let make_read_write_race_description tenv pname final_sink_site initial_sink_site final_sink tab = let make_read_write_race_description tenv pname final_sink_site initial_sink_site final_sink tab =
let conflicting_proc_envs = IList.map let conflicting_proc_envs = List.map
fst ~f:fst
(collect_conflicting_writes final_sink tab) in (collect_conflicting_writes final_sink tab) in
let conflicting_proc_names = IList.map let conflicting_proc_names = List.map
(fun (_,_,proc_name,_) -> proc_name) ~f:(fun (_,_,proc_name,_) -> proc_name)
conflicting_proc_envs in conflicting_proc_envs in
let pp_proc_name_list fmt proc_names = let pp_proc_name_list fmt proc_names =
let pp_sep _ _ = F.fprintf fmt " , " in let pp_sep _ _ = F.fprintf fmt " , " in
F.pp_print_list ~pp_sep Procname.pp fmt proc_names in F.pp_print_list ~pp_sep Procname.pp fmt proc_names in
let conflicts_description = let conflicts_description =
Format.asprintf "Potentially races with writes in method%s %a." Format.asprintf "Potentially races with writes in method%s %a."
(if IList.length conflicting_proc_names > 1 then "s" else "") (if List.length conflicting_proc_names > 1 then "s" else "")
pp_proc_name_list conflicting_proc_names in pp_proc_name_list conflicting_proc_names in
Format.asprintf "Read/Write race. Public method %a%s reads from field %a. %s %s" Format.asprintf "Read/Write race. Public method %a%s reads from field %a. %s %s"
Procname.pp pname Procname.pp pname

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

@ -236,13 +236,13 @@ let report_call_stack end_of_stack lookup_next_calls report call_site calls =
else ((p, loc) :: accu, Procname.Set.add p set)) else ((p, loc) :: accu, Procname.Set.add p set))
~init:([], visited_pnames) ~init:([], visited_pnames)
next_calls in next_calls in
IList.iter (loop fst_call_loc updated_visited (new_trace, new_stack_str)) unseen_pnames in List.iter ~f:(loop fst_call_loc updated_visited (new_trace, new_stack_str)) unseen_pnames in
IList.iter List.iter
(fun fst_call_site -> ~f:(fun fst_call_site ->
let fst_callee_pname = CallSite.pname fst_call_site in let fst_callee_pname = CallSite.pname fst_call_site in
let fst_call_loc = CallSite.loc fst_call_site in let fst_call_loc = CallSite.loc fst_call_site in
let start_trace = update_trace (CallSite.loc call_site) [] in let start_trace = update_trace (CallSite.loc call_site) [] in
loop fst_call_loc Procname.Set.empty (start_trace, "") (fst_callee_pname, fst_call_loc)) loop fst_call_loc Procname.Set.empty (start_trace, "") (fst_callee_pname, fst_call_loc))
calls calls
module TransferFunctions (CFG : ProcCfg.S) = struct module TransferFunctions (CFG : ProcCfg.S) = struct
@ -386,7 +386,7 @@ module Interprocedural = struct
calls in calls in
let calls = extract_calls_with_annot snk_annot call_map in let calls = extract_calls_with_annot snk_annot call_map in
if not (Int.equal (IList.length calls) 0) if not (Int.equal (IList.length calls) 0)
then IList.iter (report_src_snk_path calls) src_annot_list in then List.iter ~f:(report_src_snk_path calls) src_annot_list in
let initial = let initial =
let init_map = let init_map =
@ -402,7 +402,7 @@ module Interprocedural = struct
~make_extras:ProcData.make_empty_extras ~make_extras:ProcData.make_empty_extras
proc_data with proc_data with
| Some Domain.NonBottom (call_map, _) -> | Some Domain.NonBottom (call_map, _) ->
IList.iter (report_src_snk_paths call_map) (src_snk_pairs ()) List.iter ~f:(report_src_snk_paths call_map) (src_snk_pairs ())
| Some Domain.Bottom | None -> | Some Domain.Bottom | None ->
() ()
end end

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

@ -87,7 +87,7 @@ let check_final_state tenv proc_name proc_desc final_s =
| _ -> true in | _ -> true in
if report if report
then report_error tenv description proc_name proc_desc loc in then report_error tenv description proc_name proc_desc loc in
IList.iter do_node not_visited List.iter ~f:do_node not_visited
end end
(** Simple check for dead code. *) (** Simple check for dead code. *)

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

@ -306,7 +306,7 @@ let do_node tenv pn pd idenv _ node (s : State.t) : (State.t list) * (State.t li
let state2 = BooleanVars.do_instr pn pd idenv instr state1 in let state2 = BooleanVars.do_instr pn pd idenv instr state1 in
curr_state := state2 in curr_state := state2 in
IList.iter do_instr (Procdesc.Node.get_instrs node); List.iter ~f:do_instr (Procdesc.Node.get_instrs node);
[!curr_state], [!curr_state] [!curr_state], [!curr_state]
(** Check the final state at the end of the analysis. *) (** Check the final state at the end of the analysis. *)

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

@ -182,7 +182,7 @@ let callback_check_access { Callbacks.tenv; proc_desc } =
(** Report all field accesses and method calls of a class. *) (** Report all field accesses and method calls of a class. *)
let callback_check_cluster_access exe_env all_procs get_proc_desc _ = let callback_check_cluster_access exe_env all_procs get_proc_desc _ =
IList.iter (fun proc_name -> List.iter ~f:(fun proc_name ->
match get_proc_desc proc_name with match get_proc_desc proc_name with
| Some proc_desc -> | Some proc_desc ->
let tenv = Exe_env.get_tenv exe_env proc_name in let tenv = Exe_env.get_tenv exe_env proc_name in
@ -542,7 +542,7 @@ let callback_check_field_access { Callbacks.proc_desc } =
do_read_exp e do_read_exp e
| Sil.Call (_, e, etl, _, _) -> | Sil.Call (_, e, etl, _, _) ->
do_read_exp e; do_read_exp e;
IList.iter (fun (e, _) -> do_read_exp e) etl List.iter ~f:(fun (e, _) -> do_read_exp e) etl
| Sil.Nullify _ | Sil.Nullify _
| Sil.Abstract _ | Sil.Abstract _
| Sil.Remove_temps _ | Sil.Remove_temps _

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

@ -112,8 +112,8 @@ module ConstantFlow = Dataflow.MakeDF(struct
begin begin
L.stdout "Node %i:" (Procdesc.Node.get_id node :> int); L.stdout "Node %i:" (Procdesc.Node.get_id node :> int);
L.stdout "%a" pp constants; L.stdout "%a" pp constants;
IList.iter List.iter
(fun instr -> L.stdout "%a@." (Sil.pp_instr Pp.text) instr) ~f:(fun instr -> L.stdout "%a@." (Sil.pp_instr Pp.text) instr)
(Procdesc.Node.get_instrs node) (Procdesc.Node.get_instrs node)
end; end;
let constants = let constants =

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

@ -75,7 +75,7 @@ let node_throws pdesc node (proc_throws : Procname.t -> throws) : throws =
| t, DoesNotThrow -> res := t in | t, DoesNotThrow -> res := t in
let do_instr instr = update_res (instr_throws instr) in let do_instr instr = update_res (instr_throws instr) in
IList.iter do_instr (Procdesc.Node.get_instrs node); List.iter ~f:do_instr (Procdesc.Node.get_instrs node);
!res !res
(** Create an instance of the dataflow algorithm given a state parameter. *) (** Create an instance of the dataflow algorithm given a state parameter. *)
@ -121,12 +121,12 @@ module MakeDF(St: DFStateType) : DF with type state = St.t = struct
let succ_nodes = Procdesc.Node.get_succs node in let succ_nodes = Procdesc.Node.get_succs node in
let exn_nodes = Procdesc.Node.get_exn node in let exn_nodes = Procdesc.Node.get_exn node in
if throws <> Throws then if throws <> Throws then
IList.iter List.iter
(fun s -> IList.iter (propagate_to_dest s) succ_nodes) ~f:(fun s -> List.iter ~f:(propagate_to_dest s) succ_nodes)
states_succ; states_succ;
if throws <> DoesNotThrow then if throws <> DoesNotThrow then
IList.iter List.iter
(fun s -> IList.iter (propagate_to_dest s) exn_nodes) ~f:(fun s -> List.iter ~f:(propagate_to_dest s) exn_nodes)
states_exn; states_exn;
H.replace t.post_states node states_succ; H.replace t.post_states node states_succ;
@ -187,4 +187,4 @@ let callback_test_dataflow { Callbacks.proc_desc; tenv } =
match transitions node with match transitions node with
| DFCount.Transition _ -> () | DFCount.Transition _ -> ()
| DFCount.Dead_state -> () in | DFCount.Dead_state -> () in
IList.iter do_node (Procdesc.get_nodes proc_desc) List.iter ~f:do_node (Procdesc.get_nodes proc_desc)

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

@ -42,8 +42,8 @@ let callback_fragment_retains_view_java
List.filter ~f:(is_declared_view_typ class_typename) fields in List.filter ~f:(is_declared_view_typ class_typename) fields in
let fields_nullified = PatternMatch.get_fields_nullified proc_desc in let fields_nullified = PatternMatch.get_fields_nullified proc_desc in
(* report if a field is declared by C, but not nulled out in C.onDestroyView *) (* report if a field is declared by C, but not nulled out in C.onDestroyView *)
IList.iter List.iter
(fun (fname, fld_typ, _) -> ~f:(fun (fname, fld_typ, _) ->
if not (Ident.FieldSet.mem fname fields_nullified) then if not (Ident.FieldSet.mem fname fields_nullified) then
report_error report_error
(Tstruct class_typename) fname fld_typ (Procname.Java pname_java) proc_desc) (Tstruct class_typename) fname fld_typ (Procname.Java pname_java) proc_desc)

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

@ -211,7 +211,7 @@ 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
let equal_formal_arg (_, typ) arg_type_name = String.equal (get_type_name typ) arg_type_name in let equal_formal_arg (_, typ) arg_type_name = String.equal (get_type_name typ) arg_type_name in
Int.equal (IList.length formals) (IList.length argument_type_names) Int.equal (IList.length formals) (IList.length argument_type_names)
&& IList.for_all2 equal_formal_arg formals argument_type_names && List.for_all2_exn ~f:equal_formal_arg formals argument_type_names
let has_formal_method_argument_type_names cfg pname_java argument_type_names = let has_formal_method_argument_type_names cfg pname_java argument_type_names =
has_formal_proc_argument_type_names has_formal_proc_argument_type_names
@ -305,7 +305,7 @@ let java_get_vararg_values node pvar idenv =
values := content_exp :: !values values := content_exp :: !values
| _ -> () in | _ -> () in
let do_node n = let do_node n =
IList.iter do_instr (Procdesc.Node.get_instrs n) in List.iter ~f:do_instr (Procdesc.Node.get_instrs n) in
let () = match Errdesc.find_program_variable_assignment node pvar with let () = match Errdesc.find_program_variable_assignment node pvar with
| Some (node', _) -> | Some (node', _) ->
Procdesc.iter_slope_range do_node node' node Procdesc.iter_slope_range do_node node' node
@ -326,9 +326,9 @@ let proc_calls resolve_attributes pdesc filter : (Procname.t * ProcAttributes.t)
| _ -> () in | _ -> () in
let do_node node = let do_node node =
let instrs = Procdesc.Node.get_instrs node in let instrs = Procdesc.Node.get_instrs node in
IList.iter (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
IList.iter do_node nodes; List.iter ~f:do_node nodes;
IList.rev !res IList.rev !res
let override_exists f tenv proc_name = let override_exists f tenv proc_name =

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

@ -66,5 +66,5 @@ let active_cluster_checkers () =
let register () = let register () =
let register registry (callback, active, language_opt) = let register registry (callback, active, language_opt) =
if active then registry language_opt callback in if active then registry language_opt callback in
IList.iter (register Callbacks.register_procedure_callback) (active_procedure_checkers ()); List.iter ~f:(register Callbacks.register_procedure_callback) (active_procedure_checkers ());
IList.iter (register Callbacks.register_cluster_callback) (active_cluster_checkers ()) List.iter ~f:(register Callbacks.register_cluster_callback) (active_cluster_checkers ())

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

@ -75,7 +75,7 @@ struct
| Sil.Call (_, Exp.Const (Const.Cfun pn), _, loc, _) when proc_is_new pn -> | Sil.Call (_, Exp.Const (Const.Cfun pn), _, loc, _) when proc_is_new pn ->
found := Some loc found := Some loc
| _ -> () in | _ -> () in
IList.iter do_instr (Procdesc.Node.get_instrs node); List.iter ~f:do_instr (Procdesc.Node.get_instrs node);
!found in !found in
let module DFAllocCheck = Dataflow.MakeDF(struct let module DFAllocCheck = Dataflow.MakeDF(struct
@ -114,7 +114,7 @@ struct
(* same temporary variable does not imply same value *) (* same temporary variable does not imply same value *)
not (Pvar.is_frontend_tmp pvar) not (Pvar.is_frontend_tmp pvar)
| _ -> true in | _ -> true in
IList.for_all filter_arg args in List.for_all ~f:filter_arg args in
match instr with match instr with
| Sil.Call (Some _ as ret_id, Exp.Const (Const.Cfun callee_pname), _, loc, call_flags) | Sil.Call (Some _ as ret_id, Exp.Const (Const.Cfun callee_pname), _, loc, call_flags)

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

@ -111,7 +111,7 @@ let exe prog::prog args::args => {
(bin_xx, true) (bin_xx, true)
| None => (clang_xx, false) | None => (clang_xx, false)
}; };
IList.iter exec_action_item commands; List.iter f::exec_action_item commands;
if (List.is_empty commands || should_run_original_command) { if (List.is_empty commands || should_run_original_command) {
if (List.is_empty commands) { if (List.is_empty commands) {
/* No command to execute after -###, let's execute the original command /* No command to execute after -###, let's execute the original command

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

@ -264,7 +264,7 @@ let add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt fail_if_not_fo
let add_type_from_decl_ref_list type_ptr_to_sil_type tenv decl_ref_list = let add_type_from_decl_ref_list type_ptr_to_sil_type tenv decl_ref_list =
let add_elem dr = let add_elem dr =
ignore (type_ptr_to_sil_type tenv (`DeclPtr dr.Clang_ast_t.dr_decl_pointer)) in ignore (type_ptr_to_sil_type tenv (`DeclPtr dr.Clang_ast_t.dr_decl_pointer)) in
IList.iter add_elem decl_ref_list List.iter ~f:add_elem decl_ref_list
let get_function_decl_with_body decl_ptr = let get_function_decl_with_body decl_ptr =
let open Clang_ast_t in let open Clang_ast_t in
@ -338,7 +338,7 @@ let rec generate_key_stmt stmt =
let tags = IList.map generate_key_stmt stmts in let tags = IList.map generate_key_stmt stmts in
let buffer = Buffer.create 16 in let buffer = Buffer.create 16 in
let tags = tag_str :: tags in let tags = tag_str :: tags in
IList.iter (fun tag -> Buffer.add_string buffer tag) tags; List.iter ~f:(fun tag -> Buffer.add_string buffer tag) tags;
Buffer.contents buffer Buffer.contents buffer
(* Generates a key for a declaration based on its name and the declaration tag. *) (* Generates a key for a declaration based on its name and the declaration tag. *)

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

@ -25,8 +25,8 @@ let compute_icfg trans_unit_ctx tenv ast =
Logging.out_debug "@\n Start creating icfg@\n"; Logging.out_debug "@\n Start creating icfg@\n";
let cg = Cg.create (Some trans_unit_ctx.CFrontend_config.source_file) in let cg = Cg.create (Some trans_unit_ctx.CFrontend_config.source_file) in
let cfg = Cfg.create_cfg () in let cfg = Cfg.create_cfg () in
IList.iter List.iter
(CFrontend_declImpl.translate_one_declaration trans_unit_ctx tenv cg cfg `DeclTraversal) ~f:(CFrontend_declImpl.translate_one_declaration trans_unit_ctx tenv cg cfg `DeclTraversal)
decl_list; decl_list;
Logging.out_debug "\n Finished creating icfg\n"; Logging.out_debug "\n Finished creating icfg\n";
(cg, cfg) (cg, cfg)

20
infer/src/clang/cFrontend_checkers_main.ml
Unescape View File

@ -26,7 +26,7 @@ let parse_ctl_file linters_files =
| Ctl_parser.Error -> | Ctl_parser.Error ->
Logging.err "%a: syntax error\n" print_position lexbuf; Logging.err "%a: syntax error\n" print_position lexbuf;
exit (-1) in exit (-1) in
IList.iter (fun fn -> List.iter ~f:(fun fn ->
Logging.out "Loading linters rules from %s\n" fn; Logging.out "Loading linters rules from %s\n" fn;
let inx = open_in fn in let inx = open_in fn in
let lexbuf = Lexing.from_channel inx in let lexbuf = Lexing.from_channel inx in
@ -36,7 +36,7 @@ let parse_ctl_file linters_files =
Logging.out "#### Start Expanding checkers #####\n"; Logging.out "#### Start Expanding checkers #####\n";
let exp_checkers = CFrontend_errors.expand_checkers parsed_checkers in let exp_checkers = CFrontend_errors.expand_checkers parsed_checkers in
Logging.out "#### Checkers Expanded #####\n"; Logging.out "#### Checkers Expanded #####\n";
if Config.debug_mode then IList.iter CTL.print_checker exp_checkers; if Config.debug_mode then List.iter ~f:CTL.print_checker exp_checkers;
CFrontend_errors.make_condition_issue_desc_pair exp_checkers; CFrontend_errors.make_condition_issue_desc_pair exp_checkers;
| None -> Logging.out "No linters found.\n"); | None -> Logging.out "No linters found.\n");
In_channel.close inx) linters_files In_channel.close inx) linters_files
@ -131,20 +131,20 @@ let rec do_frontend_checks_stmt (context:CLintersContext.context) stmt =
let do_all_checks_on_stmts context stmt = let do_all_checks_on_stmts context stmt =
(match stmt with (match stmt with
| DeclStmt (_, _, decl_list) -> | DeclStmt (_, _, decl_list) ->
IList.iter (do_frontend_checks_decl context) decl_list List.iter ~f:(do_frontend_checks_decl context) decl_list
| BlockExpr (_, _, _, decl) -> | BlockExpr (_, _, _, decl) ->
IList.iter (do_frontend_checks_decl context) [decl] List.iter ~f:(do_frontend_checks_decl context) [decl]
| _ -> ()); | _ -> ());
do_frontend_checks_stmt context stmt in do_frontend_checks_stmt context stmt in
CFrontend_errors.invoke_set_of_checkers_on_node context (Ctl_parser_types.Stmt stmt); CFrontend_errors.invoke_set_of_checkers_on_node context (Ctl_parser_types.Stmt stmt);
match stmt with match stmt with
| ObjCAtSynchronizedStmt (_, stmt_list) -> | ObjCAtSynchronizedStmt (_, stmt_list) ->
let stmt_context = { context with CLintersContext.in_synchronized_block = true } in let stmt_context = { context with CLintersContext.in_synchronized_block = true } in
IList.iter (do_all_checks_on_stmts stmt_context) stmt_list List.iter ~f:(do_all_checks_on_stmts stmt_context) stmt_list
| IfStmt (_, [stmt1; stmt2; cond_stmt; inside_if_stmt; inside_else_stmt]) -> | IfStmt (_, [stmt1; stmt2; cond_stmt; inside_if_stmt; inside_else_stmt]) ->
(* here we analyze the children of the if stmt with the standard context, (* here we analyze the children of the if stmt with the standard context,
except for inside_if_stmt... *) except for inside_if_stmt... *)
IList.iter (do_all_checks_on_stmts context) [stmt1; stmt2; cond_stmt; inside_else_stmt]; List.iter ~f:(do_all_checks_on_stmts context) [stmt1; stmt2; cond_stmt; inside_else_stmt];
let inside_if_stmt_context = let inside_if_stmt_context =
{context with CLintersContext.if_context = compute_if_context context cond_stmt } in {context with CLintersContext.if_context = compute_if_context context cond_stmt } in
(* ...and here we analyze the stmt inside the if with the context (* ...and here we analyze the stmt inside the if with the context
@ -152,7 +152,7 @@ let rec do_frontend_checks_stmt (context:CLintersContext.context) stmt =
do_all_checks_on_stmts inside_if_stmt_context inside_if_stmt do_all_checks_on_stmts inside_if_stmt_context inside_if_stmt
| _ -> | _ ->
let stmts = CAst_utils.get_stmts_from_stmt stmt in let stmts = CAst_utils.get_stmts_from_stmt stmt in
IList.iter (do_all_checks_on_stmts context) stmts List.iter ~f:(do_all_checks_on_stmts context) stmts
and do_frontend_checks_decl (context: CLintersContext.context) decl = and do_frontend_checks_decl (context: CLintersContext.context) decl =
let open Clang_ast_t in let open Clang_ast_t in
@ -182,10 +182,10 @@ and do_frontend_checks_decl (context: CLintersContext.context) decl =
| None -> ()) | None -> ())
| ObjCImplementationDecl (_, _, decls, _, _) -> | ObjCImplementationDecl (_, _, decls, _, _) ->
let context' = {context with current_objc_impl = Some decl} in let context' = {context with current_objc_impl = Some decl} in
IList.iter (do_frontend_checks_decl context') decls List.iter ~f:(do_frontend_checks_decl context') decls
| _ -> match Clang_ast_proj.get_decl_context_tuple decl with | _ -> match Clang_ast_proj.get_decl_context_tuple decl with
| Some (decls, _) -> | Some (decls, _) ->
IList.iter (do_frontend_checks_decl context) decls List.iter ~f:(do_frontend_checks_decl context) decls
| None -> () | None -> ()
let context_with_ck_set context decl_list = let context_with_ck_set context decl_list =
@ -219,7 +219,7 @@ let do_frontend_checks trans_unit_ctx ast =
let allowed_decls = List.filter ~f:is_decl_allowed decl_list in let allowed_decls = List.filter ~f:is_decl_allowed decl_list in
(* We analyze the top level and then all the allowed declarations *) (* We analyze the top level and then all the allowed declarations *)
CFrontend_errors.invoke_set_of_checkers_on_node context (Ctl_parser_types.Decl ast); CFrontend_errors.invoke_set_of_checkers_on_node context (Ctl_parser_types.Decl ast);
IList.iter (do_frontend_checks_decl context) allowed_decls; List.iter ~f:(do_frontend_checks_decl context) allowed_decls;
if (LintIssues.exists_issues ()) then if (LintIssues.exists_issues ()) then
store_issues source_file; store_issues source_file;
Logging.out "End linting file %a@\n" SourceFile.pp source_file; Logging.out "End linting file %a@\n" SourceFile.pp source_file;

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

@ -135,7 +135,7 @@ struct
() ()
let process_methods trans_unit_ctx tenv cg cfg curr_class decl_list = let process_methods trans_unit_ctx tenv cg cfg curr_class decl_list =
IList.iter (process_one_method_decl trans_unit_ctx tenv cg cfg curr_class) decl_list List.iter ~f:(process_one_method_decl trans_unit_ctx tenv cg cfg curr_class) decl_list
(** Given REVERSED list of method qualifiers (method_name::class_name::rest_quals), return (** Given REVERSED list of method qualifiers (method_name::class_name::rest_quals), return
whether method should be translated based on method and class whitelists *) whether method should be translated based on method and class whitelists *)
@ -269,19 +269,19 @@ struct
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 = IList.partition is_method_decl decl_list in
IList.iter 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);
IList.iter translate method_decls List.iter ~f:translate method_decls
| EnumDecl _ -> ignore (CEnum_decl.enum_decl dec) | EnumDecl _ -> ignore (CEnum_decl.enum_decl dec)
| LinkageSpecDecl (_, decl_list, _) -> | LinkageSpecDecl (_, decl_list, _) ->
Logging.out_debug "ADDING: LinkageSpecDecl decl list@\n"; Logging.out_debug "ADDING: LinkageSpecDecl decl list@\n";
IList.iter translate decl_list List.iter ~f:translate decl_list
| NamespaceDecl (_, _, decl_list, _, _) -> | NamespaceDecl (_, _, decl_list, _, _) ->
IList.iter translate decl_list List.iter ~f:translate decl_list
| ClassTemplateDecl (_, _, template_decl_info) | ClassTemplateDecl (_, _, template_decl_info)
| FunctionTemplateDecl (_, _, template_decl_info) -> | FunctionTemplateDecl (_, _, template_decl_info) ->
let decl_list = template_decl_info.Clang_ast_t.tdi_specializations in let decl_list = template_decl_info.Clang_ast_t.tdi_specializations in
IList.iter translate decl_list List.iter ~f:translate decl_list
| _ -> () | _ -> ()
end end

6
infer/src/clang/cFrontend_errors.ml
Unescape View File

@ -216,10 +216,10 @@ let invoke_set_of_hard_coded_checkers_an context (an : Ctl_parser_types.ast_node
let checkers, key = match an with let checkers, key = match an with
| Decl dec -> decl_checkers_list, CAst_utils.generate_key_decl dec | Decl dec -> decl_checkers_list, CAst_utils.generate_key_decl dec
| Stmt st -> stmt_checkers_list, CAst_utils.generate_key_stmt st in | Stmt st -> stmt_checkers_list, CAst_utils.generate_key_stmt st in
IList.iter (fun checker -> List.iter ~f:(fun checker ->
let condition, issue_desc_list = checker context an in let condition, issue_desc_list = checker context an in
if CTL.eval_formula condition an context then if CTL.eval_formula condition an context then
IList.iter (fun issue_desc -> List.iter ~f:(fun issue_desc ->
if CIssue.should_run_check issue_desc.CIssue.mode then if CIssue.should_run_check issue_desc.CIssue.mode then
let loc = issue_desc.CIssue.loc in let loc = issue_desc.CIssue.loc in
fill_issue_desc_info_and_log context an key issue_desc loc fill_issue_desc_info_and_log context an key issue_desc loc
@ -231,7 +231,7 @@ let invoke_set_of_parsed_checkers_an context (an : Ctl_parser_types.ast_node) =
let key = match an with let key = match an with
| Decl dec -> CAst_utils.generate_key_decl dec | Decl dec -> CAst_utils.generate_key_decl dec
| Stmt st -> CAst_utils.generate_key_stmt st in | Stmt st -> CAst_utils.generate_key_stmt st in
IList.iter (fun (condition, issue_desc) -> List.iter ~f:(fun (condition, issue_desc) ->
if CIssue.should_run_check issue_desc.CIssue.mode && if CIssue.should_run_check issue_desc.CIssue.mode &&
CTL.eval_formula condition an context then CTL.eval_formula condition an context then
let loc = CFrontend_checkers.location_from_an context an in let loc = CFrontend_checkers.location_from_an context an in

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

@ -231,21 +231,21 @@ module Debug = struct
(Escape.escape_dotty (smart_string_of_formula root_node.content.phi)) in (Escape.escape_dotty (smart_string_of_formula root_node.content.phi)) in
let edges = let edges =
let buf = Buffer.create 16 in let buf = Buffer.create 16 in
IList.iter List.iter
(fun subtree -> Buffer.add_string buf ((edge (get_root subtree)) ^ "\n")) ~f:(fun subtree -> Buffer.add_string buf ((edge (get_root subtree)) ^ "\n"))
children; children;
buffer_content buf in buffer_content buf in
Printf.sprintf "%d [label=\"%s\" shape=box color=%s]\n%s\n" Printf.sprintf "%d [label=\"%s\" shape=box color=%s]\n%s\n"
root_node.id label color edges in root_node.id label color edges in
let rec traverse buf tree = let rec traverse buf tree =
Buffer.add_string buf (shallow_dotty_of_tree tree); Buffer.add_string buf (shallow_dotty_of_tree tree);
IList.iter (traverse buf) (get_children tree) in List.iter ~f:(traverse buf) (get_children tree) in
let buf = Buffer.create 16 in let buf = Buffer.create 16 in
traverse buf tree; traverse buf tree;
Printf.sprintf "subgraph cluster_%d {\n%s\n}" cluster_id (buffer_content buf) in Printf.sprintf "subgraph cluster_%d {\n%s\n}" cluster_id (buffer_content buf) in
let buf = Buffer.create 16 in let buf = Buffer.create 16 in
IList.iteri List.iteri
(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); (IList.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
@ -255,7 +255,7 @@ end
let print_checker c = let print_checker c =
Logging.out "\n-------------------- \n"; Logging.out "\n-------------------- \n";
Logging.out "\nChecker name: %s\n" c.name; Logging.out "\nChecker name: %s\n" c.name;
IList.iter (fun d -> (match d with List.iter ~f:(fun d -> (match d with
| CSet (clause_name, phi) | CSet (clause_name, phi)
| CLet (clause_name, phi) -> | CLet (clause_name, phi) ->
Logging.out " %s= \n %a\n\n" Logging.out " %s= \n %a\n\n"

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

@ -114,7 +114,7 @@ struct
fname, typ, item_annot in fname, typ, item_annot in
let fields = IList.map mk_field_from_captured_var captured_vars in let fields = IList.map mk_field_from_captured_var captured_vars in
Logging.out_debug "Block %s field:\n" block_name; Logging.out_debug "Block %s field:\n" block_name;
IList.iter (fun (fn, _, _) -> List.iter ~f:(fun (fn, _, _) ->
Logging.out_debug "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; Logging.out_debug "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields;
let mblock = Mangled.from_string block_name in let mblock = Mangled.from_string block_name in
let block_name = Typename.TN_csu (Csu.Class Csu.Objc, mblock) in let block_name = Typename.TN_csu (Csu.Class Csu.Objc, mblock) in
@ -763,8 +763,8 @@ struct
if res_trans_idx.root_nodes <> [] if res_trans_idx.root_nodes <> []
then then
IList.iter List.iter
(fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans_idx.root_nodes []) ~f:(fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans_idx.root_nodes [])
res_trans_a.leaf_nodes; res_trans_a.leaf_nodes;
(* Note the order of res_trans_idx.ids @ res_trans_a.ids is important. *) (* Note the order of res_trans_idx.ids @ res_trans_a.ids is important. *)
@ -1149,8 +1149,8 @@ struct
"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 = IList.partition 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
IList.iter List.iter
(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 [])
prune_nodes' in prune_nodes' in
(match stmt_list with (match stmt_list with
| [cond; exp1; exp2] -> | [cond; exp1; exp2] ->
@ -1231,8 +1231,8 @@ struct
define_condition_side_effects res_trans_cond.exps res_trans_cond.instrs sil_loc in define_condition_side_effects res_trans_cond.exps res_trans_cond.instrs sil_loc in
let prune_t = mk_prune_node true e' instrs' in let prune_t = mk_prune_node true e' instrs' in
let prune_f = mk_prune_node false e' instrs' in let prune_f = mk_prune_node false e' instrs' in
IList.iter List.iter
(fun n' -> Procdesc.node_set_succs_exn context.procdesc n' [prune_t; prune_f] []) ~f:(fun n' -> Procdesc.node_set_succs_exn context.procdesc n' [prune_t; prune_f] [])
res_trans_cond.leaf_nodes; res_trans_cond.leaf_nodes;
let rnodes = if Int.equal (IList.length res_trans_cond.root_nodes) 0 then let rnodes = if Int.equal (IList.length res_trans_cond.root_nodes) 0 then
[prune_t; prune_f] [prune_t; prune_f]
@ -1264,8 +1264,8 @@ struct
| Binop.LAnd -> prune_nodes_t, prune_nodes_f | Binop.LAnd -> prune_nodes_t, prune_nodes_f
| Binop.LOr -> prune_nodes_f, prune_nodes_t | Binop.LOr -> prune_nodes_f, prune_nodes_t
| _ -> assert false) in | _ -> assert false) in
IList.iter List.iter
(fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans_s2.root_nodes []) ~f:(fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans_s2.root_nodes [])
prune_to_s2; prune_to_s2;
let root_nodes_to_parent = let root_nodes_to_parent =
if Int.equal (IList.length res_trans_s1.root_nodes) 0 if Int.equal (IList.length res_trans_s1.root_nodes) 0
@ -1320,8 +1320,8 @@ struct
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 = IList.partition 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
IList.iter List.iter
(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 [])
prune_nodes' in prune_nodes' in
(match stmt_list with (match stmt_list with
| [_; decl_stmt; cond; stmt1; stmt2] -> | [_; decl_stmt; cond; stmt1; stmt2] ->
@ -1357,9 +1357,9 @@ struct
let switch_special_cond_node = let switch_special_cond_node =
let node_kind = Procdesc.Node.Stmt_node "Switch_stmt" in let node_kind = Procdesc.Node.Stmt_node "Switch_stmt" in
create_node node_kind res_trans_cond_tmp.instrs sil_loc context in create_node node_kind res_trans_cond_tmp.instrs sil_loc context in
IList.iter List.iter
(fun n' -> ~f:(fun n' ->
Procdesc.node_set_succs_exn context.procdesc n' [switch_special_cond_node] []) Procdesc.node_set_succs_exn context.procdesc n' [switch_special_cond_node] [])
res_trans_cond_tmp.leaf_nodes; res_trans_cond_tmp.leaf_nodes;
let root_nodes = let root_nodes =
if res_trans_cond_tmp.root_nodes <> [] then res_trans_cond_tmp.root_nodes if res_trans_cond_tmp.root_nodes <> [] then res_trans_cond_tmp.root_nodes
@ -1479,8 +1479,8 @@ struct
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
IList.iter List.iter
(fun n' -> Procdesc.Node.append_instrs n' []) succ_nodes; ~f:(fun n' -> Procdesc.Node.append_instrs n' []) succ_nodes;
(* succ_nodes will remove the temps *) (* succ_nodes will remove the temps *)
{ empty_res_trans with root_nodes = top_nodes; leaf_nodes = succ_nodes } { empty_res_trans with root_nodes = top_nodes; leaf_nodes = succ_nodes }
| _ -> assert false | _ -> assert false
@ -1559,11 +1559,11 @@ struct
| Loops.For _ | Loops.While _ -> res_trans_body.root_nodes | Loops.For _ | Loops.While _ -> res_trans_body.root_nodes
| Loops.DoWhile _ -> [join_node] in | Loops.DoWhile _ -> [join_node] in
Procdesc.node_set_succs_exn context.procdesc join_node join_succ_nodes []; Procdesc.node_set_succs_exn context.procdesc join_node join_succ_nodes [];
IList.iter List.iter
(fun n -> Procdesc.node_set_succs_exn context.procdesc n prune_t_succ_nodes []) ~f:(fun n -> Procdesc.node_set_succs_exn context.procdesc n prune_t_succ_nodes [])
prune_nodes_t; prune_nodes_t;
IList.iter List.iter
(fun n -> Procdesc.node_set_succs_exn context.procdesc n succ_nodes []) ~f:(fun n -> Procdesc.node_set_succs_exn context.procdesc n succ_nodes [])
prune_nodes_f; prune_nodes_f;
let root_nodes = let root_nodes =
match loop_kind with match loop_kind with
@ -1945,8 +1945,8 @@ struct
add_autorelease_call context sil_expr ret_type sil_loc in add_autorelease_call context sil_expr ret_type sil_loc in
let instrs = var_instrs @ res_trans_stmt.instrs @ ret_instrs @ autorelease_instrs in let instrs = var_instrs @ res_trans_stmt.instrs @ ret_instrs @ autorelease_instrs in
let ret_node = mk_ret_node instrs in let ret_node = mk_ret_node instrs in
IList.iter List.iter
(fun n -> Procdesc.node_set_succs_exn procdesc n [ret_node] []) ~f:(fun n -> Procdesc.node_set_succs_exn procdesc n [ret_node] [])
res_trans_stmt.leaf_nodes; res_trans_stmt.leaf_nodes;
let root_nodes_to_parent = let root_nodes_to_parent =
if IList.length res_trans_stmt.root_nodes >0 if IList.length res_trans_stmt.root_nodes >0

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

@ -169,8 +169,8 @@ let collect_res_trans pdesc l =
if rt'.leaf_nodes <> [] then rt'.leaf_nodes if rt'.leaf_nodes <> [] then rt'.leaf_nodes
else rt.leaf_nodes in else rt.leaf_nodes in
if rt'.root_nodes <> [] then if rt'.root_nodes <> [] then
IList.iter List.iter
(fun n -> Procdesc.node_set_succs_exn pdesc n rt'.root_nodes []) ~f:(fun n -> Procdesc.node_set_succs_exn pdesc n rt'.root_nodes [])
rt.leaf_nodes; rt.leaf_nodes;
collect l' collect l'
{ root_nodes = root_nodes; { root_nodes = root_nodes;
@ -246,8 +246,8 @@ struct
let node_kind = Procdesc.Node.Stmt_node (nd_name) in let node_kind = Procdesc.Node.Stmt_node (nd_name) in
let node = Nodes.create_node node_kind res_state.instrs loc trans_state.context in let node = Nodes.create_node node_kind res_state.instrs loc trans_state.context in
Procdesc.node_set_succs_exn trans_state.context.procdesc node trans_state.succ_nodes []; Procdesc.node_set_succs_exn trans_state.context.procdesc node trans_state.succ_nodes [];
IList.iter List.iter
(fun leaf -> Procdesc.node_set_succs_exn trans_state.context.procdesc leaf [node] []) ~f:(fun leaf -> Procdesc.node_set_succs_exn trans_state.context.procdesc leaf [node] [])
res_state.leaf_nodes; res_state.leaf_nodes;
(* Invariant: if root_nodes is empty then the params have not created a node.*) (* Invariant: if root_nodes is empty then the params have not created a node.*)
let root_nodes = (if res_state.root_nodes <> [] then res_state.root_nodes let root_nodes = (if res_state.root_nodes <> [] then res_state.root_nodes

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

@ -104,7 +104,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info d
ocidi.Clang_ast_t.otdi_protocols in ocidi.Clang_ast_t.otdi_protocols in
let decl_methods = ObjcProperty_decl.get_methods curr_class decl_list in let decl_methods = ObjcProperty_decl.get_methods curr_class decl_list in
let fields_sc = CField_decl.fields_superclass tenv ocidi Csu.Objc in let fields_sc = CField_decl.fields_superclass tenv ocidi Csu.Objc in
IList.iter (fun (fn, ft, _) -> List.iter ~f:(fun (fn, ft, _) ->
Logging.out_debug "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn); Logging.out_debug "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn);
Logging.out_debug "type: '%s'\n" (Typ.to_string ft)) fields_sc; Logging.out_debug "type: '%s'\n" (Typ.to_string ft)) fields_sc;
(*In case we found categories, or partial definition of this class earlier and they are already in the tenv *) (*In case we found categories, or partial definition of this class earlier and they are already in the tenv *)
@ -121,7 +121,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info d
let modelled_fields = StructTyp.objc_ref_counter_field :: CField_decl.modelled_field name_info in let modelled_fields = StructTyp.objc_ref_counter_field :: CField_decl.modelled_field name_info in
let all_fields = CGeneral_utils.append_no_duplicates_fields modelled_fields fields in let all_fields = CGeneral_utils.append_no_duplicates_fields modelled_fields fields in
Logging.out_debug "Class %s field:\n" class_name; Logging.out_debug "Class %s field:\n" class_name;
IList.iter (fun (fn, _, _) -> List.iter ~f:(fun (fn, _, _) ->
Logging.out_debug "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) all_fields; Logging.out_debug "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) all_fields;
ignore( ignore(
Tenv.mk_struct tenv Tenv.mk_struct tenv

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

@ -47,7 +47,7 @@ let get proc_attributes : t =
let param_is_nullable pvar ann_sig = let param_is_nullable pvar ann_sig =
List.exists List.exists
~f:(fun (param, annot, _) -> ~f:(fun (param, annot, _) ->
Mangled.equal param (Pvar.get_name pvar) && Annotations.ia_is_nullable annot) Mangled.equal param (Pvar.get_name pvar) && Annotations.ia_is_nullable annot)
ann_sig.params ann_sig.params
let pp proc_name fmt annotated_signature = let pp proc_name fmt annotated_signature =
@ -86,7 +86,7 @@ let is_anonymous_inner_class_wrapper ann_sig proc_name =
PatternMatch.type_is_object t in PatternMatch.type_is_object t in
Procname.java_is_anonymous_inner_class proc_name Procname.java_is_anonymous_inner_class proc_name
&& check_ret ann_sig.ret && check_ret ann_sig.ret
&& IList.for_all check_param ann_sig.params && List.for_all ~f:check_param ann_sig.params
&& !x_param_found && !x_param_found
let mk_ann_str s = { Annot.class_name = s; parameters = [] } let mk_ann_str s = { Annot.class_name = s; parameters = [] }

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

@ -95,8 +95,8 @@ struct
State.set_node exit_node; State.set_node exit_node;
if checks.TypeCheck.check_ret_type <> [] then if checks.TypeCheck.check_ret_type <> [] then
IList.iter List.iter
(fun f -> f curr_pname curr_pdesc ret_type typ_found_opt loc) ~f:(fun f -> f curr_pname curr_pdesc ret_type typ_found_opt loc)
checks.TypeCheck.check_ret_type; checks.TypeCheck.check_ret_type;
if checks.TypeCheck.eradicate then if checks.TypeCheck.eradicate then
EradicateChecks.check_return_annotation tenv EradicateChecks.check_return_annotation tenv
@ -132,7 +132,7 @@ struct
L.d_strln "before:"; L.d_strln "before:";
d_typestate typestate; d_typestate typestate;
L.d_strln "after:"; L.d_strln "after:";
IList.iter d_typestate typestates_succ List.iter ~f:d_typestate typestates_succ
end; end;
NodePrinter.finish_session node; NodePrinter.finish_session node;
@ -217,8 +217,8 @@ struct
| Some callee_pd -> | Some callee_pd ->
res := (callee_pn, callee_pd) :: !res res := (callee_pn, callee_pd) :: !res
| None -> () in | None -> () in
IList.iter do_called private_called in List.iter ~f:do_called private_called in
IList.iter do_proc initializers; List.iter ~f:do_proc initializers;
!res in !res in
(* Get the initializers recursively called by computing a fixpoint. (* Get the initializers recursively called by computing a fixpoint.
@ -229,7 +229,7 @@ struct
let res = ref [] in let res = ref [] in
let seen = ref Procname.Set.empty in let seen = ref Procname.Set.empty in
let mark_seen (initializers : init list) : unit = let mark_seen (initializers : init list) : unit =
IList.iter (fun (pn, _) -> seen := Procname.Set.add pn !seen) initializers; List.iter ~f:(fun (pn, _) -> seen := Procname.Set.add pn !seen) initializers;
res := !res @ initializers in res := !res @ initializers in
let rec fixpoint initializers_old = let rec fixpoint initializers_old =
@ -250,7 +250,7 @@ struct
| _, Some final_typestate -> | _, Some final_typestate ->
final_typestates := (pname, final_typestate) :: !final_typestates final_typestates := (pname, final_typestate) :: !final_typestates
| _, None -> () in | _, None -> () in
IList.iter get_final_typestate initializers_recursive; List.iter ~f:get_final_typestate initializers_recursive;
IList.rev !final_typestates IList.rev !final_typestates
let pname_and_pdescs_with f = let pname_and_pdescs_with f =
@ -264,7 +264,7 @@ struct
| Some pdesc -> | Some pdesc ->
res := (pname, pdesc) :: !res res := (pname, pdesc) :: !res
| None -> () in | None -> () in
IList.iter do_proc (get_procs_in_file curr_pname); List.iter ~f:do_proc (get_procs_in_file curr_pname);
IList.rev !res IList.rev !res
let get_class pn = match pn with let get_class pn = match pn with

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

@ -128,7 +128,7 @@ let check_condition tenv case_zero find_canonical_duplicate curr_pdesc
| _ -> () in | _ -> () in
let do_node n = let do_node n =
if Location.equal loc (Procdesc.Node.get_loc n) if Location.equal loc (Procdesc.Node.get_loc n)
then IList.iter do_instr (Procdesc.Node.get_instrs n) in then List.iter ~f:do_instr (Procdesc.Node.get_instrs n) in
Procdesc.iter_nodes do_node pdesc; Procdesc.iter_nodes do_node pdesc;
!throwable_found in !throwable_found in
@ -320,7 +320,7 @@ let check_constructor_initialization tenv
curr_pdesc; curr_pdesc;
) in ) in
IList.iter do_field fields List.iter ~f:do_field fields
| None -> | None ->
() ()
) )

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

@ -232,7 +232,7 @@ type model_table_t = (string, bool * bool list) Hashtbl.t
let mk_table list = let mk_table list =
let map = Hashtbl.create 1 in let map = Hashtbl.create 1 in
IList.iter (function (v, pn_id) -> Hashtbl.replace map pn_id v) list; List.iter ~f:(function (v, pn_id) -> Hashtbl.replace map pn_id v) list;
map map
let this_file = __FILE__ let this_file = __FILE__

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

@ -705,7 +705,7 @@ let typecheck_instr
| _ -> () | _ -> ()
end end
| _ -> () in | _ -> () in
IList.iter do_instr (Procdesc.Node.get_instrs cond_node) in List.iter ~f:do_instr (Procdesc.Node.get_instrs cond_node) in
let handle_optional_isPresent node' e = let handle_optional_isPresent node' e =
match convert_complex_exp_to_pvar node' false e typestate' loc with match convert_complex_exp_to_pvar node' false e typestate' loc with
| Exp.Lvar pvar', _ -> | Exp.Lvar pvar', _ ->
@ -721,8 +721,8 @@ let typecheck_instr
(* In foo(cond1 && cond2), the node that sets the result to false (* In foo(cond1 && cond2), the node that sets the result to false
has all the negated conditions as parents. *) has all the negated conditions as parents. *)
| Some boolean_assignment_node -> | Some boolean_assignment_node ->
IList.iter List.iter
handle_negated_condition ~f:handle_negated_condition
(Procdesc.Node.get_preds boolean_assignment_node); (Procdesc.Node.get_preds boolean_assignment_node);
!res_typestate !res_typestate
| None -> | None ->
@ -1031,7 +1031,7 @@ let typecheck_instr
when Exp.equal (Exp.Lvar pvar) (Idenv.expand_expr idenv e') -> when Exp.equal (Exp.Lvar pvar) (Idenv.expand_expr idenv e') ->
found := Some e found := Some e
| _ -> () in | _ -> () in
IList.iter do_instr (Procdesc.Node.get_instrs prev_node); List.iter ~f:do_instr (Procdesc.Node.get_instrs prev_node);
!found !found
| _ -> None in | _ -> None in

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

@ -36,7 +36,7 @@ let try_create_lifecycle_trace name lifecycle_name lifecycle_procs tenv =
(** generate a harness for a lifecycle type in an Android application *) (** generate a harness for a lifecycle type in an Android application *)
let create_harness cfg cg tenv = let create_harness cfg cg tenv =
IList.iter (fun (pkg, clazz, lifecycle_methods) -> List.iter ~f:(fun (pkg, clazz, lifecycle_methods) ->
let typname = Typename.TN_csu (Class Java, Mangled.from_package_class pkg clazz) in let typname = Typename.TN_csu (Class Java, Mangled.from_package_class pkg clazz) in
let framework_procs = let framework_procs =
AndroidFramework.get_lifecycle_for_framework_typ_opt tenv typname lifecycle_methods in AndroidFramework.get_lifecycle_for_framework_typ_opt tenv typname lifecycle_methods in

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

@ -103,7 +103,7 @@ let rec inhabit_typ tenv typ cfg env =
let try_get_non_receiver_formals p = let try_get_non_receiver_formals p =
get_non_receiver_formals (formals_from_name cfg p) in get_non_receiver_formals (formals_from_name cfg p) in
Procname.is_constructor p Procname.is_constructor p
&& IList.for_all (fun (_, typ) -> && List.for_all ~f:(fun (_, typ) ->
not (TypSet.mem typ env.cur_inhabiting) not (TypSet.mem typ env.cur_inhabiting)
) (try_get_non_receiver_formals p) in ) (try_get_non_receiver_formals p) in
List.filter ~f:(fun p -> is_suitable_constructor p) methods List.filter ~f:(fun p -> is_suitable_constructor p) methods
@ -214,7 +214,7 @@ let create_dummy_harness_filename harness_name =
(* TODO (t3040429): fill this file up with Java-like code that matches the SIL *) (* TODO (t3040429): fill this file up with Java-like code that matches the SIL *)
let write_harness_to_file harness_instrs harness_file_name = let write_harness_to_file harness_instrs harness_file_name =
let harness_file = Utils.create_outfile harness_file_name in let harness_file = Utils.create_outfile harness_file_name in
let pp_harness fmt = IList.iter (fun instr -> let pp_harness fmt = List.iter ~f:(fun instr ->
Format.fprintf fmt "%a\n" (Sil.pp_instr Pp.text) instr) harness_instrs in Format.fprintf fmt "%a\n" (Sil.pp_instr Pp.text) instr) harness_instrs in
Utils.do_outf harness_file (fun outf -> Utils.do_outf harness_file (fun outf ->
pp_harness outf.fmt; pp_harness outf.fmt;
@ -223,8 +223,8 @@ let write_harness_to_file harness_instrs harness_file_name =
(** add the harness proc to the cg and make sure its callees can be looked up by sym execution *) (** add the harness proc to the cg and make sure its callees can be looked up by sym execution *)
let add_harness_to_cg harness_name harness_node cg = let add_harness_to_cg harness_name harness_node cg =
Cg.add_defined_node cg (Procname.Java harness_name); Cg.add_defined_node cg (Procname.Java harness_name);
IList.iter List.iter
(fun p -> Cg.add_edge cg (Procname.Java harness_name) p) ~f:(fun p -> Cg.add_edge cg (Procname.Java harness_name) p)
(Procdesc.Node.get_callees harness_node) (Procdesc.Node.get_callees harness_node)
(** create and fill the appropriate nodes and add them to the harness cfg. also add the harness (** create and fill the appropriate nodes and add them to the harness cfg. also add the harness

4
infer/src/integration/CompilationDatabase.ml
Unescape View File

@ -63,7 +63,7 @@ let decode_json_file (database : t) json_format =
let rec parse_json json = let rec parse_json json =
match json with match json with
| `List arguments -> | `List arguments ->
IList.iter parse_json arguments List.iter ~f:parse_json arguments
| `Assoc l -> | `Assoc l ->
let dir = match List.find_map ~f:get_dir l with let dir = match List.find_map ~f:get_dir l with
| Some dir -> dir | Some dir -> dir
@ -84,6 +84,6 @@ let decode_json_file (database : t) json_format =
let from_json_files db_json_files = let from_json_files db_json_files =
let db = empty () in let db = empty () in
IList.iter (decode_json_file db) db_json_files; List.iter ~f:(decode_json_file db) db_json_files;
Logging.out "created database with %d entries@\n" (get_size db); Logging.out "created database with %d entries@\n" (get_size db);
db db

4
infer/src/java/jMain.ml
Unescape View File

@ -128,8 +128,8 @@ let do_all_files classpath sources classes =
| JClasspath.Singleton source_file -> | JClasspath.Singleton source_file ->
translate_source_file basename (None, source_file) source_file translate_source_file basename (None, source_file) source_file
| JClasspath.Duplicate source_files -> | JClasspath.Duplicate source_files ->
IList.iter List.iter
(fun (package, source_file) -> ~f:(fun (package, source_file) ->
translate_source_file basename (Some package, source_file) source_file) translate_source_file basename (Some package, source_file) source_file)
source_files) source_files)
sources; sources;

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

@ -24,7 +24,7 @@ let create_handler_table impl =
Hashtbl.replace handler_tb pc (exn_handler:: handlers) Hashtbl.replace handler_tb pc (exn_handler:: handlers)
with Not_found -> with Not_found ->
Hashtbl.add handler_tb pc [exn_handler] in Hashtbl.add handler_tb pc [exn_handler] in
IList.iter collect (JBir.exception_edges impl); List.iter ~f:collect (JBir.exception_edges impl);
handler_tb handler_tb
let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handler_table = let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handler_table =

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

@ -311,7 +311,7 @@ and get_class_struct_typ program tenv cn =
Tenv.mk_struct tenv name Tenv.mk_struct tenv name
| Some node -> | Some node ->
let create_super_list interface_names = let create_super_list interface_names =
IList.iter (fun cn -> ignore (get_class_struct_typ program tenv cn)) interface_names; List.iter ~f:(fun cn -> ignore (get_class_struct_typ program tenv cn)) interface_names;
IList.map typename_of_classname interface_names in IList.map typename_of_classname interface_names in
let supers, fields, statics, annots = let supers, fields, statics, annots =
match node with match node with

2
infer/src/quandary/TaintAnalysis.ml
Unescape View File

@ -184,7 +184,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct
let exn = Exceptions.Checkers (msg, Localise.verbatim_desc trace_str) in let exn = Exceptions.Checkers (msg, Localise.verbatim_desc trace_str) in
Reporting.log_error caller_pname ~loc:(CallSite.loc cur_site) ~ltr exn in Reporting.log_error caller_pname ~loc:(CallSite.loc cur_site) ~ltr exn in
IList.iter report_error (TraceDomain.get_reportable_paths ~cur_site trace ~trace_of_pname) List.iter ~f:report_error (TraceDomain.get_reportable_paths ~cur_site trace ~trace_of_pname)
let add_sinks sinks actuals ({ Domain.access_tree; id_map; } as astate) proc_data callee_site = let add_sinks sinks actuals ({ Domain.access_tree; id_map; } as astate) proc_data callee_site =
let f_resolve_id = resolve_id id_map in let f_resolve_id = resolve_id id_map in

Write Preview
Loading…
Cancel
Save