More IList deprecation: fold functions

Reviewed By: jberdine

Differential Revision: D4588244

fbshipit-source-id: 5df1d9b
master
Cristiano Calcagno 8 years ago committed by Facebook Github Bot
parent a79096efa8
commit 731dead406

@ -51,9 +51,9 @@ let iter_all_nodes sorted::sorted=false f cfg => {
Procname.Hash.fold Procname.Hash.fold
( (
fun _ pdesc desc_nodes => fun _ pdesc desc_nodes =>
IList.fold_left List.fold
(fun desc_nodes node => [(pdesc, node), ...desc_nodes]) f::(fun desc_nodes node => [(pdesc, node), ...desc_nodes])
desc_nodes init::desc_nodes
(Procdesc.get_nodes pdesc) (Procdesc.get_nodes pdesc)
) )
cfg.proc_desc_table cfg.proc_desc_table
@ -434,7 +434,7 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => {
let rec convert_node node => { let rec convert_node node => {
let loc = Procdesc.Node.get_loc node let loc = Procdesc.Node.get_loc node
and kind = convert_node_kind (Procdesc.Node.get_kind node) and kind = convert_node_kind (Procdesc.Node.get_kind node)
and instrs = IList.fold_left convert_instr [] (Procdesc.Node.get_instrs node) |> IList.rev; and instrs = List.fold f::convert_instr init::[] (Procdesc.Node.get_instrs node) |> IList.rev;
Procdesc.create_node resolved_pdesc loc kind instrs Procdesc.create_node resolved_pdesc loc kind instrs
} }
and loop callee_nodes => and loop callee_nodes =>
@ -471,8 +471,8 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => {
let specialize_types callee_pdesc resolved_pname args => { let specialize_types callee_pdesc resolved_pname args => {
let callee_attributes = Procdesc.get_attributes callee_pdesc; let callee_attributes = Procdesc.get_attributes callee_pdesc;
let (resolved_params, substitutions) = let (resolved_params, substitutions) =
IList.fold_left2 List.fold2_exn
( f::(
fun (params, subts) (param_name, param_typ) (_, arg_typ) => fun (params, subts) (param_name, param_typ) (_, arg_typ) =>
switch arg_typ { switch arg_typ {
| Typ.Tptr (Tstruct typename) Pk_pointer => | Typ.Tptr (Tstruct typename) Pk_pointer =>
@ -481,7 +481,7 @@ let specialize_types callee_pdesc resolved_pname args => {
| _ => ([(param_name, param_typ), ...params], subts) | _ => ([(param_name, param_typ), ...params], subts)
} }
) )
([], Mangled.Map.empty) init::([], Mangled.Map.empty)
callee_attributes.formals callee_attributes.formals
args; args;
let resolved_attributes = { let resolved_attributes = {

@ -192,8 +192,10 @@ let get_vars exp => {
| BinOp _ e1 e2 | BinOp _ e1 e2
| Lindex e1 e2 => get_vars_ e1 vars |> get_vars_ e2 | Lindex e1 e2 => get_vars_ e1 vars |> get_vars_ e2
| Closure {captured_vars} => | Closure {captured_vars} =>
IList.fold_left List.fold
(fun vars_acc (captured_exp, _, _) => get_vars_ captured_exp vars_acc) vars captured_vars f::(fun vars_acc (captured_exp, _, _) => get_vars_ captured_exp vars_acc)
init::vars
captured_vars
| Const (Cint _ | Cfun _ | Cstr _ | Cfloat _ | Cclass _ | Cptr_to_fld _) => vars | Const (Cint _ | Cfun _ | Cstr _ | Cfloat _ | Cclass _ | Cptr_to_fld _) => vars
/* TODO: Sizeof length expressions may contain variables, do not ignore them. */ /* TODO: Sizeof length expressions may contain variables, do not ignore them. */
/* | Sizeof _ None _ => vars */ /* | Sizeof _ None _ => vars */

@ -104,7 +104,8 @@ let module FieldMap = Caml.Map.Make {
type t = fieldname [@@deriving compare]; type t = fieldname [@@deriving compare];
}; };
let idlist_to_idset ids => IList.fold_left (fun set id => IdentSet.add id set) IdentSet.empty ids; let idlist_to_idset ids =>
List.fold f::(fun set id => IdentSet.add id set) init::IdentSet.empty ids;
/** {2 Conversion between Names and Strings} */ /** {2 Conversion between Names and Strings} */

@ -425,7 +425,7 @@ let desc_context_leak pname context_typ fieldname leak_path : error_desc =
let path_str = let path_str =
let path_prefix = let path_prefix =
if List.is_empty leak_path then "Leaked " if List.is_empty leak_path then "Leaked "
else (IList.fold_left leak_path_entry_to_str "" leak_path) ^ " Leaked " in else (List.fold ~f:leak_path_entry_to_str ~init:"" leak_path) ^ " Leaked " in
path_prefix ^ context_str in path_prefix ^ context_str in
let preamble = let preamble =
let pname_str = match pname with let pname_str = match pname with

@ -92,7 +92,7 @@ let module Node = {
acc (slice_nodes (List.filter f::(fun s => not (NodeSet.mem s !visited)) n.succs)) acc (slice_nodes (List.filter f::(fun s => not (NodeSet.mem s !visited)) n.succs))
} }
}; };
IList.fold_left do_node NodeSet.empty nodes List.fold f::do_node init::NodeSet.empty nodes
}; };
NodeSet.elements (slice_nodes node.succs) NodeSet.elements (slice_nodes node.succs)
}; };
@ -108,7 +108,7 @@ let module Node = {
acc (slice_nodes (List.filter f::(fun s => not (NodeSet.mem s !visited)) n.preds)) acc (slice_nodes (List.filter f::(fun s => not (NodeSet.mem s !visited)) n.preds))
} }
}; };
IList.fold_left do_node NodeSet.empty nodes List.fold f::do_node init::NodeSet.empty nodes
}; };
NodeSet.elements (slice_nodes node.preds) NodeSet.elements (slice_nodes node.preds)
}; };
@ -158,7 +158,7 @@ let module Node = {
} }
| _ => callees | _ => callees
}; };
IList.fold_left collect [] (get_instrs node) List.fold f::collect init::[] (get_instrs node)
}; };
/** Get the location of the node */ /** Get the location of the node */
@ -399,9 +399,11 @@ let iter_nodes f pdesc => IList.iter 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 =>
IList.fold_left List.fold
(fun b callee_pname => f b (callee_pname, Node.get_loc node)) a (Node.get_callees node); f::(fun b callee_pname => f b (callee_pname, Node.get_loc node))
IList.fold_left do_node acc (get_nodes pdesc) init::a
(Node.get_callees node);
List.fold f::do_node init::acc (get_nodes pdesc)
}; };
@ -413,11 +415,11 @@ let iter_instrs f pdesc => {
iter_nodes do_node pdesc iter_nodes do_node pdesc
}; };
let fold_nodes f acc pdesc => IList.fold_left f acc (IList.rev (get_nodes pdesc)); let fold_nodes f acc pdesc => List.fold f::f init::acc (IList.rev (get_nodes pdesc));
let fold_instrs f acc pdesc => { let fold_instrs f acc pdesc => {
let fold_node acc node => let fold_node acc node =>
IList.fold_left (fun acc instr => f acc node instr) acc (Node.get_instrs node); List.fold f::(fun acc instr => f acc node instr) init::acc (Node.get_instrs node);
fold_nodes fold_node acc pdesc fold_nodes fold_node acc pdesc
}; };

@ -269,7 +269,7 @@ let is_static_local_name pname pvar => {
/** {2 Sets of expressions} */ /** {2 Sets of expressions} */
let elist_to_eset es => IList.fold_left (fun set e => Exp.Set.add e set) Exp.Set.empty es; let elist_to_eset es => List.fold f::(fun set e => Exp.Set.add e set) init::Exp.Set.empty es;
/** {2 Sets of heap predicates} */ /** {2 Sets of heap predicates} */
@ -1223,7 +1223,7 @@ let hpred_get_lexp acc =>
| Hdllseg _ _ e1 _ _ e2 _ => [e1, e2, ...acc]; | Hdllseg _ _ e1 _ _ e2 _ => [e1, e2, ...acc];
let hpred_list_get_lexps (filter: Exp.t => bool) (hlist: list hpred) :list Exp.t => { let hpred_list_get_lexps (filter: Exp.t => bool) (hlist: list hpred) :list Exp.t => {
let lexps = IList.fold_left hpred_get_lexp [] hlist; let lexps = List.fold f::hpred_get_lexp init::[] hlist;
List.filter f::filter lexps List.filter f::filter lexps
}; };
@ -1254,7 +1254,7 @@ let atom_fpv =
| Aeq e1 e2 => exp_fpv e1 @ exp_fpv e2 | Aeq e1 e2 => exp_fpv e1 @ exp_fpv e2
| Aneq e1 e2 => exp_fpv e1 @ exp_fpv e2 | Aneq e1 e2 => exp_fpv e1 @ exp_fpv e2
| Apred _ es | Apred _ es
| Anpred _ es => IList.fold_left (fun fpv e => IList.rev_append (exp_fpv e) fpv) [] es; | Anpred _ es => List.fold f::(fun fpv e => IList.rev_append (exp_fpv e) fpv) init::[] es;
let rec strexp_fpv = let rec strexp_fpv =
fun fun
@ -2099,8 +2099,8 @@ let compare_structural_instr instr1 instr2 exp_map => {
if (n != 0) { if (n != 0) {
(n, exp_map) (n, exp_map)
} else { } else {
IList.fold_left2 List.fold2_exn
( f::(
fun (n, exp_map) id1 id2 => fun (n, exp_map) id1 id2 =>
if (n != 0) { if (n != 0) {
(n, exp_map) (n, exp_map)
@ -2108,7 +2108,7 @@ let compare_structural_instr instr1 instr2 exp_map => {
exp_compare_structural (Var id1) (Var id2) exp_map exp_compare_structural (Var id1) (Var id2) exp_map
} }
) )
(0, exp_map) init::(0, exp_map)
ids1 ids1
ids2 ids2
} }
@ -2162,8 +2162,8 @@ let compare_structural_instr instr1 instr2 exp_map => {
if (n != 0) { if (n != 0) {
(n, exp_map) (n, exp_map)
} else { } else {
IList.fold_left2 List.fold2_exn
( f::(
fun (n, exp_map) arg1 arg2 => fun (n, exp_map) arg1 arg2 =>
if (n != 0) { if (n != 0) {
(n, exp_map) (n, exp_map)
@ -2171,7 +2171,7 @@ let compare_structural_instr instr1 instr2 exp_map => {
exp_typ_compare_structural arg1 arg2 exp_map exp_typ_compare_structural arg1 arg2 exp_map
} }
) )
(0, exp_map) init::(0, exp_map)
args1 args1
args2 args2
} }
@ -2204,8 +2204,8 @@ let compare_structural_instr instr1 instr2 exp_map => {
if (n != 0) { if (n != 0) {
(n, exp_map) (n, exp_map)
} else { } else {
IList.fold_left2 List.fold2_exn
( f::(
fun (n, exp_map) (pv1, t1) (pv2, t2) => fun (n, exp_map) (pv1, t1) (pv2, t2) =>
if (n != 0) { if (n != 0) {
(n, exp_map) (n, exp_map)
@ -2218,7 +2218,7 @@ let compare_structural_instr instr1 instr2 exp_map => {
} }
} }
) )
(0, exp_map) init::(0, exp_map)
ptl1 ptl1
ptl2 ptl2
} }
@ -2386,7 +2386,7 @@ let sigma_to_sigma_ne sigma :list (list atom, list hpred) =>
]; ];
List.concat (IList.map g eqs_sigma_list) List.concat (IList.map g eqs_sigma_list)
}; };
IList.fold_left f [([], [])] sigma List.fold f::f init::[([], [])] sigma
} else { } else {
[([], sigma)] [([], sigma)]
}; };

@ -238,7 +238,7 @@ let check_redundancies tenv c l => {
}; };
(l, add && should_add) (l, add && should_add)
}; };
IList.fold_left aux ([], true) l List.fold f::aux init::([], true) l
}; };
let rec updates_head f c l => let rec updates_head f c l =>

@ -116,7 +116,7 @@ CHECKCOPYRIGHT_MAIN = $(SCRIPT_SOURCES)/checkCopyright
#### End of declarations #### #### End of declarations ####
ifeq ($(IS_FACEBOOK_TREE),yes) ifeq ($(IS_FACEBOOK_TREE),yes)
EXTRA_DEPS = facebook facebook/scripts EXTRA_DEPS = facebook
else else
EXTRA_DEPS = opensource EXTRA_DEPS = opensource
endif endif
@ -258,7 +258,7 @@ rei:
roots:=Infer InferAnalyzeExe InferClang InferPrintExe StatsAggregator roots:=Infer InferAnalyzeExe InferClang InferPrintExe StatsAggregator
clusters:=base clang java IR clusters:=base clang java IR
ml_src_files:=$(shell find $(DEPENDENCIES) -regex '.*\.ml\(i\)*' -not -path facebook/scripts/eradicate_stats.ml) ml_src_files:=$(shell find $(DEPENDENCIES) -regex '.*\.ml\(i\)*')
re_src_files:=$(shell find $(DEPENDENCIES) -regex '.*\.re\(i\)*') re_src_files:=$(shell find $(DEPENDENCIES) -regex '.*\.re\(i\)*')
inc_flags:=$(foreach dir,$(DEPENDENCIES),-I $(dir)) inc_flags:=$(foreach dir,$(DEPENDENCIES),-I $(dir))
root_flags:=$(foreach root,$(roots),-r $(root)) root_flags:=$(foreach root,$(roots),-r $(root))
@ -297,7 +297,7 @@ toplevel.mlpack: base/Version.ml $(OCAML_CONFIG_SOURCES) $(MAKEFILE_LIST)
$(foreach module,\ $(foreach module,\
$(filter-out $(foreach root,$(roots),%/$(root)),\ $(filter-out $(foreach root,$(roots),%/$(root)),\
$(foreach source,\ $(foreach source,\
$(filter-out unit/% facebook/scripts/eradicate_stats.ml,$(OCAML_CONFIG_SOURCES)),\ $(filter-out unit/%,$(OCAML_CONFIG_SOURCES)),\
$(call to_ocaml_module,$(source)))),\ $(call to_ocaml_module,$(source)))),\
$(shell echo $(module) >> $($@_tmp))) $(shell echo $(module) >> $($@_tmp)))
mv $($@_tmp) $@ mv $($@_tmp) $@

@ -82,7 +82,7 @@ let get_for_exp tenv (prop: 'a Prop.t) exp =
| Sil.Apred (_, es) | Anpred (_, es) | Sil.Apred (_, es) | Anpred (_, es)
when List.mem ~equal:Exp.equal es nexp -> atom :: attributes when List.mem ~equal:Exp.equal es nexp -> atom :: attributes
| _ -> attributes in | _ -> attributes in
IList.fold_left atom_get_attr [] prop.pi List.fold ~f:atom_get_attr ~init:[] prop.pi
let get tenv prop exp category = let get tenv prop exp category =
let atts = get_for_exp tenv prop exp in let atts = get_for_exp tenv prop exp in
@ -204,7 +204,7 @@ let mark_vars_as_undefined tenv prop vars_to_mark callee_pname ret_annots loc pa
match exp with match exp with
| Exp.Var _ | Lvar _ -> add_or_replace tenv prop (Apred (att_undef, [exp])) | Exp.Var _ | Lvar _ -> add_or_replace tenv prop (Apred (att_undef, [exp]))
| _ -> prop in | _ -> prop in
IList.fold_left (fun prop id -> mark_var_as_undefined id prop) prop vars_to_mark List.fold ~f:(fun prop id -> mark_var_as_undefined id prop) ~init:prop vars_to_mark
(** type for arithmetic problems *) (** type for arithmetic problems *)
type arith_problem = type arith_problem =
@ -291,14 +291,14 @@ let deallocate_stack_vars tenv (p: 'a Prop.t) pvars =
end in end in
IList.iter do_var !fresh_address_vars; IList.iter do_var !fresh_address_vars;
!res in !res in
!stack_vars_address_in_post, IList.fold_left (Prop.prop_atom_and tenv) p'' pi !stack_vars_address_in_post, List.fold ~f:(Prop.prop_atom_and tenv) ~init:p'' pi
(** Input of this method is an exp in a prop. Output is a formal variable or path from a (** Input of this method is an exp in a prop. Output is a formal variable or path from a
formal variable that is equal to the expression, formal variable that is equal to the expression,
or the OBJC_NULL attribute of the expression. *) or the OBJC_NULL attribute of the expression. *)
let find_equal_formal_path tenv e prop = let find_equal_formal_path tenv e prop =
let rec find_in_sigma e seen_hpreds = let rec find_in_sigma e seen_hpreds =
IList.fold_right ( List.fold_right ~f:(
fun hpred res -> fun hpred res ->
if List.mem ~equal:Sil.equal_hpred seen_hpreds hpred then None if List.mem ~equal:Sil.equal_hpred seen_hpreds hpred then None
else else
@ -312,7 +312,7 @@ let find_equal_formal_path tenv e prop =
(Pvar.is_local pvar1 || Pvar.is_seed pvar1) -> (Pvar.is_local pvar1 || Pvar.is_seed pvar1) ->
Some (Exp.Lvar pvar1) Some (Exp.Lvar pvar1)
| Sil.Hpointsto (exp1, Sil.Estruct (fields, _), _) -> | Sil.Hpointsto (exp1, Sil.Estruct (fields, _), _) ->
IList.fold_right (fun (field, strexp) res -> List.fold_right ~f:(fun (field, strexp) res ->
match res with match res with
| Some _ -> res | Some _ -> res
| None -> | None ->
@ -321,8 +321,8 @@ let find_equal_formal_path tenv e prop =
(match find_in_sigma exp1 seen_hpreds with (match find_in_sigma exp1 seen_hpreds with
| Some vfs -> Some (Exp.Lfield (vfs, field, Typ.Tvoid)) | Some vfs -> Some (Exp.Lfield (vfs, field, Typ.Tvoid))
| None -> None) | None -> None)
| _ -> None) fields None | _ -> None) fields ~init:None
| _ -> None) prop.Prop.sigma None in | _ -> None) prop.Prop.sigma ~init:None in
match find_in_sigma e [] with match find_in_sigma e [] with
| Some vfs -> Some vfs | Some vfs -> Some vfs
| None -> | None ->

@ -565,7 +565,7 @@ let execute___release_autorelease_pool
) )
~default:res ~default:res
| _ -> res in | _ -> res in
IList.fold_left call_release [(prop_without_attribute, path)] autoreleased_objects List.fold ~f:call_release ~init:[(prop_without_attribute, path)] autoreleased_objects
else execute___no_op prop_ path else execute___no_op prop_ path
let set_attr tenv pdesc prop path exp attr = let set_attr tenv pdesc prop path exp attr =
@ -703,7 +703,7 @@ let _execute_free_nonzero mk pdesc tenv instr prop lexp typ loc =
assert false assert false
| Some _ -> | Some _ ->
let prop_list = let prop_list =
IList.fold_left (_execute_free tenv mk loc) [] List.fold ~f:(_execute_free tenv mk loc) ~init:[]
(Rearrange.rearrange pdesc tenv lexp typ prop loc) in (Rearrange.rearrange pdesc tenv lexp typ prop loc) in
IList.rev prop_list IList.rev prop_list
end end

@ -53,9 +53,9 @@ let remove_abduced_retvars tenv p => {
| Sil.Eexp (Exp.Exn e) _ => Exp.Set.add e exps | Sil.Eexp (Exp.Exn e) _ => Exp.Set.add e exps
| Sil.Eexp e _ => Exp.Set.add e exps | Sil.Eexp e _ => Exp.Set.add e exps
| Sil.Estruct flds _ => | Sil.Estruct flds _ =>
IList.fold_left (fun exps (_, strexp) => collect_exps exps strexp) exps flds List.fold f::(fun exps (_, strexp) => collect_exps exps strexp) init::exps flds
| Sil.Earray _ elems _ => | Sil.Earray _ elems _ =>
IList.fold_left (fun exps (_, strexp) => collect_exps exps strexp) exps elems; List.fold f::(fun exps (_, strexp) => collect_exps exps strexp) init::exps elems;
let rec compute_reachable_hpreds_rec sigma (reach, exps) => { let rec compute_reachable_hpreds_rec sigma (reach, exps) => {
let add_hpred_if_reachable (reach, exps) => let add_hpred_if_reachable (reach, exps) =>
fun fun
@ -67,21 +67,23 @@ let remove_abduced_retvars tenv p => {
| Sil.Hlseg _ _ exp1 exp2 exp_l as hpred => { | Sil.Hlseg _ _ exp1 exp2 exp_l as hpred => {
let reach' = Sil.HpredSet.add hpred reach; let reach' = Sil.HpredSet.add hpred reach;
let exps' = let exps' =
IList.fold_left List.fold
(fun exps_acc exp => Exp.Set.add exp exps_acc) exps [exp1, exp2, ...exp_l]; f::(fun exps_acc exp => Exp.Set.add exp exps_acc)
init::exps
[exp1, exp2, ...exp_l];
(reach', exps') (reach', exps')
} }
| Sil.Hdllseg _ _ exp1 exp2 exp3 exp4 exp_l as hpred => { | Sil.Hdllseg _ _ exp1 exp2 exp3 exp4 exp_l as hpred => {
let reach' = Sil.HpredSet.add hpred reach; let reach' = Sil.HpredSet.add hpred reach;
let exps' = let exps' =
IList.fold_left List.fold
(fun exps_acc exp => Exp.Set.add exp exps_acc) f::(fun exps_acc exp => Exp.Set.add exp exps_acc)
exps init::exps
[exp1, exp2, exp3, exp4, ...exp_l]; [exp1, exp2, exp3, exp4, ...exp_l];
(reach', exps') (reach', exps')
} }
| _ => (reach, exps); | _ => (reach, exps);
let (reach', exps') = IList.fold_left add_hpred_if_reachable (reach, exps) sigma; let (reach', exps') = List.fold f::add_hpred_if_reachable init::(reach, exps) sigma;
if (Int.equal (Sil.HpredSet.cardinal reach) (Sil.HpredSet.cardinal reach')) { if (Int.equal (Sil.HpredSet.cardinal reach) (Sil.HpredSet.cardinal reach')) {
(reach, exps) (reach, exps)
} else { } else {
@ -115,8 +117,8 @@ let remove_abduced_retvars tenv p => {
}; };
/* separate the abduced pvars from the normal ones, deallocate the abduced ones*/ /* separate the abduced pvars from the normal ones, deallocate the abduced ones*/
let (abduceds, normal_pvars) = let (abduceds, normal_pvars) =
IList.fold_left List.fold
( f::(
fun pvars hpred => fun pvars hpred =>
switch hpred { switch hpred {
| Sil.Hpointsto (Exp.Lvar pvar) _ _ => | Sil.Hpointsto (Exp.Lvar pvar) _ _ =>
@ -129,13 +131,13 @@ let remove_abduced_retvars tenv p => {
| _ => pvars | _ => pvars
} }
) )
([], []) init::([], [])
p.Prop.sigma; p.Prop.sigma;
let (_, p') = Attribute.deallocate_stack_vars tenv p abduceds; let (_, p') = Attribute.deallocate_stack_vars tenv p abduceds;
let normal_pvar_set = let normal_pvar_set =
IList.fold_left List.fold
(fun normal_pvar_set pvar => Exp.Set.add (Exp.Lvar pvar) normal_pvar_set) f::(fun normal_pvar_set pvar => Exp.Set.add (Exp.Lvar pvar) normal_pvar_set)
Exp.Set.empty init::Exp.Set.empty
normal_pvars; normal_pvars;
/* walk forward from non-abduced pvars, keep everything reachable. remove everything else */ /* walk forward from non-abduced pvars, keep everything reachable. remove everything else */
let (sigma_reach, pi_reach) = compute_reachable p' normal_pvar_set; let (sigma_reach, pi_reach) = compute_reachable p' normal_pvar_set;

@ -135,7 +135,7 @@ let aggregate_all_stats origin => {
let stats_paths = let stats_paths =
switch origin { switch origin {
| Buck_out tf => | Buck_out tf =>
IList.fold_left (fun acc (_, paths) => accumulate_paths acc paths) empty_stats_paths tf List.fold f::(fun acc (_, paths) => accumulate_paths acc paths) init::empty_stats_paths tf
| Infer_out paths => paths | Infer_out paths => paths
}; };
{ {
@ -152,7 +152,7 @@ let aggregate_stats_by_target tp => {
| Some v => [(t, v), ...acc] | Some v => [(t, v), ...acc]
| None => acc | None => acc
}; };
let l = IList.fold_left (fun acc (t, p) => collect_valid_stats acc t (f p)) [] aggr_stats; let l = List.fold f::(fun acc (t, p) => collect_valid_stats acc t (f p)) init::[] aggr_stats;
switch l { switch l {
| [] => None | [] => None
| _ as v => Some (`Assoc v) | _ as v => Some (`Assoc v)

@ -33,7 +33,7 @@ let sigma_rewrite tenv p r : Prop.normal Prop.t option =
else else
let res_pi = r.r_new_pi p p_leftover sub in let res_pi = r.r_new_pi p p_leftover sub in
let res_sigma = Prop.sigma_sub sub r.r_new_sigma in let res_sigma = Prop.sigma_sub sub r.r_new_sigma in
let p_with_res_pi = IList.fold_left (Prop.prop_atom_and tenv) p_leftover res_pi in let p_with_res_pi = List.fold ~f:(Prop.prop_atom_and tenv) ~init:p_leftover res_pi in
let p_new = Prop.prop_sigma_star p_with_res_pi res_sigma in let p_new = Prop.prop_sigma_star p_with_res_pi res_sigma in
Some (Prop.normalize tenv p_new) Some (Prop.normalize tenv p_new)
@ -494,7 +494,7 @@ let discover_para_candidates tenv p =
let edges_matched = List.filter ~f:(fun (e1', _) -> Exp.equal e2 e1') edges_others in let edges_matched = List.filter ~f:(fun (e1', _) -> Exp.equal e2 e1') edges_others in
let new_found = let new_found =
let f found_acc (_, e3) = (e1, e2, e3) :: found_acc in let f found_acc (_, e3) = (e1, e2, e3) :: found_acc in
IList.fold_left f found edges_matched in List.fold ~f ~init:found edges_matched in
let new_edges_seen = (e1, e2) :: edges_seen in let new_edges_seen = (e1, e2) :: edges_seen in
find_all_consecutive_edges new_found new_edges_seen edges_notseen in find_all_consecutive_edges new_found new_edges_seen edges_notseen in
let sigma = p.Prop.sigma in let sigma = p.Prop.sigma in
@ -514,7 +514,7 @@ let discover_para_dll_candidates tenv p =
match se with match se with
| Sil.Eexp (e, _) -> e:: acc | Sil.Eexp (e, _) -> e:: acc
| _ -> assert false in | _ -> assert false in
let links = IList.rev (IList.fold_left convert_to_exp [] 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 -> (IList.iter (fun y -> add_edge (root, x, y)) l; iter_pairs l) in
@ -534,7 +534,7 @@ let discover_para_dll_candidates tenv p =
let edges_matched = List.filter ~f:(fun (e1', _, _) -> Exp.equal flink e1') edges_others in let edges_matched = List.filter ~f:(fun (e1', _, _) -> Exp.equal flink e1') edges_others in
let new_found = let new_found =
let f found_acc (_, _, flink2) = (iF, blink, flink, flink2) :: found_acc in let f found_acc (_, _, flink2) = (iF, blink, flink, flink2) :: found_acc in
IList.fold_left f found edges_matched in List.fold ~f ~init:found edges_matched in
let new_edges_seen = (iF, blink, flink) :: edges_seen in let new_edges_seen = (iF, blink, flink) :: edges_seen in
find_all_consecutive_edges new_found new_edges_seen edges_notseen in find_all_consecutive_edges new_found new_edges_seen edges_notseen in
let sigma = p.Prop.sigma in let sigma = p.Prop.sigma in
@ -549,7 +549,7 @@ let discover_para tenv p =
match (discover_para_roots tenv p root next next out) with match (discover_para_roots tenv p root next next out) with
| None -> paras | None -> paras
| Some para -> if already_defined para paras then paras else para :: paras in | Some para -> if already_defined para paras then paras else para :: paras in
IList.fold_left f [] candidates List.fold ~f ~init:[] candidates
let discover_para_dll tenv p = let discover_para_dll tenv p =
(* (*
@ -563,7 +563,7 @@ let discover_para_dll tenv p =
match (discover_para_dll_roots tenv p iF oB iF' iF' iF oF) with match (discover_para_dll_roots tenv p iF oB iF' iF' iF oF) with
| None -> paras | None -> paras
| Some para -> if already_defined para paras then paras else para :: paras in | Some para -> if already_defined para paras then paras else para :: paras in
IList.fold_left f [] candidates List.fold ~f ~init:[] candidates
(****************** End of Predicate Discovery ******************) (****************** End of Predicate Discovery ******************)
(****************** Start of the ADT abs_rules ******************) (****************** Start of the ADT abs_rules ******************)
@ -667,7 +667,7 @@ let sigma_special_cases ids sigma : (Ident.t list * Sil.hpred list) list =
| None -> acc | None -> acc
| Some (ids_res, sub) -> | Some (ids_res, sub) ->
(ids_res, IList.map (Sil.hpred_sub sub) sigma_cur) :: acc in (ids_res, IList.map (Sil.hpred_sub sub) sigma_cur) :: acc in
IList.fold_left f [] special_cases_eqs in List.fold ~f ~init:[] special_cases_eqs in
IList.rev special_cases_rev IList.rev special_cases_rev
let hpara_special_cases hpara : Sil.hpara list = let hpara_special_cases hpara : Sil.hpara list =
@ -692,9 +692,9 @@ let abs_rules_apply_rsets tenv (rsets: rule_set list) (p_in: Prop.normal Prop.t)
(true, p') in (true, p') in
let rec apply_rule_set p rset = let rec apply_rule_set p rset =
let (_, rules) = rset in let (_, rules) = rset in
let (changed, p') = IList.fold_left apply_rule (false, p) rules in let (changed, p') = List.fold ~f:apply_rule ~init:(false, p) rules in
if changed then apply_rule_set p' rset else p' in if changed then apply_rule_set p' rset else p' in
IList.fold_left apply_rule_set p_in rsets List.fold ~f:apply_rule_set ~init:p_in rsets
let abs_rules_apply_lists tenv (p_in: Prop.normal Prop.t) : Prop.normal Prop.t = let abs_rules_apply_lists tenv (p_in: Prop.normal Prop.t) : Prop.normal Prop.t =
let new_rsets = ref [] in let new_rsets = ref [] in
@ -773,8 +773,8 @@ let abstract_pure_part tenv p ~(from_abstract_footprint: bool) =
else true) in else true) in
List.filter ~f:filter pure in List.filter ~f:filter pure in
let new_pure = let new_pure =
IList.fold_left List.fold
(fun pi a -> ~f:(fun pi a ->
match a with match a with
(* we only use Lt and Le because Gt and Ge are inserted in terms of Lt and Le. *) (* we only use Lt and Le because Gt and Ge are inserted in terms of Lt and Le. *)
| Sil.Aeq (Exp.Const (Const.Cint i), Exp.BinOp (Binop.Lt, _, _)) | Sil.Aeq (Exp.Const (Const.Cint i), Exp.BinOp (Binop.Lt, _, _))
@ -791,7 +791,7 @@ let abstract_pure_part tenv p ~(from_abstract_footprint: bool) =
| Sil.Apred (_, Var _ :: _) | Anpred (_, Var _ :: _) -> a :: pi | Sil.Apred (_, Var _ :: _) | Anpred (_, Var _ :: _) -> a :: pi
| Sil.Aeq _ | Aneq _ | Apred _ | Anpred _ -> pi | Sil.Aeq _ | Aneq _ | Apred _ | Anpred _ -> pi
) )
[] pi_filtered in ~init:[] pi_filtered in
IList.rev new_pure in IList.rev new_pure in
let new_pure = do_pure (Prop.get_pure p) in let new_pure = do_pure (Prop.get_pure p) in

@ -275,13 +275,13 @@ let prop_replace_path_index tenv
= =
let elist_path = StrexpMatch.path_to_exps path in let elist_path = StrexpMatch.path_to_exps path in
let expmap_list = let expmap_list =
IList.fold_left (fun acc_outer e_path -> List.fold ~f:(fun acc_outer e_path ->
IList.fold_left (fun acc_inner (old_index, new_index) -> List.fold ~f:(fun acc_inner (old_index, new_index) ->
let old_e_path_index = Prop.exp_normalize_prop tenv p (Exp.Lindex(e_path, old_index)) in let old_e_path_index = Prop.exp_normalize_prop tenv p (Exp.Lindex(e_path, old_index)) in
let new_e_path_index = Prop.exp_normalize_prop tenv p (Exp.Lindex(e_path, new_index)) in let new_e_path_index = Prop.exp_normalize_prop tenv p (Exp.Lindex(e_path, new_index)) in
(old_e_path_index, new_e_path_index) :: acc_inner (old_e_path_index, new_e_path_index) :: acc_inner
) acc_outer map ) ~init:acc_outer map
) [] elist_path in ) ~init:[] elist_path in
let expmap_fun e' = let expmap_fun e' =
Option.value_map Option.value_map
~f:snd (List.find ~f:(fun (e, _) -> Exp.equal e e') expmap_list) ~f:snd (List.find ~f:(fun (e, _) -> Exp.equal e e') expmap_list)
@ -411,10 +411,9 @@ let blur_array_index tenv
let blur_array_indices tenv let blur_array_indices tenv
(p: Prop.normal Prop.t) (p: Prop.normal Prop.t)
(root: StrexpMatch.path) (root: StrexpMatch.path)
(indices: Exp.t list) : Prop.normal Prop.t * bool (indices: Exp.t list) : Prop.normal Prop.t * bool =
=
let f prop index = blur_array_index tenv prop root index in let f prop index = blur_array_index tenv prop root index in
(IList.fold_left f p indices, IList.length indices > 0) (List.fold ~f ~init:p indices, IList.length indices > 0)
(** Given [p] containing an array at [root], only keep [indices] in it *) (** Given [p] containing an array at [root], only keep [indices] in it *)

@ -150,12 +150,12 @@ let iterate_callbacks store_summary call_graph exe_env =
"unknown" in "unknown" in
let cluster proc_names = let cluster proc_names =
let cluster_map = let cluster_map =
IList.fold_left List.fold
(fun map proc_name -> ~f:(fun map proc_name ->
let proc_cluster = cluster_id proc_name in let proc_cluster = cluster_id proc_name in
let bucket = try String.Map.find_exn map proc_cluster with Not_found -> [] in let bucket = try String.Map.find_exn map proc_cluster with Not_found -> [] in
String.Map.add ~key:proc_cluster ~data:(proc_name:: bucket) map) String.Map.add ~key:proc_cluster ~data:(proc_name:: bucket) map)
String.Map.empty ~init:String.Map.empty
proc_names in proc_names in
(* Return all values of the map *) (* Return all values of the map *)
String.Map.data cluster_map in String.Map.data cluster_map in

@ -52,10 +52,10 @@ let stitch_summaries stacktrace_file summary_files out_file =
let summaries = IList.map let summaries = IList.map
(Ag_util.Json.from_file Stacktree_j.read_stacktree) (Ag_util.Json.from_file Stacktree_j.read_stacktree)
summary_files in summary_files in
let summary_map = IList.fold_left let summary_map = List.fold
(fun acc stacktree -> ~f:(fun acc stacktree ->
String.Map.add ~key:(frame_id_of_summary stacktree) ~data:stacktree acc) String.Map.add ~key:(frame_id_of_summary stacktree) ~data:stacktree acc)
String.Map.empty ~init:String.Map.empty
summaries in summaries in
let expand_stack_frame frame = let expand_stack_frame frame =
(* TODO: Implement k > 1 case *) (* TODO: Implement k > 1 case *)

@ -213,7 +213,7 @@ end = struct
let get_lexp_set' sigma = let get_lexp_set' sigma =
let lexp_lst = Sil.hpred_list_get_lexps (fun _ -> true) sigma in let lexp_lst = Sil.hpred_list_get_lexps (fun _ -> true) sigma in
IList.fold_left (fun set e -> Exp.Set.add e set) Exp.Set.empty lexp_lst List.fold ~f:(fun set e -> Exp.Set.add e set) ~init:Exp.Set.empty lexp_lst
let init sigma1 sigma2 = let init sigma1 sigma2 =
lexps1 := get_lexp_set' sigma1; lexps1 := get_lexp_set' sigma1;
lexps2 := get_lexp_set' sigma2 lexps2 := get_lexp_set' sigma2
@ -511,7 +511,7 @@ end = struct
let e_upper1 = Exp.int upper1 in let e_upper1 = Exp.int upper1 in
get_induced_atom tenv acc e_strict_lower1 e_upper1 e get_induced_atom tenv acc e_strict_lower1 e_upper1 e
| _ -> acc in | _ -> acc in
IList.fold_left f_ineqs eqs t_minimal List.fold ~f:f_ineqs ~init:eqs t_minimal
end end
@ -1664,11 +1664,11 @@ let pi_partial_join tenv mode
end; end;
let atom_list1 = let atom_list1 =
let p2 = Prop.normalize tenv ep2 in let p2 = Prop.normalize tenv ep2 in
IList.fold_left (handle_atom_with_widening Lhs p2 pi2) [] pi1 in List.fold ~f:(handle_atom_with_widening Lhs p2 pi2) ~init:[] pi1 in
if Config.trace_join then (L.d_str "atom_list1: "; Prop.d_pi atom_list1; L.d_ln ()); if Config.trace_join then (L.d_str "atom_list1: "; Prop.d_pi atom_list1; L.d_ln ());
let atom_list2 = let atom_list2 =
let p1 = Prop.normalize tenv ep1 in let p1 = Prop.normalize tenv ep1 in
IList.fold_left (handle_atom_with_widening Rhs p1 pi1) [] pi2 in List.fold ~f:(handle_atom_with_widening Rhs p1 pi1) ~init:[] pi2 in
if Config.trace_join then if Config.trace_join then
(L.d_str "atom_list2: "; Prop.d_pi atom_list2; L.d_ln ()); (L.d_str "atom_list2: "; Prop.d_pi atom_list2; L.d_ln ());
let atom_list_combined = IList.inter Sil.compare_atom atom_list1 atom_list2 in let atom_list_combined = IList.inter Sil.compare_atom atom_list1 atom_list2 in
@ -1697,9 +1697,10 @@ let pi_partial_meet tenv (p: Prop.normal Prop.t) (ep1: 'a Prop.t) (ep2: 'b Prop.
let pi1 = ep1.Prop.pi in let pi1 = ep1.Prop.pi in
let pi2 = ep2.Prop.pi in let pi2 = ep2.Prop.pi in
let p_pi1 = IList.fold_left f1 p pi1 in let p_pi1 = List.fold ~f:f1 ~init:p pi1 in
let p_pi2 = IList.fold_left f2 p_pi1 pi2 in let p_pi2 = List.fold ~f:f2 ~init:p_pi1 pi2 in
if (Prover.check_inconsistency_base tenv p_pi2) then (L.d_strln "check_inconsistency_base failed"; raise IList.Fail) if (Prover.check_inconsistency_base tenv p_pi2)
then (L.d_strln "check_inconsistency_base failed"; raise IList.Fail)
else p_pi2 else p_pi2
(** {2 Join and Meet for Prop} *) (** {2 Join and Meet for Prop} *)
@ -1800,7 +1801,7 @@ let eprop_partial_join' tenv mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed
L.d_strln "pi_partial_join succeeded"; L.d_strln "pi_partial_join succeeded";
let pi_from_fresh_vars = FreshVarExp.get_induced_pi tenv () in let pi_from_fresh_vars = FreshVarExp.get_induced_pi tenv () in
let pi_all = pi' @ pi_from_fresh_vars in let pi_all = pi' @ pi_from_fresh_vars in
IList.fold_left (Prop.prop_atom_and tenv) p_sub_sigma pi_all in List.fold ~f:(Prop.prop_atom_and tenv) ~init:p_sub_sigma pi_all in
p_sub_sigma_pi p_sub_sigma_pi
| _ -> | _ ->
L.d_strln "leftovers not empty"; raise IList.Fail L.d_strln "leftovers not empty"; raise IList.Fail

@ -118,14 +118,14 @@ module FileOrProcMatcher = struct
default_matcher default_matcher
else else
let pattern_map = let pattern_map =
IList.fold_left List.fold
(fun map pattern -> ~f:(fun map pattern ->
let previous = let previous =
try try
String.Map.find_exn map pattern.class_name String.Map.find_exn map pattern.class_name
with Not_found -> [] in with Not_found -> [] in
String.Map.add ~key:pattern.class_name ~data:(pattern :: previous) map) String.Map.add ~key:pattern.class_name ~data:(pattern :: previous) map)
String.Map.empty ~init:String.Map.empty
m_patterns in m_patterns in
let do_java pname_java = let do_java pname_java =
let class_name = Procname.java_get_class_name pname_java let class_name = Procname.java_get_class_name pname_java
@ -152,7 +152,7 @@ module FileOrProcMatcher = struct
let collect (s_patterns, m_patterns) = function let collect (s_patterns, m_patterns) = function
| Source_contains (_, s) -> (s:: s_patterns, m_patterns) | Source_contains (_, s) -> (s:: s_patterns, m_patterns)
| Method_pattern (_, mp) -> (s_patterns, mp :: m_patterns) in | Method_pattern (_, mp) -> (s_patterns, mp :: m_patterns) in
IList.fold_left collect ([], []) patterns in List.fold ~f:collect ~init:([], []) patterns in
let s_matcher = let s_matcher =
let matcher = FileContainsStringMatcher.create_matcher s_patterns in let matcher = FileContainsStringMatcher.create_matcher s_patterns in
fun source_file _ -> matcher source_file fun source_file _ -> matcher source_file
@ -253,7 +253,7 @@ let patterns_of_json_with_key (json_key, json) =
let collect accu = function let collect accu = function
| `String s -> s:: accu | `String s -> s:: accu
| _ -> failwith ("Unrecognised parameters in " ^ Yojson.Basic.to_string (`Assoc assoc)) in | _ -> failwith ("Unrecognised parameters in " ^ Yojson.Basic.to_string (`Assoc assoc)) in
IList.rev (IList.fold_left collect [] l) in IList.rev (List.fold ~f:collect ~init:[] l) in
let create_method_pattern assoc = let create_method_pattern assoc =
let loop mp = function let loop mp = function
| (key, `String s) when String.equal key "class" -> | (key, `String s) when String.equal key "class" ->
@ -264,13 +264,13 @@ let patterns_of_json_with_key (json_key, json) =
{ mp with parameters = Some (collect_params l) } { mp with parameters = Some (collect_params l) }
| (key, _) when String.equal key "language" -> mp | (key, _) when String.equal key "language" -> mp
| _ -> failwith ("Fails to parse " ^ Yojson.Basic.to_string (`Assoc assoc)) in | _ -> failwith ("Fails to parse " ^ Yojson.Basic.to_string (`Assoc assoc)) in
IList.fold_left loop default_method_pattern assoc List.fold ~f:loop ~init:default_method_pattern assoc
and create_string_contains assoc = and create_string_contains assoc =
let loop sc = function let loop sc = function
| (key, `String pattern) when String.equal key "source_contains" -> pattern | (key, `String pattern) when String.equal key "source_contains" -> pattern
| (key, _) when String.equal key "language" -> sc | (key, _) when String.equal key "language" -> sc
| _ -> failwith ("Fails to parse " ^ Yojson.Basic.to_string (`Assoc assoc)) in | _ -> failwith ("Fails to parse " ^ Yojson.Basic.to_string (`Assoc assoc)) in
IList.fold_left loop default_source_contains assoc in List.fold ~f:loop ~init:default_source_contains assoc in
match detect_pattern assoc with match detect_pattern assoc with
| Ok (Method_pattern (language, _)) -> | Ok (Method_pattern (language, _)) ->
Ok (Method_pattern (language, create_method_pattern assoc)) Ok (Method_pattern (language, create_method_pattern assoc))
@ -293,7 +293,7 @@ let patterns_of_json_with_key (json_key, json) =
warn_user msg; warn_user msg;
accu) accu)
| `List l -> | `List l ->
IList.fold_left translate accu l List.fold ~f:translate ~init:accu l
| json -> | json ->
warn_user (Printf.sprintf "expected list or assoc json type, but got value %s" warn_user (Printf.sprintf "expected list or assoc json type, but got value %s"
(Yojson.Basic.to_string json)); (Yojson.Basic.to_string json));
@ -369,9 +369,10 @@ let test () =
(fun (name, analyzer) -> (name, analyzer, create_filters analyzer)) (fun (name, analyzer) -> (name, analyzer, create_filters analyzer))
Config.string_to_analyzer in Config.string_to_analyzer in
let matching_analyzers path = let matching_analyzers path =
IList.fold_left List.fold
(fun l (n, a, f) -> if f.path_filter path then (n,a) :: l else l) ~f:(fun l (n, a, f) -> if f.path_filter path then (n,a) :: l else l)
[] filters in ~init:[]
filters in
Utils.directory_iter Utils.directory_iter
(fun path -> (fun path ->
if DB.is_source_file path then if DB.is_source_file path then

@ -496,12 +496,12 @@ let add_taint_attrs tenv proc_name proc_desc prop =
let formal_params' = let formal_params' =
IList.map (fun (p, _) -> Pvar.mk p proc_name) formal_params in IList.map (fun (p, _) -> Pvar.mk p proc_name) formal_params in
Taint.get_params_to_taint tainted_param_nums formal_params' Taint.get_params_to_taint tainted_param_nums formal_params'
|> IList.fold_left |> List.fold
(fun prop_acc (param, taint_kind) -> ~f:(fun prop_acc (param, taint_kind) ->
let attr = let attr =
PredSymb.Ataint { taint_source = proc_name; taint_kind; } in PredSymb.Ataint { taint_source = proc_name; taint_kind; } in
Taint.add_tainting_attribute tenv attr param prop_acc) Taint.add_tainting_attribute tenv attr param prop_acc)
prop ~init:prop
let forward_tabulate tenv pdesc wl source = let forward_tabulate tenv pdesc wl source =
let pname = Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
@ -668,15 +668,15 @@ let report_context_leaks pname sigma tenv =
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 =
IList.fold_left List.fold
(fun exps hpred -> match hpred with ~f:(fun exps hpred -> match hpred with
| Sil.Hpointsto (_, Eexp (exp, _), Sizeof (Tptr (Tstruct name, _), _, _)) | Sil.Hpointsto (_, Eexp (exp, _), Sizeof (Tptr (Tstruct name, _), _, _))
when not (Exp.is_null_literal exp) when not (Exp.is_null_literal exp)
&& AndroidFramework.is_context tenv name && AndroidFramework.is_context tenv name
&& not (AndroidFramework.is_application tenv name) -> && not (AndroidFramework.is_application tenv name) ->
(exp, name) :: exps (exp, name) :: exps
| _ -> exps) | _ -> exps)
[] ~init:[]
sigma in sigma in
IList.iter IList.iter
(function (function
@ -780,7 +780,7 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list =
| Some (post, path) -> Paths.PathSet.add_renamed_prop post path current_posts in | Some (post, path) -> Paths.PathSet.add_renamed_prop post path current_posts in
let new_visited = Specs.Visitedset.union visited current_visited in let new_visited = Specs.Visitedset.union visited current_visited in
Pmap.add pre (new_posts, new_visited) map in Pmap.add pre (new_posts, new_visited) map in
IList.fold_left add Pmap.empty pre_post_visited_list in List.fold ~f:add ~init:Pmap.empty pre_post_visited_list in
let specs = ref [] in let specs = ref [] in
let add_spec pre ((posts : Paths.PathSet.t), visited) = let add_spec pre ((posts : Paths.PathSet.t), visited) =
let posts' = let posts' =
@ -841,7 +841,7 @@ let create_seed_vars sigma =
| Sil.Hpointsto (Exp.Lvar pv, se, typ) when not (Pvar.is_abduced pv) -> | Sil.Hpointsto (Exp.Lvar pv, se, typ) when not (Pvar.is_abduced pv) ->
Sil.Hpointsto(Exp.Lvar (Pvar.to_seed pv), se, typ) :: sigma Sil.Hpointsto(Exp.Lvar (Pvar.to_seed pv), se, typ) :: sigma
| _ -> sigma in | _ -> sigma in
IList.fold_left hpred_add_seed [] sigma List.fold ~f:hpred_add_seed ~init:[] sigma
(** Initialize proposition for execution given formal and global (** Initialize proposition for execution given formal and global
parameters. The footprint is initialized according to the parameters. The footprint is initialized according to the
@ -1125,8 +1125,8 @@ let exception_preconditions tenv pname summary =
((pre, exn_name) :: exns, all_post_exn) ((pre, exn_name) :: exns, all_post_exn)
| _ -> (exns, false) in | _ -> (exns, false) in
let collect_spec errors spec = let collect_spec errors spec =
IList.fold_left (collect_exceptions spec.Specs.pre) errors spec.Specs.posts in List.fold ~f:(collect_exceptions spec.Specs.pre) ~init:errors spec.Specs.posts in
IList.fold_left collect_spec ([], true) (Specs.get_specs_from_payload summary) List.fold ~f:collect_spec ~init:([], true) (Specs.get_specs_from_payload summary)
(* Collect all pairs of the kind (precondition, custom error) from a summary *) (* Collect all pairs of the kind (precondition, custom error) from a summary *)
let custom_error_preconditions summary = let custom_error_preconditions summary =
@ -1135,8 +1135,8 @@ let custom_error_preconditions summary =
| None -> (errors, false) | None -> (errors, false)
| Some e -> ((pre, e) :: errors, all_post_error) in | Some e -> ((pre, e) :: errors, all_post_error) in
let collect_spec errors spec = let collect_spec errors spec =
IList.fold_left (collect_errors spec.Specs.pre) errors spec.Specs.posts in List.fold ~f:(collect_errors spec.Specs.pre) ~init:errors spec.Specs.posts in
IList.fold_left collect_spec ([], true) (Specs.get_specs_from_payload summary) List.fold ~f:collect_spec ~init:([], true) (Specs.get_specs_from_payload summary)
(* Remove the constrain of the form this != null which is true for all Java virtual calls *) (* Remove the constrain of the form this != null which is true for all Java virtual calls *)
@ -1150,11 +1150,11 @@ let remove_this_not_null tenv prop =
| Sil.Aneq (Exp.Var v, e) | Sil.Aneq (Exp.Var v, e)
when Ident.equal v var && Exp.equal e Exp.null -> atoms when Ident.equal v var && Exp.equal e Exp.null -> atoms
| a -> a:: atoms in | a -> a:: atoms in
match IList.fold_left collect_hpred (None, []) prop.Prop.sigma with match List.fold ~f:collect_hpred ~init:(None, []) prop.Prop.sigma with
| None, _ -> prop | None, _ -> prop
| Some var, filtered_hpreds -> | Some var, filtered_hpreds ->
let filtered_atoms = let filtered_atoms =
IList.fold_left (collect_atom var) [] prop.Prop.pi in List.fold ~f:(collect_atom var) ~init:[] prop.Prop.pi in
let prop' = Prop.set Prop.prop_emp ~pi:filtered_atoms ~sigma:filtered_hpreds in let prop' = Prop.set Prop.prop_emp ~pi:filtered_atoms ~sigma:filtered_hpreds in
Prop.normalize tenv prop' Prop.normalize tenv prop'
@ -1227,12 +1227,12 @@ let update_specs tenv proc_name phase (new_specs : Specs.NormSpec.t list)
let changed = ref false in let changed = ref false in
let current_specs = let current_specs =
ref ref
(IList.fold_left (List.fold
(fun map spec -> ~f:(fun map spec ->
SpecMap.add SpecMap.add
spec.Specs.pre spec.Specs.pre
(Paths.PathSet.from_renamed_list spec.Specs.posts, spec.Specs.visited) map) (Paths.PathSet.from_renamed_list spec.Specs.posts, spec.Specs.visited) map)
SpecMap.empty old_specs) in ~init:SpecMap.empty old_specs) in
let re_exe_filter old_spec = (* filter out pres which failed re-exe *) let re_exe_filter old_spec = (* filter out pres which failed re-exe *)
if Specs.equal_phase phase Specs.RE_EXECUTION && if Specs.equal_phase phase Specs.RE_EXECUTION &&
not (List.exists not (List.exists

@ -88,7 +88,7 @@ let exp_list_match es1 sub vars es2 =
| None -> None | None -> None
| Some (sub_acc, vars_leftover) -> exp_match e1 sub_acc vars_leftover e2 in | Some (sub_acc, vars_leftover) -> exp_match e1 sub_acc vars_leftover e2 in
Option.find_map Option.find_map
~f:(fun es_combined -> IList.fold_left f (Some (sub, vars)) es_combined) ~f:(fun es_combined -> List.fold ~f ~init:(Some (sub, vars)) es_combined)
(List.zip es1 es2) (List.zip es1 es2)
(** Checks sexp1 = sexp2[sub ++ sub'] for some sub' with (** Checks sexp1 = sexp2[sub ++ sub'] for some sub' with

@ -30,7 +30,7 @@ let modified_targets = ref String.Set.empty
let modified_file file = let modified_file file =
match Utils.read_file file with match Utils.read_file file with
| Some targets -> | Some targets ->
modified_targets := IList.fold_left String.Set.add String.Set.empty targets modified_targets := List.fold ~f:String.Set.add ~init:String.Set.empty targets
| None -> | None ->
() ()

@ -682,6 +682,6 @@ end = struct
(** It's the caller's resposibility to ensure that Prop.prop_rename_primed_footprint_vars was called on the list *) (** It's the caller's resposibility to ensure that Prop.prop_rename_primed_footprint_vars was called on the list *)
let from_renamed_list (pl : ('a Prop.t * Path.t) list) : t = let from_renamed_list (pl : ('a Prop.t * Path.t) list) : t =
IList.fold_left (fun ps (p, pa) -> add_renamed_prop p pa ps) empty pl List.fold ~f:(fun ps (p, pa) -> add_renamed_prop p pa ps) ~init:empty pl
end end
(* =============== END of the PathSet module ===============*) (* =============== END of the PathSet module ===============*)

@ -274,8 +274,8 @@ let do_copy_propagation pdesc tenv =
(* perform copy-propagation on each instruction in [node] *) (* perform copy-propagation on each instruction in [node] *)
let rev_transform_node_instrs node = let rev_transform_node_instrs node =
IList.fold_left List.fold
(fun (instrs, changed) (instr, id_opt) -> ~f:(fun (instrs, changed) (instr, id_opt) ->
match id_opt with match id_opt with
| Some id -> | Some id ->
begin begin
@ -287,7 +287,7 @@ let do_copy_propagation pdesc tenv =
instr :: instrs, changed instr :: instrs, changed
end end
| None -> instr :: instrs, changed) | None -> instr :: instrs, changed)
([], false) ~init:([], false)
(ExceptionalOneInstrPerNodeCfg.instr_ids node) in (ExceptionalOneInstrPerNodeCfg.instr_ids node) in
IList.iter IList.iter

@ -484,7 +484,7 @@ let rec create_strexp_of_type tenv struct_init_mode (typ : Typ.t) len inst : Sil
((fld, Sil.Eexp (Exp.one, inst)) :: flds, None) ((fld, Sil.Eexp (Exp.one, inst)) :: flds, None)
else else
((fld, create_strexp_of_type tenv struct_init_mode t len inst) :: flds, None) in ((fld, create_strexp_of_type tenv struct_init_mode t len inst) :: flds, None) in
let flds, _ = IList.fold_right f fields ([], len) in let flds, _ = List.fold_right ~f fields ~init:([], len) in
Estruct (flds, inst) Estruct (flds, inst)
| _ -> | _ ->
Estruct ([], inst) Estruct ([], inst)
@ -593,19 +593,28 @@ let strexp_get_exps strexp =
| Eexp (Exn e, _) -> Exp.Set.add e exps | Eexp (Exn e, _) -> Exp.Set.add e exps
| Eexp (e, _) -> Exp.Set.add e exps | Eexp (e, _) -> Exp.Set.add e exps
| Estruct (flds, _) -> | Estruct (flds, _) ->
IList.fold_left (fun exps (_, strexp) -> strexp_get_exps_rec exps strexp) exps flds List.fold
~f:(fun exps (_, strexp) -> strexp_get_exps_rec exps strexp)
~init:exps
flds
| Earray (_, elems, _) -> | Earray (_, elems, _) ->
IList.fold_left (fun exps (_, strexp) -> strexp_get_exps_rec exps strexp) exps elems in List.fold
~f:(fun exps (_, strexp) -> strexp_get_exps_rec exps strexp)
~init:exps
elems in
strexp_get_exps_rec Exp.Set.empty strexp strexp_get_exps_rec Exp.Set.empty strexp
(** get the set of expressions on the righthand side of [hpred] *) (** get the set of expressions on the righthand side of [hpred] *)
let hpred_get_targets (hpred : Sil.hpred) = match hpred with let hpred_get_targets (hpred : Sil.hpred) = match hpred with
| Hpointsto (_, rhs, _) -> strexp_get_exps rhs | Hpointsto (_, rhs, _) -> strexp_get_exps rhs
| Hlseg (_, _, _, e, el) -> | Hlseg (_, _, _, e, el) ->
IList.fold_left (fun exps e -> Exp.Set.add e exps) Exp.Set.empty (e :: el) List.fold ~f:(fun exps e -> Exp.Set.add e exps) ~init:Exp.Set.empty (e :: el)
| Hdllseg (_, _, _, oB, oF, iB, el) -> | Hdllseg (_, _, _, oB, oF, iB, el) ->
(* only one direction supported for now *) (* only one direction supported for now *)
IList.fold_left (fun exps e -> Exp.Set.add e exps) Exp.Set.empty (oB :: oF :: iB :: el) List.fold
~f:(fun exps e -> Exp.Set.add e exps)
~init:Exp.Set.empty
(oB :: oF :: iB :: el)
(** return the set of hpred's and exp's in [sigma] that are reachable from an expression in (** return the set of hpred's and exp's in [sigma] that are reachable from an expression in
[exps] *) [exps] *)
@ -617,7 +626,7 @@ let compute_reachable_hpreds sigma exps =
let reach_exps = hpred_get_targets hpred in let reach_exps = hpred_get_targets hpred in
(reach', Exp.Set.union exps reach_exps) (reach', Exp.Set.union exps reach_exps)
| _ -> reach, exps in | _ -> reach, exps in
let reach', exps' = IList.fold_left add_hpred_if_reachable (reach, exps) sigma in let reach', exps' = List.fold ~f:add_hpred_if_reachable ~init:(reach, exps) sigma in
if Int.equal (Sil.HpredSet.cardinal reach) (Sil.HpredSet.cardinal reach') then (reach, exps) if Int.equal (Sil.HpredSet.cardinal reach) (Sil.HpredSet.cardinal reach') then (reach, exps)
else compute_reachable_hpreds_rec sigma (reach', exps') in else compute_reachable_hpreds_rec sigma (reach', exps') in
compute_reachable_hpreds_rec sigma (Sil.HpredSet.empty, exps) compute_reachable_hpreds_rec sigma (Sil.HpredSet.empty, exps)
@ -1425,7 +1434,7 @@ module Normalize = struct
| Aneq (Const (Cint n), e) | Aneq (Const (Cint n), e)
| Aneq(e, Const (Cint n)) -> (e, n) :: acc | Aneq(e, Const (Cint n)) -> (e, n) :: acc
| _ -> acc in | _ -> acc in
IList.fold_left get_disequality_info [] nonineq_list in List.fold ~f:get_disequality_info ~init:[] nonineq_list in
let is_neq e n = let is_neq e n =
List.exists ~f:(fun (e', n') -> Exp.equal e e' && IntLit.eq n n') diseq_list in List.exists ~f:(fun (e', n') -> Exp.equal e e' && IntLit.eq n n') diseq_list in
let le_list_tightened = let le_list_tightened =
@ -1438,7 +1447,7 @@ module Normalize = struct
| (e, n):: le_list_todo -> (* e <= n *) | (e, n):: le_list_todo -> (* e <= n *)
if is_neq e n then le_tighten le_list_done ((e, n -- IntLit.one):: le_list_todo) if is_neq e n then le_tighten le_list_done ((e, n -- IntLit.one):: le_list_todo)
else le_tighten ((e, n):: le_list_done) (le_list_todo) in else le_tighten ((e, n):: le_list_done) (le_list_todo) in
let le_list = IList.rev (IList.fold_left get_le_inequality_info [] ineq_list) in let le_list = IList.rev (List.fold ~f:get_le_inequality_info ~init:[] ineq_list) in
le_tighten [] le_list in le_tighten [] le_list in
let lt_list_tightened = let lt_list_tightened =
let get_lt_inequality_info acc a = let get_lt_inequality_info acc a =
@ -1452,7 +1461,7 @@ module Normalize = struct
if is_neq e n_plus_one if is_neq e n_plus_one
then lt_tighten lt_list_done ((n ++ IntLit.one, e):: lt_list_todo) then lt_tighten lt_list_done ((n ++ IntLit.one, e):: lt_list_todo)
else lt_tighten ((n, e):: lt_list_done) (lt_list_todo) in else lt_tighten ((n, e):: lt_list_done) (lt_list_todo) in
let lt_list = IList.rev (IList.fold_left get_lt_inequality_info [] ineq_list) in let lt_list = IList.rev (List.fold ~f:get_lt_inequality_info ~init:[] ineq_list) in
lt_tighten [] lt_list in lt_tighten [] lt_list in
let ineq_list' = let ineq_list' =
let le_ineq_list = let le_ineq_list =
@ -1573,7 +1582,7 @@ module Normalize = struct
let p' = let p' =
unsafe_cast_to_normal unsafe_cast_to_normal
(set p ~sub:nsub' ~pi:npi' ~sigma:nsigma'') in (set p ~sub:nsub' ~pi:npi' ~sigma:nsigma'') in
IList.fold_left (prop_atom_and tenv ~footprint) p' eqs_zero List.fold ~f:(prop_atom_and tenv ~footprint) ~init:p' eqs_zero
| Aeq (e1, e2) when Exp.equal e1 e2 -> | Aeq (e1, e2) when Exp.equal e1 e2 ->
p p
| Aneq (e1, e2) -> | Aneq (e1, e2) ->
@ -1615,7 +1624,7 @@ module Normalize = struct
let p0 = let p0 =
unsafe_cast_to_normal unsafe_cast_to_normal
(set prop_emp ~sigma: (sigma_normalize tenv Sil.sub_empty eprop.sigma)) in (set prop_emp ~sigma: (sigma_normalize tenv Sil.sub_empty eprop.sigma)) in
let nprop = IList.fold_left (prop_atom_and tenv) p0 (get_pure eprop) in let nprop = List.fold ~f:(prop_atom_and tenv) ~init:p0 (get_pure eprop) in
unsafe_cast_to_normal unsafe_cast_to_normal
(footprint_normalize tenv (set nprop ~pi_fp:eprop.pi_fp ~sigma_fp:eprop.sigma_fp)) (footprint_normalize tenv (set nprop ~pi_fp:eprop.pi_fp ~sigma_fp:eprop.sigma_fp))
@ -1841,11 +1850,11 @@ let rec strexp_get_array_indices acc (se : Sil.strexp) = match se with
acc acc
| Estruct (fsel, _) -> | Estruct (fsel, _) ->
let se_list = IList.map snd fsel in let se_list = IList.map snd fsel in
IList.fold_left strexp_get_array_indices acc se_list List.fold ~f:strexp_get_array_indices ~init:acc se_list
| Earray (_, isel, _) -> | Earray (_, isel, _) ->
let acc_new = IList.fold_left (fun acc' (idx, _) -> idx:: acc') acc isel in let acc_new = List.fold ~f:(fun acc' (idx, _) -> idx:: acc') ~init:acc isel in
let se_list = IList.map snd isel in let se_list = IList.map snd isel in
IList.fold_left strexp_get_array_indices acc_new se_list List.fold ~f:strexp_get_array_indices ~init:acc_new se_list
let hpred_get_array_indices acc (hpred : Sil.hpred) = match hpred with let hpred_get_array_indices acc (hpred : Sil.hpred) = match hpred with
| Hpointsto (_, se, _) -> | Hpointsto (_, se, _) ->
@ -1854,7 +1863,7 @@ let hpred_get_array_indices acc (hpred : Sil.hpred) = match hpred with
acc acc
let sigma_get_array_indices sigma = let sigma_get_array_indices sigma =
let indices = IList.fold_left hpred_get_array_indices [] sigma in let indices = List.fold ~f:hpred_get_array_indices ~init:[] sigma in
IList.rev indices IList.rev indices
let compute_reindexing fav_add get_id_offset list = let compute_reindexing fav_add get_id_offset list =
@ -1909,7 +1918,7 @@ let apply_reindexing tenv subst prop =
let p' = let p' =
unsafe_cast_to_normal unsafe_cast_to_normal
(set prop ~sub:nsub ~pi:npi ~sigma:nsigma) in (set prop ~sub:nsub ~pi:npi ~sigma:nsigma) in
IList.fold_left (Normalize.prop_atom_and tenv) p' atoms List.fold ~f:(Normalize.prop_atom_and tenv) ~init:p' atoms
let prop_rename_array_indices tenv prop = let prop_rename_array_indices tenv prop =
if !Config.footprint then prop if !Config.footprint then prop
@ -2234,9 +2243,10 @@ let prop_iter_to_prop tenv iter =
~sigma:sigma ~sigma:sigma
~pi_fp:iter.pit_pi_fp ~pi_fp:iter.pit_pi_fp
~sigma_fp:iter.pit_sigma_fp) in ~sigma_fp:iter.pit_sigma_fp) in
IList.fold_left List.fold
(fun p (footprint, atom) -> Normalize.prop_atom_and tenv ~footprint: footprint p atom) ~f:(fun p (footprint, atom) -> Normalize.prop_atom_and tenv ~footprint: footprint p atom)
prop iter.pit_newpi ~init:prop
iter.pit_newpi
(** Add an atom to the pi part of prop iter. The (** Add an atom to the pi part of prop iter. The
first parameter records whether it is done first parameter records whether it is done
@ -2265,9 +2275,10 @@ let prop_iter_current tenv iter =
unsafe_cast_to_normal unsafe_cast_to_normal
(set prop_emp ~sigma:[curr]) in (set prop_emp ~sigma:[curr]) in
let prop' = let prop' =
IList.fold_left List.fold
(fun p (footprint, atom) -> Normalize.prop_atom_and tenv ~footprint: footprint p atom) ~f:(fun p (footprint, atom) -> Normalize.prop_atom_and tenv ~footprint: footprint p atom)
prop iter.pit_newpi in ~init:prop
iter.pit_newpi in
match prop'.sigma with match prop'.sigma with
| [curr'] -> (curr', iter.pit_state) | [curr'] -> (curr', iter.pit_state)
| _ -> assert false | _ -> assert false
@ -2465,8 +2476,8 @@ let prop_case_split tenv prop =
let prop' = let prop' =
unsafe_cast_to_normal unsafe_cast_to_normal
(set prop ~sigma:sigma') in (set prop ~sigma:sigma') in
(IList.fold_left (Normalize.prop_atom_and tenv) prop' pi):: props_acc in (List.fold ~f:(Normalize.prop_atom_and tenv) ~init:prop' pi):: props_acc in
IList.fold_left f [] pi_sigma_list List.fold ~f ~init:[] pi_sigma_list
let prop_expand prop = let prop_expand prop =
(* (*

@ -31,9 +31,11 @@ type t = PropSet.t
let add tenv p pset = let add tenv p pset =
let ps = Prop.prop_expand tenv p in let ps = Prop.prop_expand tenv p in
IList.fold_left (fun pset' p' -> List.fold
PropSet.add (Prop.prop_rename_primed_footprint_vars tenv p') pset' ~f:(fun pset' p' ->
) pset ps PropSet.add (Prop.prop_rename_primed_footprint_vars tenv p') pset')
~init:pset
ps
(** Singleton set. *) (** Singleton set. *)
let singleton tenv p = let singleton tenv p =
@ -64,7 +66,7 @@ let size = PropSet.cardinal
let filter = PropSet.filter let filter = PropSet.filter
let from_proplist tenv plist = let from_proplist tenv plist =
IList.fold_left (fun pset p -> add tenv p pset) empty plist List.fold ~f:(fun pset p -> add tenv p pset) ~init:empty plist
let to_proplist pset = let to_proplist pset =
PropSet.elements pset PropSet.elements pset
@ -84,7 +86,7 @@ let map tenv f pset =
where [p1 ... pN] are the elements of pset, in increasing order. *) where [p1 ... pN] are the elements of pset, in increasing order. *)
let fold f a pset = let fold f a pset =
let l = to_proplist pset in let l = to_proplist pset in
IList.fold_left f a l List.fold ~f ~init:a l
(** [iter f pset] computes (f p1;f p2;..;f pN) (** [iter f pset] computes (f p1;f p2;..;f pN)
where [p1 ... pN] are the elements of pset, in increasing order. *) where [p1 ... pN] are the elements of pset, in increasing order. *)

@ -286,9 +286,9 @@ end = struct
let saturate { leqs = leqs; lts = lts; neqs = neqs } = let saturate { leqs = leqs; lts = lts; neqs = neqs } =
let diff_constraints1 = let diff_constraints1 =
IList.fold_left List.fold
DiffConstr.from_lt ~f:DiffConstr.from_lt
(IList.fold_left DiffConstr.from_leq [] leqs) ~init:(List.fold ~f:DiffConstr.from_leq ~init:[] leqs)
lts in lts in
let inconsistent, diff_constraints2 = DiffConstr.saturate diff_constraints1 in let inconsistent, diff_constraints2 = DiffConstr.saturate diff_constraints1 in
if inconsistent then inconsistent_ineq if inconsistent then inconsistent_ineq

@ -18,9 +18,10 @@ module F = Format
let list_product l1 l2 = let list_product l1 l2 =
let l1' = IList.rev l1 in let l1' = IList.rev l1 in
let l2' = IList.rev l2 in let l2' = IList.rev l2 in
IList.fold_left List.fold
(fun acc x -> IList.fold_left (fun acc' y -> (x, y):: acc') acc l2') ~f:(fun acc x -> List.fold ~f:(fun acc' y -> (x, y):: acc') ~init:acc l2')
[] l1' ~init:[]
l1'
let rec list_rev_and_concat l1 l2 = let rec list_rev_and_concat l1 l2 =
match l1 with match l1 with
@ -228,7 +229,7 @@ let rec _strexp_extend_values
IList.sort StructTyp.compare_field (IList.map replace_fta fields) in IList.sort StructTyp.compare_field (IList.map replace_fta fields) in
ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ;
(res_atoms', Sil.Estruct (res_fsel', inst'), typ) :: acc in (res_atoms', Sil.Estruct (res_fsel', inst'), typ) :: acc in
IList.fold_left replace [] atoms_se_typ_list' List.fold ~f:replace ~init:[] atoms_se_typ_list'
| None -> | None ->
let atoms', se', res_typ' = let atoms', se', res_typ' =
create_struct_values create_struct_values
@ -280,7 +281,7 @@ let rec _strexp_extend_values
:: acc :: acc
else else
raise (Exceptions.Bad_footprint __POS__) in raise (Exceptions.Bad_footprint __POS__) in
IList.fold_left replace [] atoms_se_typ_list' List.fold ~f:replace ~init:[] atoms_se_typ_list'
| None -> | None ->
array_case_analysis_index pname tenv orig_prop array_case_analysis_index pname tenv orig_prop
footprint_part kind max_stamp footprint_part kind max_stamp
@ -341,14 +342,16 @@ and array_case_analysis_index pname tenv orig_prop
_strexp_extend_values _strexp_extend_values
pname tenv orig_prop footprint_part kind max_stamp se typ_cont off inst in pname tenv orig_prop footprint_part kind max_stamp se typ_cont off inst in
let atoms_se_typ_list' = let atoms_se_typ_list' =
IList.fold_left (fun acc' (atoms', se', typ') -> List.fold
~f:(fun acc' (atoms', se', typ') ->
check_sound typ'; check_sound typ';
let atoms_new = Sil.Aeq (index, i) :: atoms' in let atoms_new = Sil.Aeq (index, i) :: atoms' in
let isel_new = list_rev_and_concat isel_seen_rev ((i, se'):: isel_unseen) in let isel_new = list_rev_and_concat isel_seen_rev ((i, se'):: isel_unseen) in
let array_new = Sil.Earray (array_len, isel_new, inst_arr) in let array_new = Sil.Earray (array_len, isel_new, inst_arr) in
let typ_new = Typ.Tarray (typ', typ_array_len) in let typ_new = Typ.Tarray (typ', typ_array_len) in
(atoms_new, array_new, typ_new):: acc' (atoms_new, array_new, typ_new):: acc')
) [] atoms_se_typ_list in ~init:[]
atoms_se_typ_list in
let acc_new = atoms_se_typ_list' :: acc in let acc_new = atoms_se_typ_list' :: acc in
let isel_seen_rev_new = ise :: isel_seen_rev in let isel_seen_rev_new = ise :: isel_seen_rev in
handle_case acc_new isel_seen_rev_new isel_unseen in handle_case acc_new isel_seen_rev_new isel_unseen in
@ -520,7 +523,7 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst =
end end
| _ -> assert false in | _ -> assert false in
let atoms_se_te_to_iter e (atoms, se, te) = let atoms_se_te_to_iter e (atoms, se, te) =
let iter' = IList.fold_left (Prop.prop_iter_add_atom !Config.footprint) iter atoms in let iter' = List.fold ~f:(Prop.prop_iter_add_atom !Config.footprint) ~init:iter atoms in
Prop.prop_iter_update_current iter' (Sil.Hpointsto (e, se, te)) in Prop.prop_iter_update_current iter' (Sil.Hpointsto (e, se, te)) in
let do_extend e se te = let do_extend e se te =
if Config.trace_rearrange then begin if Config.trace_rearrange then begin
@ -562,7 +565,8 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst =
let iter_atoms_fp_sigma_list = let iter_atoms_fp_sigma_list =
list_product iter_list atoms_fp_sigma_list in list_product iter_list atoms_fp_sigma_list in
IList.map (fun (iter, (atoms, fp_sigma)) -> IList.map (fun (iter, (atoms, fp_sigma)) ->
let iter' = IList.fold_left (Prop.prop_iter_add_atom !Config.footprint) iter atoms in let iter' =
List.fold ~f:(Prop.prop_iter_add_atom !Config.footprint) ~init:iter atoms in
Prop.prop_iter_replace_footprint_sigma iter' fp_sigma Prop.prop_iter_replace_footprint_sigma iter' fp_sigma
) iter_atoms_fp_sigma_list in ) iter_atoms_fp_sigma_list in
let res_prop_list = let res_prop_list =
@ -600,7 +604,8 @@ let prop_iter_add_hpred_footprint_to_prop pname tenv prop (lexp, typ) inst =
let sigma_fp = ptsto_foot :: eprop.Prop.sigma_fp in let sigma_fp = ptsto_foot :: eprop.Prop.sigma_fp in
let nsigma_fp = Prop.sigma_normalize_prop tenv Prop.prop_emp sigma_fp in let nsigma_fp = Prop.sigma_normalize_prop tenv Prop.prop_emp sigma_fp in
let prop' = Prop.normalize tenv (Prop.set eprop ~sigma_fp:nsigma_fp) in let prop' = Prop.normalize tenv (Prop.set eprop ~sigma_fp:nsigma_fp) in
let prop_new = IList.fold_left (Prop.prop_atom_and tenv ~footprint:!Config.footprint) prop' atoms in let prop_new =
List.fold ~f:(Prop.prop_atom_and tenv ~footprint:!Config.footprint) ~init:prop' atoms in
let iter = match (Prop.prop_iter_create prop_new) with let iter = match (Prop.prop_iter_create prop_new) with
| None -> | None ->
let prop_new' = Prop.normalize tenv (Prop.prop_hpred_star prop_new ptsto) in let prop_new' = Prop.normalize tenv (Prop.prop_hpred_star prop_new ptsto) in
@ -895,7 +900,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
| _ -> prop_acc in | _ -> prop_acc in
let hpred_check_flds prop_acc = function let hpred_check_flds prop_acc = function
| Sil.Hpointsto (_, Estruct (flds, _), Sizeof (typ, _, _)) -> | Sil.Hpointsto (_, Estruct (flds, _), Sizeof (typ, _, _)) ->
IList.fold_left (check_fld_locks typ) prop_acc flds List.fold ~f:(check_fld_locks typ) ~init:prop_acc flds
| _ -> | _ ->
prop_acc in prop_acc in
match lexp with match lexp with
@ -904,7 +909,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
enforce_guarded_access fld typ prop enforce_guarded_access fld typ prop
| _ -> | _ ->
(* check for access via alias *) (* check for access via alias *)
IList.fold_left hpred_check_flds prop prop.Prop.sigma List.fold ~f:hpred_check_flds ~init:prop prop.Prop.sigma
(** Add a pointsto for [root(lexp): typ] to the iterator and to the (** Add a pointsto for [root(lexp): typ] to the iterator and to the
footprint, if it's compatible with the allowed footprint footprint, if it's compatible with the allowed footprint
@ -924,7 +929,8 @@ let prop_iter_add_hpred_footprint pname tenv orig_prop iter (lexp, typ) inst =
L.d_ln (); L.d_ln (); L.d_ln (); L.d_ln ();
let sigma_fp = ptsto_foot :: (Prop.prop_iter_get_footprint_sigma iter) in let sigma_fp = ptsto_foot :: (Prop.prop_iter_get_footprint_sigma iter) in
let iter_foot = Prop.prop_iter_prev_then_insert iter ptsto in let iter_foot = Prop.prop_iter_prev_then_insert iter ptsto in
let iter_foot_atoms = IList.fold_left (Prop.prop_iter_add_atom (!Config.footprint)) iter_foot atoms in let iter_foot_atoms =
List.fold ~f:(Prop.prop_iter_add_atom (!Config.footprint)) ~init:iter_foot atoms in
let iter' = Prop.prop_iter_replace_footprint_sigma iter_foot_atoms sigma_fp in let iter' = Prop.prop_iter_replace_footprint_sigma iter_foot_atoms sigma_fp in
let offsets_default = Sil.exp_get_offsets lexp in let offsets_default = Sil.exp_get_offsets lexp in
Prop.prop_iter_set_state iter' offsets_default Prop.prop_iter_set_state iter' offsets_default
@ -982,7 +988,8 @@ let iter_rearrange_ptsto pname tenv orig_prop iter lexp inst =
strexp_extend_values strexp_extend_values
pname tenv orig_prop false Ident.kprimed max_stamp se te offset inst in pname tenv orig_prop false Ident.kprimed max_stamp se te offset inst in
let handle_case (atoms', se', te') = let handle_case (atoms', se', te') =
let iter' = IList.fold_left (Prop.prop_iter_add_atom !Config.footprint) iter atoms' in let iter' =
List.fold ~f:(Prop.prop_iter_add_atom !Config.footprint) ~init:iter atoms' in
Prop.prop_iter_update_current iter' (Sil.Hpointsto (e, se', te')) in Prop.prop_iter_update_current iter' (Sil.Hpointsto (e, se', te')) in
let filter it = let filter it =
let p = Prop.prop_iter_to_prop tenv it in let p = Prop.prop_iter_to_prop tenv it in

@ -149,7 +149,7 @@ let instrs_normalize instrs =
let do_instr ids = function let do_instr ids = function
| Sil.Load (id, _, _, _) -> id :: ids | Sil.Load (id, _, _, _) -> id :: ids
| _ -> ids in | _ -> ids in
IList.fold_left do_instr [] instrs in List.fold ~f:do_instr ~init:[] instrs in
let subst = let subst =
let count = ref Int.min_value in let count = ref Int.min_value in
let gensym id = let gensym id =
@ -216,9 +216,10 @@ let mk_find_duplicate_nodes proc_desc : (Procdesc.Node.t -> Procdesc.NodeSet.t)
let equal_normalized_instrs (_, normalized_instrs') = let equal_normalized_instrs (_, normalized_instrs') =
List.equal ~equal:Sil.equal_instr node_normalized_instrs normalized_instrs' in List.equal ~equal:Sil.equal_instr node_normalized_instrs normalized_instrs' in
List.filter ~f:equal_normalized_instrs elements in List.filter ~f:equal_normalized_instrs elements in
IList.fold_left List.fold
(fun nset (node', _) -> Procdesc.NodeSet.add node' nset) ~f:(fun nset (node', _) -> Procdesc.NodeSet.add node' nset)
Procdesc.NodeSet.empty duplicates ~init:Procdesc.NodeSet.empty
duplicates
with Not_found -> Procdesc.NodeSet.singleton node in with Not_found -> Procdesc.NodeSet.singleton node in
find_duplicate_nodes find_duplicate_nodes

@ -250,7 +250,7 @@ let ptsto_update pdesc tenv p (lexp, se, typ, len, st) offlist exp =
let update_iter iter pi sigma = let update_iter iter pi sigma =
let iter' = Prop.prop_iter_update_current_by_list iter sigma in let iter' = Prop.prop_iter_update_current_by_list iter sigma in
IList.fold_left (Prop.prop_iter_add_atom false) iter' pi List.fold ~f:(Prop.prop_iter_add_atom false) ~init:iter' pi
(** Precondition: se should not include hpara_psto (** Precondition: se should not include hpara_psto
that could mean nonempty heaps. *) that could mean nonempty heaps. *)
@ -597,13 +597,13 @@ let resolve_java_pname tenv prop args pname_java call_flags : Procname.java =
resolved_pname_java resolved_pname_java
else else
let resolved_params = let resolved_params =
IList.fold_left2 List.fold2_exn
(fun accu (arg_exp, _) name -> ~f:(fun accu (arg_exp, _) name ->
match resolve_typename prop arg_exp with match resolve_typename prop arg_exp with
| Some class_name -> | Some class_name ->
(Procname.split_classname (Typename.name class_name)) :: accu (Procname.split_classname (Typename.name class_name)) :: accu
| None -> name :: accu) | None -> name :: accu)
[] args (Procname.java_get_parameters resolved_pname_java) |> IList.rev in ~init:[] args (Procname.java_get_parameters resolved_pname_java) |> IList.rev in
Procname.java_replace_parameters resolved_pname_java resolved_params in Procname.java_replace_parameters resolved_pname_java resolved_params in
let resolved_pname_java, other_args = let resolved_pname_java, other_args =
match args with match args with
@ -791,7 +791,7 @@ let normalize_params tenv pdesc prop actual_params =
let norm_arg (p, args) (e, t) = let norm_arg (p, args) (e, t) =
let e', p' = check_arith_norm_exp tenv pdesc e p in let e', p' = check_arith_norm_exp tenv pdesc e p in
(p', (e', t) :: args) in (p', (e', t) :: args) in
let prop, args = IList.fold_left norm_arg (prop, []) actual_params in let prop, args = List.fold ~f:norm_arg ~init:(prop, []) actual_params in
(prop, IList.rev args) (prop, IList.rev args)
let do_error_checks tenv node_opt instr pname pdesc = match node_opt with let do_error_checks tenv node_opt instr pname pdesc = match node_opt with
@ -843,7 +843,7 @@ let add_constraints_on_retval tenv pdesc prop ret_exp ~has_nullable_annot typ ca
when Pvar.equal pv abduced -> when Pvar.equal pv abduced ->
Prop.conjoin_eq tenv exp_to_bind rhs prop Prop.conjoin_eq tenv exp_to_bind rhs prop
| _ -> prop in | _ -> prop in
IList.fold_left bind_exp prop prop.Prop.sigma in List.fold ~f:bind_exp ~init:prop prop.Prop.sigma in
(* To avoid obvious false positives, assume skip functions do not return null pointers *) (* To avoid obvious false positives, assume skip functions do not return null pointers *)
let add_ret_non_null exp typ prop = let add_ret_non_null exp typ prop =
if has_nullable_annot if has_nullable_annot
@ -920,7 +920,7 @@ let execute_load ?(report_deref_errors=true) pname pdesc tenv id rhs_exp typ loc
begin begin
match pred_insts_op with match pred_insts_op with
| None -> update acc_in ([],[]) | None -> update acc_in ([],[])
| Some pred_insts -> IList.rev (IList.fold_left update acc_in pred_insts) | Some pred_insts -> IList.rev (List.fold ~f:update ~init:acc_in pred_insts)
end end
| (Sil.Hpointsto _, _) -> | (Sil.Hpointsto _, _) ->
Errdesc.warning_err loc "no offset access in execute_load -- treating as skip@."; Errdesc.warning_err loc "no offset access in execute_load -- treating as skip@.";
@ -943,7 +943,7 @@ let execute_load ?(report_deref_errors=true) pname pdesc tenv id rhs_exp typ loc
match callee_opt, atom with match callee_opt, atom with
| None, Sil.Apred (Aundef _, _) -> Some atom | None, Sil.Apred (Aundef _, _) -> Some atom
| _ -> callee_opt in | _ -> callee_opt in
IList.fold_left fold_undef_pname None (Attribute.get_for_exp tenv prop exp) in List.fold ~f:fold_undef_pname ~init:None (Attribute.get_for_exp tenv prop exp) in
let prop' = let prop' =
if Config.angelic_execution then if Config.angelic_execution then
(* when we try to deref an undefined value, add it to the footprint *) (* when we try to deref an undefined value, add it to the footprint *)
@ -956,7 +956,7 @@ let execute_load ?(report_deref_errors=true) pname pdesc tenv id rhs_exp typ loc
else prop in else prop in
let iter_list = let iter_list =
Rearrange.rearrange ~report_deref_errors pdesc tenv n_rhs_exp' typ prop' loc in Rearrange.rearrange ~report_deref_errors pdesc tenv n_rhs_exp' typ prop' loc in
IList.rev (IList.fold_left (execute_load_ pdesc tenv id loc) [] iter_list) IList.rev (List.fold ~f:(execute_load_ pdesc tenv id loc) ~init:[] iter_list)
with Rearrange.ARRAY_ACCESS -> with Rearrange.ARRAY_ACCESS ->
if Int.equal Config.array_level 0 then assert false if Int.equal Config.array_level 0 then assert false
else else
@ -988,14 +988,14 @@ let execute_store ?(report_deref_errors=true) pname pdesc tenv lhs_exp typ rhs_e
prop' :: acc in prop' :: acc in
match pred_insts_op with match pred_insts_op with
| None -> update acc_in ([],[]) | None -> update acc_in ([],[])
| Some pred_insts -> IList.fold_left update acc_in pred_insts in | Some pred_insts -> List.fold ~f:update ~init:acc_in pred_insts in
try try
let n_lhs_exp, prop_' = check_arith_norm_exp tenv pname lhs_exp prop_ in let n_lhs_exp, prop_' = check_arith_norm_exp tenv pname lhs_exp prop_ in
let n_rhs_exp, prop = check_arith_norm_exp tenv pname rhs_exp prop_' in let n_rhs_exp, prop = check_arith_norm_exp tenv pname rhs_exp prop_' in
let prop = Attribute.replace_objc_null tenv prop n_lhs_exp n_rhs_exp in let prop = Attribute.replace_objc_null tenv prop n_lhs_exp n_rhs_exp in
let n_lhs_exp' = Prop.exp_collapse_consecutive_indices_prop typ n_lhs_exp in let n_lhs_exp' = Prop.exp_collapse_consecutive_indices_prop typ n_lhs_exp in
let iter_list = Rearrange.rearrange ~report_deref_errors pdesc tenv n_lhs_exp' typ prop loc in let iter_list = Rearrange.rearrange ~report_deref_errors pdesc tenv n_lhs_exp' typ prop loc in
IList.rev (IList.fold_left (execute_store_ pdesc tenv n_rhs_exp) [] iter_list) IList.rev (List.fold ~f:(execute_store_ pdesc tenv n_rhs_exp) ~init:[] iter_list)
with Rearrange.ARRAY_ACCESS -> with Rearrange.ARRAY_ACCESS ->
if Int.equal Config.array_level 0 then assert false if Int.equal Config.array_level 0 then assert false
else [prop_] else [prop_]
@ -1128,7 +1128,10 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
| Some callee_summary -> | Some callee_summary ->
let handled_args = call_args norm_prop pname url_handled_args ret_id loc in let handled_args = call_args norm_prop pname url_handled_args ret_id loc in
proc_call callee_summary handled_args in proc_call callee_summary handled_args in
IList.fold_left (fun acc pname -> exec_one_pname pname @ acc) [] resolved_pnames List.fold
~f:(fun acc pname -> exec_one_pname pname @ acc)
~init:[]
resolved_pnames
| _ -> (* Generic fun call with known name *) | _ -> (* Generic fun call with known name *)
let (prop_r, n_actual_params) = let (prop_r, n_actual_params) =
normalize_params tenv current_pname prop_ actual_params in normalize_params tenv current_pname prop_ actual_params in
@ -1269,7 +1272,7 @@ and instrs ?(mask_errors=false) tenv pdesc instrs ppl =
(Localise.to_string err_name)^loc ); L.d_ln(); (Localise.to_string err_name)^loc ); L.d_ln();
[(p, path)] in [(p, path)] in
let f plist instr = List.concat (IList.map (exe_instr instr) plist) in let f plist instr = List.concat (IList.map (exe_instr instr) plist) in
IList.fold_left f ppl instrs List.fold ~f ~init:ppl instrs
and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname callee_loc = and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname callee_loc =
(* replace an hpred of the form actual_var |-> _ with new_hpred in prop *) (* replace an hpred of the form actual_var |-> _ with new_hpred in prop *)
@ -1332,14 +1335,14 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call
| _ -> true) | _ -> true)
prop.Prop.sigma in prop.Prop.sigma in
Prop.normalize tenv (Prop.set prop ~sigma:filtered_sigma) in Prop.normalize tenv (Prop.set prop ~sigma:filtered_sigma) in
IList.fold_left List.fold
(fun p hpred -> ~f:(fun p hpred ->
match hpred with match hpred with
| Sil.Hpointsto (Exp.Lvar pv, rhs, texp) when Pvar.equal pv abduced_ref_pv -> | Sil.Hpointsto (Exp.Lvar pv, rhs, texp) when Pvar.equal pv abduced_ref_pv ->
let new_hpred = Sil.Hpointsto (actual, rhs, texp) in let new_hpred = Sil.Hpointsto (actual, rhs, texp) in
Prop.normalize tenv (Prop.set p ~sigma:(new_hpred :: prop'.Prop.sigma)) Prop.normalize tenv (Prop.set p ~sigma:(new_hpred :: prop'.Prop.sigma))
| _ -> p) | _ -> p)
prop' ~init:prop'
prop'.Prop.sigma prop'.Prop.sigma
| _ -> assert false in | _ -> assert false in
(* non-angelic mode; havoc each var passed by reference by assigning it to a fresh id *) (* non-angelic mode; havoc each var passed by reference by assigning it to a fresh id *)
@ -1366,7 +1369,7 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call
| None -> | None ->
true in true in
List.filter ~f:is_not_const actuals_by_ref in List.filter ~f:is_not_const actuals_by_ref in
IList.fold_left do_actual_by_ref prop non_const_actuals_by_ref List.fold ~f:do_actual_by_ref ~init:prop non_const_actuals_by_ref
and check_untainted tenv exp taint_kind caller_pname callee_pname prop = and check_untainted tenv exp taint_kind caller_pname callee_pname prop =
match Attribute.get_taint tenv prop exp with match Attribute.get_taint tenv prop exp with
@ -1400,14 +1403,14 @@ and unknown_or_scan_call ~is_scan ret_type_option ret_annots
match atom with match atom with
| Sil.Apred ((Aresource {ra_res = Rfile} as res), _) -> Attribute.remove_for_attr tenv q res | Sil.Apred ((Aresource {ra_res = Rfile} as res), _) -> Attribute.remove_for_attr tenv q res
| _ -> q in | _ -> q in
IList.fold_left do_attribute p (Attribute.get_for_exp tenv p e) in List.fold ~f:do_attribute ~init:p (Attribute.get_for_exp tenv p e) in
let filtered_args = let filtered_args =
match args, instr with match args, instr with
| _:: other_args, Sil.Call (_, _, _, _, { CallFlags.cf_virtual }) when cf_virtual -> | _:: other_args, Sil.Call (_, _, _, _, { CallFlags.cf_virtual }) when cf_virtual ->
(* Do not remove the file attribute on the reciver for virtual calls *) (* Do not remove the file attribute on the reciver for virtual calls *)
other_args other_args
| _ -> args in | _ -> args in
IList.fold_left do_exp prop filtered_args in List.fold ~f:do_exp ~init:prop filtered_args in
let add_tainted_pre prop actuals caller_pname callee_pname = let add_tainted_pre prop actuals caller_pname callee_pname =
if Config.taint_analysis then if Config.taint_analysis then
match Taint.accepts_sensitive_params callee_pname None with match Taint.accepts_sensitive_params callee_pname None with
@ -1420,9 +1423,9 @@ and unknown_or_scan_call ~is_scan ret_type_option ret_annots
check_untainted tenv actual_exp taint_kind caller_pname callee_pname prop_acc check_untainted tenv actual_exp taint_kind caller_pname callee_pname prop_acc
| None -> prop_acc in | None -> prop_acc in
prop_acc', param_num + 1 in prop_acc', param_num + 1 in
IList.fold_left List.fold
check_taint_if_nums_match ~f:check_taint_if_nums_match
(prop, 0) ~init:(prop, 0)
actuals actuals
|> fst |> fst
else prop in else prop in
@ -1455,8 +1458,10 @@ and unknown_or_scan_call ~is_scan ret_type_option ret_annots
(* otherwise, add undefined attribute to retvals and actuals passed by ref *) (* otherwise, add undefined attribute to retvals and actuals passed by ref *)
let exps_to_mark = let exps_to_mark =
let ret_exps = Option.value_map ~f:(fun (id, _) -> [Exp.Var id]) ~default:[] ret_id in let ret_exps = Option.value_map ~f:(fun (id, _) -> [Exp.Var id]) ~default:[] ret_id in
IList.fold_left List.fold
(fun exps_to_mark (exp, _, _) -> exp :: exps_to_mark) ret_exps actuals_by_ref in ~f:(fun exps_to_mark (exp, _, _) -> exp :: exps_to_mark)
~init:ret_exps
actuals_by_ref in
let prop_with_undef_attr = let prop_with_undef_attr =
let path_pos = State.get_path_pos () in let path_pos = State.get_path_pos () in
Attribute.mark_vars_as_undefined tenv Attribute.mark_vars_as_undefined tenv
@ -1479,8 +1484,8 @@ and check_variadic_sentinel
let mk_non_terminal_argsi (acc, i) a = let mk_non_terminal_argsi (acc, i) a =
if i < first_var_arg_pos || i >= sentinel_pos then (acc, i +1) if i < first_var_arg_pos || i >= sentinel_pos then (acc, i +1)
else ((a, i):: acc, i +1) in else ((a, i):: acc, i +1) in
(* IList.fold_left reverses the arguments *) (* fold_left reverses the arguments *)
let non_terminal_argsi = fst (IList.fold_left mk_non_terminal_argsi ([], 0) args) in let non_terminal_argsi = fst (List.fold ~f:mk_non_terminal_argsi ~init:([], 0) args) in
let check_allocated result ((lexp, typ), i) = let check_allocated result ((lexp, typ), i) =
(* simulate a Load for [lexp] *) (* simulate a Load for [lexp] *)
let tmp_id_deref = Ident.create_fresh Ident.kprimed in let tmp_id_deref = Ident.create_fresh Ident.kprimed in
@ -1496,9 +1501,9 @@ and check_variadic_sentinel
raise (Exceptions.Premature_nil_termination (err_desc, __POS__)) raise (Exceptions.Premature_nil_termination (err_desc, __POS__))
else else
raise e in raise e in
(* IList.fold_left reverses the arguments back so that we report an *) (* fold_left reverses the arguments back so that we report an *)
(* error on the first premature nil argument *) (* error on the first premature nil argument *)
IList.fold_left check_allocated [(prop_, path)] non_terminal_argsi List.fold ~f:check_allocated ~init:[(prop_, path)] non_terminal_argsi
and check_variadic_sentinel_if_present and check_variadic_sentinel_if_present
({ Builtin.prop_; path; proc_name; } as builtin_args) = ({ Builtin.prop_; path; proc_name; } as builtin_args) =
@ -1694,4 +1699,4 @@ let node handle_exn tenv pdesc node (pset : Paths.PathSet.t) : Paths.PathSet.t =
Paths.PathSet.union pset2 pset1 in Paths.PathSet.union pset2 pset1 in
let exe_instr_pset pset instr = let exe_instr_pset pset instr =
Paths.PathSet.fold (exe_instr_prop instr) pset Paths.PathSet.empty in Paths.PathSet.fold (exe_instr_prop instr) pset Paths.PathSet.empty in
IList.fold_left exe_instr_pset pset (Procdesc.Node.get_instrs node) List.fold ~f:exe_instr_pset ~init:pset (Procdesc.Node.get_instrs node)

@ -329,10 +329,13 @@ let check_dereferences tenv callee_pname actual_pre sub spec_pre formal_params =
| Sil.Hpointsto (lexp, se, _) -> | Sil.Hpointsto (lexp, se, _) ->
check_dereference (Exp.root_of_lexp lexp) se check_dereference (Exp.root_of_lexp lexp) se
| _ -> None in | _ -> None in
let deref_err_list = IList.fold_left (fun deref_errs hpred -> match check_hpred hpred with let deref_err_list =
List.fold
~f:(fun deref_errs hpred -> match check_hpred hpred with
| Some reason -> reason :: deref_errs | Some reason -> reason :: deref_errs
| None -> deref_errs | None -> deref_errs)
) [] spec_pre.Prop.sigma in ~init:[]
spec_pre.Prop.sigma in
match deref_err_list with match deref_err_list with
| [] -> None | [] -> None
| deref_err :: _ -> | deref_err :: _ ->
@ -610,7 +613,7 @@ let prop_copy_footprint_pure tenv p1 p2 =
Attribute.add_or_replace_check_changed tenv check_attr_dealloc_mismatch prop atom Attribute.add_or_replace_check_changed tenv check_attr_dealloc_mismatch prop atom
else else
prop in prop in
IList.fold_left replace_attr (Prop.normalize tenv res_noattr) pi2_attr List.fold ~f:replace_attr ~init:(Prop.normalize tenv res_noattr) pi2_attr
(** check if an expression is an exception *) (** check if an expression is an exception *)
let exp_is_exn = function let exp_is_exn = function
@ -807,11 +810,11 @@ let mk_pre tenv pre formal_params callee_pname callee_attrs =
| [] -> pre | [] -> pre
| tainted_param_nums -> | tainted_param_nums ->
Taint.get_params_to_taint tainted_param_nums formal_params Taint.get_params_to_taint tainted_param_nums formal_params
|> IList.fold_left |> List.fold
(fun prop_acc (param, taint_kind) -> ~f:(fun prop_acc (param, taint_kind) ->
let attr = PredSymb.Auntaint { taint_source = callee_pname; taint_kind; } in let attr = PredSymb.Auntaint { taint_source = callee_pname; taint_kind; } in
Taint.add_tainting_attribute tenv attr param prop_acc) Taint.add_tainting_attribute tenv attr param prop_acc)
(Prop.normalize tenv pre) ~init:(Prop.normalize tenv pre)
|> Prop.expose |> Prop.expose
else pre else pre
@ -933,7 +936,7 @@ let inconsistent_actualpre_missing tenv actual_pre split_opt =
match split_opt with match split_opt with
| Some split -> | Some split ->
let prop'= Prop.normalize tenv (Prop.prop_sigma_star actual_pre split.missing_sigma) in let prop'= Prop.normalize tenv (Prop.prop_sigma_star actual_pre split.missing_sigma) in
let prop''= IList.fold_left (Prop.prop_atom_and tenv) prop' split.missing_pi in let prop''= List.fold ~f:(Prop.prop_atom_and tenv) ~init:prop' split.missing_pi in
Prover.check_inconsistency tenv prop'' Prover.check_inconsistency tenv prop''
| None -> false | None -> false
@ -956,9 +959,9 @@ let do_taint_check tenv caller_pname callee_pname calling_prop missing_pi sub ac
Exp.Map.add e (taint_atoms, atom :: untaint_atoms) acc_map Exp.Map.add e (taint_atoms, atom :: untaint_atoms) acc_map
| _ -> acc_map in | _ -> acc_map in
let taint_untaint_exp_map = let taint_untaint_exp_map =
IList.fold_left List.fold
collect_taint_untaint_exprs ~f:collect_taint_untaint_exprs
Exp.Map.empty ~init:Exp.Map.empty
combined_pi combined_pi
|> Exp.Map.filter (fun _ (taint, untaint) -> taint <> [] && untaint <> []) in |> Exp.Map.filter (fun _ (taint, untaint) -> taint <> [] && untaint <> []) in
(* TODO: in the future, we will have a richer taint domain that will require making sure that the (* TODO: in the future, we will have a richer taint domain that will require making sure that the

@ -336,7 +336,7 @@ let accepts_sensitive_params callee_pname callee_attrs_opt =
else if Annotations.ia_is_privacy_sink attr else if Annotations.ia_is_privacy_sink attr
then (index, PredSymb.Tk_privacy_annotation) :: acc then (index, PredSymb.Tk_privacy_annotation) :: acc
else acc in else acc in
IList.fold_left tag_tainted_indices [] indices_and_annots List.fold ~f:tag_tainted_indices ~init:[] indices_and_annots
| Some (taint_info, tainted_param_indices) -> | Some (taint_info, tainted_param_indices) ->
IList.map (fun param_num -> param_num, taint_info.PredSymb.taint_kind) tainted_param_indices IList.map (fun param_num -> param_num, taint_info.PredSymb.taint_kind) tainted_param_indices
@ -364,12 +364,12 @@ let get_params_to_taint tainted_param_nums formal_params =
| Some (_, taint_kind) -> (param, taint_kind) :: params_to_taint_acc | Some (_, taint_kind) -> (param, taint_kind) :: params_to_taint_acc
| None -> params_to_taint_acc in | None -> params_to_taint_acc in
let numbered_params = IList.mapi (fun i param -> (i, param)) formal_params in let numbered_params = IList.mapi (fun i param -> (i, param)) formal_params in
IList.fold_left collect_params_to_taint [] numbered_params List.fold ~f:collect_params_to_taint ~init:[] numbered_params
(* add tainting attribute to a pvar in a prop *) (* add tainting attribute to a pvar in a prop *)
let add_tainting_attribute tenv att pvar_param prop = let add_tainting_attribute tenv att pvar_param prop =
IList.fold_left List.fold
(fun prop_acc hpred -> ~f:(fun prop_acc hpred ->
match hpred with match hpred with
| Sil.Hpointsto (Exp.Lvar pvar, (Sil.Eexp (rhs, _)), _) | Sil.Hpointsto (Exp.Lvar pvar, (Sil.Eexp (rhs, _)), _)
when Pvar.equal pvar pvar_param -> when Pvar.equal pvar pvar_param ->
@ -377,4 +377,5 @@ let add_tainting_attribute tenv att pvar_param prop =
(Pvar.to_string pvar)); (Pvar.to_string pvar));
Attribute.add_or_replace tenv prop_acc (Apred (att, [rhs])) Attribute.add_or_replace tenv prop_acc (Apred (att, [rhs]))
| _ -> prop_acc) | _ -> prop_acc)
prop prop.Prop.sigma ~init:prop
prop.Prop.sigma

@ -155,7 +155,8 @@ let wrap_line indent_string wrap_length line =
(new_line::rev_lines, false, indent_string, indent_length) (new_line::rev_lines, false, indent_string, indent_length)
else else
(rev_lines, new_non_empty, new_line, String.length new_line) in (rev_lines, new_non_empty, new_line, String.length new_line) in
let (rev_lines, _, line, _) = IList.fold_left add_word_to_paragraph ([], false, "", 0) words in let (rev_lines, _, line, _) =
List.fold ~f:add_word_to_paragraph ~init:([], false, "", 0) words in
IList.rev (line::rev_lines) IList.rev (line::rev_lines)
let pad_and_xform doc_width left_width desc = let pad_and_xform doc_width left_width desc =
@ -205,7 +206,8 @@ let align desc_list =
NOTE: this doesn't take into account "--help | -h" nor "--help-full", but fortunately these NOTE: this doesn't take into account "--help | -h" nor "--help-full", but fortunately these
have short names *) have short names *)
let left_width = let left_width =
let opt_left_width = IList.fold_left (max_left_length max_left_width) 0 desc_list in let opt_left_width =
List.fold ~f:(max_left_length max_left_width) ~init:0 desc_list in
let (--) a b = float_of_int a -. float_of_int b in let (--) a b = float_of_int a -. float_of_int b in
let multiplier = (max_left_width -- min_left_width) /. (max_term_width -- min_term_width) in let multiplier = (max_left_width -- min_left_width) /. (max_term_width -- min_term_width) in
(* at 80 columns use min_left_width then use extra columns until opt_left_width *) (* at 80 columns use min_left_width then use extra columns until opt_left_width *)
@ -701,7 +703,7 @@ let decode_inferconfig_to_argv path =
warnf "WARNING: while reading config file %s:@\nIll-formed value %s for option %s: %s@." warnf "WARNING: while reading config file %s:@\nIll-formed value %s for option %s: %s@."
path (Yojson.Basic.to_string json) key msg ; path (Yojson.Basic.to_string json) key msg ;
result in result in
IList.fold_left one_config_item [] json_config List.fold ~f:one_config_item ~init:[] json_config
(** separator of argv elements when encoded into environment variables *) (** separator of argv elements when encoded into environment variables *)

@ -1675,7 +1675,7 @@ let specs_library =
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
IList.fold_left add_spec_lib [] !specs_library List.fold ~f:add_spec_lib ~init:[] !specs_library
| _ -> | _ ->
!specs_library !specs_library

@ -9,7 +9,6 @@
let exists = List.exists let exists = List.exists
let fold_left = List.fold_left let fold_left = List.fold_left
let fold_left2 = List.fold_left2
let for_all = List.for_all let for_all = List.for_all
let for_all2 = List.for_all2 let for_all2 = List.for_all2
let iter = List.iter let iter = List.iter
@ -29,16 +28,6 @@ let rec last = function
| [x] -> Some x | [x] -> Some x
| _ :: xs -> last xs | _ :: xs -> last xs
(** tail-recursive variant of List.fold_right *)
let fold_right f l a =
let g x y = f y x in
fold_left g a (rev l)
(** fold_left with indices *)
let fold_lefti (f : 'a -> int -> 'b -> 'a) a l =
fold_left (fun (i, acc) e -> i +1, f acc i e) (0, a) l
|> snd
let flatten_options list = let flatten_options list =
fold_left (fun list -> function | Some x -> x:: list | None -> list) [] list fold_left (fun list -> function | Some x -> x:: list | None -> list) [] list
|> rev |> rev

@ -10,8 +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 fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a
val for_all : ('a -> bool) -> 'a list -> bool val for_all : ('a -> bool) -> 'a list -> bool
val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
val iter : ('a -> unit) -> 'a list -> unit val iter : ('a -> unit) -> 'a list -> unit
@ -19,12 +17,6 @@ val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit
val iteri : (int -> 'a -> unit) -> 'a 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.fold_right *)
val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
(** fold_left with indices *)
val fold_lefti : ('a -> int -> 'b -> 'a) -> 'a -> 'b list -> 'a
(** tail-recursive variant of List.map *) (** tail-recursive variant of List.map *)
val map : ('a -> 'b) -> 'a list -> 'b list val map : ('a -> 'b) -> 'a list -> 'b list

@ -142,8 +142,8 @@ let changed_files_set =
from_abs_path path in from_abs_path path in
Option.bind Config.changed_files_index Utils.read_file |> Option.bind Config.changed_files_index Utils.read_file |>
Option.map ~f:( Option.map ~f:(
IList.fold_left List.fold
(fun changed_files line -> ~f:(fun changed_files line ->
let source_file = create_source_file line in let source_file = create_source_file line in
let changed_files' = Set.add source_file changed_files in let changed_files' = Set.add source_file changed_files in
(* Add source corresponding to changed header if it exists *) (* Add source corresponding to changed header if it exists *)
@ -151,5 +151,5 @@ let changed_files_set =
| Some src -> Set.add src changed_files' | Some src -> Set.add src changed_files'
| None -> changed_files' | None -> changed_files'
) )
Set.empty ~init:Set.empty
) )

@ -47,7 +47,7 @@ let from_json json => {
let compute_statistics values => { let compute_statistics values => {
let num_elements = IList.length values; let num_elements = IList.length values;
let sum = IList.fold_left (fun acc v => acc +. v) 0.0 values; let sum = List.fold f::(fun acc v => acc +. v) init::0.0 values;
let average = sum /. float_of_int num_elements; let average = sum /. float_of_int num_elements;
let values_arr = Array.of_list values; let values_arr = Array.of_list values;
Array.sort Array.sort

@ -117,7 +117,7 @@ let filename_to_absolute ~root fname =
| _ -> entry :: rev_done | _ -> entry :: rev_done
in in
let abs_fname = if Filename.is_absolute fname then fname else root ^/ fname in let abs_fname = if Filename.is_absolute fname then fname else root ^/ fname in
Filename.of_parts (List.rev (List.fold_left ~f:add_entry ~init:[] (Filename.parts abs_fname))) Filename.of_parts (List.rev (List.fold ~f:add_entry ~init:[] (Filename.parts abs_fname)))
(** Convert an absolute filename to one relative to the given directory. *) (** Convert an absolute filename to one relative to the given directory. *)

@ -78,7 +78,7 @@ let zip_libraries =
else else
(* fname is a dir of specs *) (* fname is a dir of specs *)
zip_libs in zip_libs in
IList.fold_left add_zip [] Config.specs_library in List.fold ~f:add_zip ~init:[] Config.specs_library in
if Config.checkers then if Config.checkers then
zip_libs zip_libs
else if (Sys.file_exists Config.models_jar) = `Yes then else if (Sys.file_exists Config.models_jar) = `Yes then

@ -161,7 +161,7 @@ struct
| Typ.Tstruct typename -> | Typ.Tstruct typename ->
(match Tenv.lookup tenv typename with (match Tenv.lookup tenv typename with
| Some str -> | Some str ->
IList.fold_left decl_fld (mem, sym_num + 6) str.StructTyp.fields List.fold ~f:decl_fld ~init:(mem, sym_num + 6) str.StructTyp.fields
| _ -> (mem, sym_num + 6)) | _ -> (mem, sym_num + 6))
| _ -> (mem, sym_num + 6) | _ -> (mem, sym_num + 6)
@ -183,7 +183,7 @@ struct
(mem, inst_num + 1, sym_num) (mem, inst_num + 1, sym_num)
| _ -> (mem, inst_num, sym_num) (* TODO: add other cases if necessary *) | _ -> (mem, inst_num, sym_num) (* TODO: add other cases if necessary *)
in in
IList.fold_left add_formal (mem, inst_num, 0) (Sem.get_formals pdesc) List.fold ~f:add_formal ~init:(mem, inst_num, 0) (Sem.get_formals pdesc)
|> fst3 |> fst3
let instantiate_ret let instantiate_ret
@ -260,7 +260,7 @@ struct
handle_unknown_call pname ret callee_pname params node mem loc) handle_unknown_call pname ret callee_pname params node mem loc)
| Declare_locals (locals, _) -> | Declare_locals (locals, _) ->
(* array allocation in stack e.g., int arr[10] *) (* array allocation in stack e.g., int arr[10] *)
let (mem, inst_num) = IList.fold_left try_decl_arr (mem, 1) locals in let (mem, inst_num) = List.fold ~f:try_decl_arr ~init:(mem, 1) locals in
declare_symbolic_parameter pdesc tenv node inst_num mem declare_symbolic_parameter pdesc tenv node inst_num mem
| Call _ | Call _
| Remove_temps _ | Remove_temps _
@ -373,7 +373,7 @@ struct
: extras ProcData.t -> CFG.node -> Sil.instr list -> Dom.Mem.t : extras ProcData.t -> CFG.node -> Sil.instr list -> Dom.Mem.t
-> Dom.ConditionSet.t -> Dom.ConditionSet.t -> Dom.ConditionSet.t -> Dom.ConditionSet.t
= fun pdata node instrs mem cond_set -> = fun pdata node instrs mem cond_set ->
IList.fold_left (collect_instr pdata node) (cond_set, mem) instrs List.fold ~f:(collect_instr pdata node) ~init:(cond_set, mem) instrs
|> fst |> fst
let collect_node let collect_node

@ -299,7 +299,7 @@ struct
(match Tenv.lookup tenv typename with (match Tenv.lookup tenv typename with
| Some str -> | Some str ->
let fns = IList.map get_field_name str.StructTyp.fields in let fns = IList.map get_field_name str.StructTyp.fields in
IList.fold_left (add_pair_field v1 v2) pairs fns List.fold ~f:(add_pair_field v1 v2) ~init:pairs fns
| _ -> pairs) | _ -> pairs)
| Typ.Tptr (_ ,_) -> | Typ.Tptr (_ ,_) ->
let v1' = deref_ptr v1 callee_mem in let v1' = deref_ptr v1 callee_mem in
@ -321,13 +321,13 @@ struct
else assert false else assert false
| _ -> assert false | _ -> assert false
in in
IList.fold_left add_pair Itv.SubstMap.empty pairs List.fold ~f:add_pair ~init:Itv.SubstMap.empty pairs
let rec list_fold2_def let rec list_fold2_def
: Val.t -> ('a -> Val.t -> 'b -> 'b) -> 'a list -> Val.t list -> 'b -> 'b : Val.t -> ('a -> Val.t -> 'b -> 'b) -> 'a list -> Val.t list -> 'b -> 'b
= fun default f xs ys acc -> = fun default f xs ys acc ->
match xs, ys with match xs, ys with
| [x], _ -> f x (IList.fold_left Val.join Val.bot ys) acc | [x], _ -> f x (List.fold ~f:Val.join ~init:Val.bot ys) acc
| [], _ -> acc | [], _ -> acc
| x :: xs', [] -> list_fold2_def default f xs' ys (f x default acc) | x :: xs', [] -> list_fold2_def default f xs' ys (f x default acc)
| x :: xs', y :: ys' -> list_fold2_def default f xs' ys' (f x y acc) | x :: xs', y :: ys' -> list_fold2_def default f xs' ys' (f x y acc)

@ -83,7 +83,8 @@ module MakeNoCFG
| l -> l in | l -> l in
let underlying_node = CFG.underlying_node node in let underlying_node = CFG.underlying_node node in
NodePrinter.start_session underlying_node; NodePrinter.start_session underlying_node;
let astate_post, inv_map_post = IList.fold_left compute_post (pre, inv_map) instr_ids in let astate_post, inv_map_post =
List.fold ~f:compute_post ~init:(pre, inv_map) instr_ids in
if Config.write_html if Config.write_html
then then
begin begin
@ -120,9 +121,10 @@ module MakeNoCFG
let normal_posts = IList.map extract_post_ (CFG.normal_preds cfg node) in let normal_posts = IList.map extract_post_ (CFG.normal_preds cfg node) in
(* if the [pred] -> [node] transition was exceptional, use pre([pred]) *) (* if the [pred] -> [node] transition was exceptional, use pre([pred]) *)
let extract_pre_f acc pred = extract_pre (CFG.id pred) inv_map :: acc in let extract_pre_f acc pred = extract_pre (CFG.id pred) inv_map :: acc in
let all_posts = IList.fold_left extract_pre_f normal_posts (CFG.exceptional_preds cfg node) in let all_posts =
List.fold ~f:extract_pre_f ~init:normal_posts (CFG.exceptional_preds cfg node) in
match IList.flatten_options all_posts with match IList.flatten_options all_posts with
| post :: posts -> Some (IList.fold_left Domain.join post posts) | post :: posts -> Some (List.fold ~f:Domain.join ~init:post posts)
| [] -> None in | [] -> None in
match Scheduler.pop work_queue with match Scheduler.pop work_queue with
| Some (_, [], work_queue') -> | Some (_, [], work_queue') ->

@ -23,9 +23,9 @@ let make pdesc =
let pvar = Pvar.mk name pname in let pvar = Pvar.mk name pname in
AccessPath.base_of_pvar pvar typ, index) AccessPath.base_of_pvar pvar typ, index)
attrs.ProcAttributes.formals in attrs.ProcAttributes.formals in
IList.fold_left List.fold
(fun formal_map (base, index) -> AccessPath.BaseMap.add base index formal_map) ~f:(fun formal_map (base, index) -> AccessPath.BaseMap.add base index formal_map)
AccessPath.BaseMap.empty ~init:AccessPath.BaseMap.empty
formals_with_nums formals_with_nums
let empty = AccessPath.BaseMap.empty let empty = AccessPath.BaseMap.empty

@ -59,11 +59,11 @@ module Make (TraceElem : TraceElem.S) = struct
to_loc_trace ?desc_of_sink ?sink_should_nest (passthroughs, [], sinks) to_loc_trace ?desc_of_sink ?sink_should_nest (passthroughs, [], sinks)
let with_callsite t call_site = let with_callsite t call_site =
IList.fold_left List.fold
(fun t_acc sink -> ~f:(fun t_acc sink ->
let callee_sink = Sink.with_callsite sink call_site in let callee_sink = Sink.with_callsite sink call_site in
add_sink callee_sink t_acc) add_sink callee_sink t_acc)
empty ~init:empty
(Sinks.elements (sinks t)) (Sinks.elements (sinks t))
let pp fmt t = let pp fmt t =

@ -109,7 +109,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let add_params_globals astate pdesc call_loc params = let add_params_globals astate pdesc call_loc params =
IList.map (fun (e, _) -> get_globals pdesc call_loc e) params IList.map (fun (e, _) -> get_globals pdesc call_loc e) params
|> IList.fold_left GlobalsAccesses.union GlobalsAccesses.empty |> List.fold ~f:GlobalsAccesses.union ~init:GlobalsAccesses.empty
|> add_globals astate (Procdesc.get_loc pdesc) |> add_globals astate (Procdesc.get_loc pdesc)
let at_least_nonbottom = let at_least_nonbottom =

@ -31,7 +31,9 @@ let normalize ((trace, initialized) as astate) = match trace with
let loc = CallSite.loc (SiofTrace.Sink.call_site access) in let loc = CallSite.loc (SiofTrace.Sink.call_site access) in
let kind = let kind =
IList.map SiofTrace.Sink.kind direct IList.map SiofTrace.Sink.kind direct
|> IList.fold_left SiofTrace.GlobalsAccesses.union SiofTrace.GlobalsAccesses.empty in |> List.fold
~f:SiofTrace.GlobalsAccesses.union
~init:SiofTrace.GlobalsAccesses.empty in
let trace' = let trace' =
SiofTrace.make_access kind loc::indirect SiofTrace.make_access kind loc::indirect
|> SiofTrace.Sinks.of_list |> SiofTrace.Sinks.of_list

@ -93,7 +93,7 @@ let trace_of_error loc gname path =
[] []
::err_trace in ::err_trace in
GlobalsAccesses.elements globals GlobalsAccesses.elements globals
|> IList.fold_left add_trace_elem_of_access rest |> List.fold ~f:add_trace_elem_of_access ~init:rest
|> IList.rev |> IList.rev
| _ -> trace_with_set_of_globals | _ -> trace_with_set_of_globals
in in

@ -173,13 +173,13 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
then then
path_state path_state
else else
IList.fold_left List.fold
(fun acc rawpath -> ~f:(fun acc rawpath ->
if not (is_owned (AccessPath.Raw.truncate rawpath) attribute_map) && if not (is_owned (AccessPath.Raw.truncate rawpath) attribute_map) &&
not (is_safe_write rawpath tenv) not (is_safe_write rawpath tenv)
then Domain.PathDomain.add_sink (Domain.make_access rawpath loc) acc then Domain.PathDomain.add_sink (Domain.make_access rawpath loc) acc
else acc) else acc)
path_state ~init:path_state
(AccessPath.of_exp exp typ ~f_resolve_id) (AccessPath.of_exp exp typ ~f_resolve_id)
let analyze_id_assignment lhs_id rhs_exp rhs_typ { Domain.id_map; } = let analyze_id_assignment lhs_id rhs_exp rhs_typ { Domain.id_map; } =
@ -365,7 +365,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
(* add the conditional writes rooted in the callee formal at [index] to (* add the conditional writes rooted in the callee formal at [index] to
the current state *) the current state *)
let add_conditional_writes let add_conditional_writes
((cond_writes, uncond_writes) as acc) index (actual_exp, actual_typ) = index ((cond_writes, uncond_writes) as acc) (actual_exp, actual_typ) =
if is_constant actual_exp if is_constant actual_exp
then then
acc acc
@ -419,9 +419,9 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let combined_unconditional_writes = let combined_unconditional_writes =
PathDomain.with_callsite callee_unconditional_writes call_site PathDomain.with_callsite callee_unconditional_writes call_site
|> PathDomain.join astate.unconditional_writes in |> PathDomain.join astate.unconditional_writes in
IList.fold_lefti List.foldi
add_conditional_writes ~f:add_conditional_writes
(astate.conditional_writes, combined_unconditional_writes) ~init:(astate.conditional_writes, combined_unconditional_writes)
actuals in actuals in
let reads = let reads =
PathDomain.with_callsite callee_reads call_site PathDomain.with_callsite callee_reads call_site
@ -572,9 +572,9 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
| Sil.Remove_temps (ids, _) -> | Sil.Remove_temps (ids, _) ->
let id_map = let id_map =
IList.fold_left List.fold
(fun acc id -> IdAccessPathMapDomain.remove (Var.of_id id) acc) ~f:(fun acc id -> IdAccessPathMapDomain.remove (Var.of_id id) acc)
astate.id_map ~init:astate.id_map
ids in ids in
{ astate with id_map; } { astate with id_map; }
@ -675,9 +675,10 @@ let should_report_on_proc (_, _, proc_name, proc_desc) =
let make_results_table get_proc_desc file_env = let make_results_table get_proc_desc file_env =
(* make a Map sending each element e of list l to (f e) *) (* make a Map sending each element e of list l to (f e) *)
let map_post_computation_over_procs f l = let map_post_computation_over_procs f l =
IList.fold_left (fun m p -> ResultsTableType.add p (f p) m List.fold
) ResultsTableType.empty l ~f:(fun m p -> ResultsTableType.add p (f p) m)
in ~init:ResultsTableType.empty
l in
let is_initializer tenv proc_name = let is_initializer tenv proc_name =
Procname.is_constructor proc_name || FbThreadSafety.is_custom_init tenv proc_name in Procname.is_constructor proc_name || FbThreadSafety.is_custom_init tenv proc_name in
let compute_post_for_procedure = (* takes proc_env as arg *) let compute_post_for_procedure = (* takes proc_env as arg *)

@ -290,7 +290,7 @@ module Make (Spec : Spec) = struct
let loc2 = CallSite.loc (Passthrough.site passthrough2) in let loc2 = CallSite.loc (Passthrough.site passthrough2) in
Int.compare loc1.Location.line loc2.Location.line) Int.compare loc1.Location.line loc2.Location.line)
(Passthroughs.elements passthroughs) in (Passthroughs.elements passthroughs) in
IList.fold_right trace_elem_of_passthrough sorted_passthroughs acc0 in List.fold_right ~f:trace_elem_of_passthrough sorted_passthroughs ~init:acc0 in
let get_nesting should_nest elems start_nesting = let get_nesting should_nest elems start_nesting =
let level = ref start_nesting in let level = ref start_nesting in
@ -318,10 +318,12 @@ module Make (Spec : Spec) = struct
let sources_with_level = get_nesting source_should_nest sources (-1) in let sources_with_level = get_nesting source_should_nest sources (-1) in
let sinks_with_level = get_nesting sink_should_nest sinks 0 in let sinks_with_level = get_nesting sink_should_nest sinks 0 in
let trace_prefix = let trace_prefix =
IList.fold_right trace_elems_of_sink sinks_with_level [] List.fold_right ~f:trace_elems_of_sink sinks_with_level ~init:[]
|> trace_elems_of_passthroughs 0 passthroughs in |> trace_elems_of_passthroughs 0 passthroughs in
IList.fold_left List.fold
(fun acc source -> trace_elems_of_source source acc) trace_prefix sources_with_level ~f:(fun acc source -> trace_elems_of_source source acc)
~init:trace_prefix
sources_with_level
let of_source source = let of_source source =
let sources = Sources.singleton source in let sources = Sources.singleton source in

@ -37,7 +37,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let add_actual_by_ref astate_acc = function let add_actual_by_ref astate_acc = function
| actual_exp, Typ.Tptr _ -> add_address_taken_pvars actual_exp astate_acc | actual_exp, Typ.Tptr _ -> add_address_taken_pvars actual_exp astate_acc
| _ -> astate_acc in | _ -> astate_acc in
IList.fold_left add_actual_by_ref astate actuals List.fold ~f:add_actual_by_ref ~init:astate actuals
| Sil.Store _ | Load _ | Prune _ | Nullify _ | Abstract _ | Remove_temps _ | Sil.Store _ | Load _ | Prune _ | Nullify _ | Abstract _ | Remove_temps _
| Declare_locals _ -> | Declare_locals _ ->
astate astate

@ -229,13 +229,14 @@ let report_call_stack end_of_stack lookup_next_calls report call_site calls =
let new_stack_str = stack_str ^ callee_pname_str ^ " -> " in let new_stack_str = stack_str ^ callee_pname_str ^ " -> " in
let new_trace = update_trace call_loc trace |> update_trace callee_def_loc in let new_trace = update_trace call_loc trace |> update_trace callee_def_loc in
let unseen_pnames, updated_visited = let unseen_pnames, updated_visited =
IList.fold_left List.fold
(fun (accu, set) call_site -> ~f:(fun (accu, set) call_site ->
let p = CallSite.pname call_site in let p = CallSite.pname call_site in
let loc = CallSite.loc call_site in let loc = CallSite.loc call_site in
if Procname.Set.mem p set then (accu, set) if Procname.Set.mem p set then (accu, set)
else ((p, loc) :: accu, Procname.Set.add p set)) else ((p, loc) :: accu, Procname.Set.add p set))
([], visited_pnames) next_calls in ~init:([], visited_pnames)
next_calls in
IList.iter (loop fst_call_loc updated_visited (new_trace, new_stack_str)) unseen_pnames in IList.iter (loop fst_call_loc updated_visited (new_trace, new_stack_str)) unseen_pnames in
IList.iter IList.iter
(fun fst_call_site -> (fun fst_call_site ->
@ -390,9 +391,10 @@ module Interprocedural = struct
let initial = let initial =
let init_map = let init_map =
IList.fold_left List.fold
(fun astate_acc (_, snk_annot) -> CallsDomain.add snk_annot CallSiteSet.empty astate_acc) ~f:(fun astate_acc (_, snk_annot) ->
CallsDomain.empty CallsDomain.add snk_annot CallSiteSet.empty astate_acc)
~init:CallsDomain.empty
(src_snk_pairs ()) in (src_snk_pairs ()) in
Domain.NonBottom Domain.NonBottom
(init_map, Domain.TrackingVar.empty) in (init_map, Domain.TrackingVar.empty) in

@ -123,7 +123,7 @@ module State = struct
let map2 (f : Elem.t -> Elem.t list) (s : t) : t = let map2 (f : Elem.t -> Elem.t list) (s : t) : t =
let l = ElemSet.elements s in let l = ElemSet.elements s in
let l' = List.filter ~f:Elem.is_consistent (List.concat (IList.map f l)) in let l' = List.filter ~f:Elem.is_consistent (List.concat (IList.map f l)) in
IList.fold_right ElemSet.add l' ElemSet.empty List.fold_right ~f:ElemSet.add l' ~init:ElemSet.empty
let map (f : Elem.t -> Elem.t) s = let map (f : Elem.t -> Elem.t) s =
map2 (fun elem -> [f elem]) s map2 (fun elem -> [f elem]) s

@ -117,9 +117,9 @@ module ConstantFlow = Dataflow.MakeDF(struct
(Procdesc.Node.get_instrs node) (Procdesc.Node.get_instrs node)
end; end;
let constants = let constants =
IList.fold_left List.fold
do_instr ~f:do_instr
constants ~init:constants
(Procdesc.Node.get_instrs node) in (Procdesc.Node.get_instrs node) in
if verbose then L.stdout "%a\n@." pp constants; if verbose then L.stdout "%a\n@." pp constants;
[constants], [constants] [constants], [constants]

@ -104,7 +104,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let astate' = Option.value_map ~f:kill_ret_id ~default:astate ret_id in let astate' = Option.value_map ~f:kill_ret_id ~default:astate ret_id in
if Config.curr_language_is Config.Java if Config.curr_language_is Config.Java
then astate' (* Java doesn't have pass-by-reference *) then astate' (* Java doesn't have pass-by-reference *)
else IList.fold_left kill_actuals_by_ref astate' actuals else List.fold ~f:kill_actuals_by_ref ~init:astate' actuals
| Sil.Store _ | Prune _ | Nullify _ | Abstract _ | Remove_temps _ | Declare_locals _ -> | Sil.Store _ | Prune _ | Nullify _ | Abstract _ | Remove_temps _ | Declare_locals _ ->
(* none of these can assign to program vars or logical vars *) (* none of these can assign to program vars or logical vars *)
astate astate

@ -100,9 +100,9 @@ module MakeDF(St: DFStateType) : DF with type state = St.t = struct
| Transition of state * state list * state list | Transition of state * state list * state list
let join states initial_state = let join states initial_state =
IList.fold_left List.fold
St.join ~f:St.join
initial_state ~init:initial_state
states states
(** Propagate [new_state] to all the nodes immediately reachable. *) (** Propagate [new_state] to all the nodes immediately reachable. *)

@ -27,8 +27,14 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let exp_add_live exp astate = let exp_add_live exp astate =
let (ids, pvars) = Exp.get_vars exp in let (ids, pvars) = Exp.get_vars exp in
let astate' = let astate' =
IList.fold_left (fun astate_acc id -> Domain.add (Var.of_id id) astate_acc) astate ids in List.fold
IList.fold_left (fun astate_acc pvar -> Domain.add (Var.of_pvar pvar) astate_acc) astate' pvars ~f:(fun astate_acc id -> Domain.add (Var.of_id id) astate_acc)
~init:astate
ids in
List.fold
~f:(fun astate_acc pvar -> Domain.add (Var.of_pvar pvar) astate_acc)
~init:astate'
pvars
let exec_instr astate _ _ = function let exec_instr astate _ _ = function
| Sil.Load (lhs_id, rhs_exp, _, _) -> | Sil.Load (lhs_id, rhs_exp, _, _) ->
@ -49,7 +55,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
Option.value_map ~f:(fun (ret_id, _) -> Domain.remove (Var.of_id ret_id) astate) Option.value_map ~f:(fun (ret_id, _) -> Domain.remove (Var.of_id ret_id) astate)
~default:astate ret_id ~default:astate ret_id
|> exp_add_live call_exp |> exp_add_live call_exp
|> IList.fold_right exp_add_live (IList.map fst params) |> (fun x -> List.fold_right ~f:exp_add_live (IList.map fst params) ~init:x)
| Sil.Declare_locals _ | Remove_temps _ | Abstract _ | Nullify _ -> | Sil.Declare_locals _ | Remove_temps _ | Abstract _ | Nullify _ ->
astate astate
end end

@ -156,9 +156,9 @@ module Exceptional = struct
Procdesc.IdMap.add exn_succ_node_id (n :: existing_exn_preds) exn_preds_acc Procdesc.IdMap.add exn_succ_node_id (n :: existing_exn_preds) exn_preds_acc
else else
exn_preds_acc in exn_preds_acc in
IList.fold_left add_exn_pred exn_preds_acc (Procdesc.Node.get_exn n) in List.fold ~f:add_exn_pred ~init:exn_preds_acc (Procdesc.Node.get_exn n) in
let exceptional_preds = let exceptional_preds =
IList.fold_left add_exn_preds Procdesc.IdMap.empty (Procdesc.get_nodes pdesc) in List.fold ~f:add_exn_preds ~init:Procdesc.IdMap.empty (Procdesc.get_nodes pdesc) in
pdesc, exceptional_preds pdesc, exceptional_preds
let instrs = Procdesc.Node.get_instrs let instrs = Procdesc.Node.get_instrs

@ -77,7 +77,7 @@ module ReversePostorder (CFG : ProcCfg.S) = struct
with Not_found -> WorkUnit.make t.cfg node_to_schedule in with Not_found -> WorkUnit.make t.cfg node_to_schedule in
let new_work = WorkUnit.add_visited_pred t.cfg old_work node_id in let new_work = WorkUnit.add_visited_pred t.cfg old_work node_id in
M.add id_to_schedule new_work worklist_acc in M.add id_to_schedule new_work worklist_acc in
let new_worklist = IList.fold_left schedule_succ t.worklist (CFG.succs t.cfg node) in let new_worklist = List.fold ~f:schedule_succ ~init:t.worklist (CFG.succs t.cfg node) in
{ t with worklist = new_worklist; } { t with worklist = new_worklist; }
(* remove and return the node with the highest priority (note that smaller integers have higher (* remove and return the node with the highest priority (note that smaller integers have higher

@ -32,8 +32,8 @@ let plugin_name = "BiniouASTExporter";
let infer_cxx_models = Config.cxx; let infer_cxx_models = Config.cxx;
let value_of_argv_option argv opt_name => let value_of_argv_option argv opt_name =>
IList.fold_left List.fold
( f::(
fun (prev_arg, result) arg => { fun (prev_arg, result) arg => {
let result' = let result' =
if (Option.is_some result) { if (Option.is_some result) {
@ -46,7 +46,7 @@ let value_of_argv_option argv opt_name =>
(arg, result') (arg, result')
} }
) )
("", None) init::("", None)
argv |> snd; argv |> snd;
let value_of_option {orig_argv} => value_of_argv_option orig_argv; let value_of_option {orig_argv} => value_of_argv_option orig_argv;

@ -60,7 +60,7 @@ let fold_qual_name qual_name_list =
match qual_name_list with match qual_name_list with
| [] -> "" | [] -> ""
| name :: quals -> | name :: quals ->
let s = (IList.fold_right (fun el res -> res ^ el ^ "::") quals "") ^ name in let s = (List.fold_right ~f:(fun el res -> res ^ el ^ "::") quals ~init:"") ^ name in
let no_slash_space = Str.global_replace (Str.regexp "[/ ]") "_" s in let no_slash_space = Str.global_replace (Str.regexp "[/ ]") "_" s in
no_slash_space no_slash_space

@ -98,4 +98,4 @@ let modelled_field class_name_info =
let name = CGeneral_utils.mk_class_field_name field_name_qualified in let name = CGeneral_utils.mk_class_field_name field_name_qualified in
(name, typ, Annot.Item.empty) :: res (name, typ, Annot.Item.empty) :: res
else res in else res in
IList.fold_left modelled_field_in_class [] modelled_fields_in_classes List.fold ~f:modelled_field_in_class ~init:[] modelled_fields_in_classes

@ -99,4 +99,4 @@ let cxx_ref_captured_in_block an =
| _ -> [] in | _ -> [] in
let var_desc vars var_named_decl_info = let var_desc vars var_named_decl_info =
vars ^ "'" ^ var_named_decl_info.ni_name ^ "'" in vars ^ "'" ^ var_named_decl_info.ni_name ^ "'" in
IList.fold_left var_desc "" capt_refs List.fold ~f:var_desc ~init:"" capt_refs

@ -103,7 +103,7 @@ let make_condition_issue_desc_pair checkers =
severity = Exceptions.Kwarning; severity = Exceptions.Kwarning;
mode = CIssue.On; mode = CIssue.On;
} in } in
let issue, condition = IList.fold_left (fun (issue', cond') d -> let issue, condition = List.fold ~f:(fun (issue', cond') d ->
match d with match d with
| CSet (s, phi) when String.equal s report_when_const -> | CSet (s, phi) when String.equal s report_when_const ->
issue', phi issue', phi
@ -115,7 +115,7 @@ let make_condition_issue_desc_pair checkers =
{issue' with severity = string_to_err_kind sev}, cond' {issue' with severity = string_to_err_kind sev}, cond'
| CDesc (s, m) when String.equal s mode_const -> | CDesc (s, m) when String.equal s mode_const ->
{issue' with mode = string_to_issue_mode m }, cond' {issue' with mode = string_to_issue_mode m }, cond'
| _ -> issue', cond') (dummy_issue, CTL.False) c.definitions in | _ -> issue', cond') ~init:(dummy_issue, CTL.False) c.definitions in
if Config.debug_mode then ( if Config.debug_mode then (
Logging.out "\nMaking condition and issue desc for checker '%s'\n" Logging.out "\nMaking condition and issue desc for checker '%s'\n"
c.name; c.name;
@ -159,15 +159,15 @@ let expand_checkers checkers =
let expand_one_checker c = let expand_one_checker c =
Logging.out " +Start expanding %s\n" c.name; Logging.out " +Start expanding %s\n" c.name;
let map : CTL.t Core.Std.String.Map.t = Core.Std.String.Map.empty in let map : CTL.t Core.Std.String.Map.t = Core.Std.String.Map.empty in
let map = IList.fold_left (fun map' d -> match d with let map = List.fold ~f:(fun map' d -> match d with
| CLet (k,formula) -> Core.Std.Map.add map' ~key:k ~data:formula | CLet (k,formula) -> Core.Std.Map.add map' ~key:k ~data:formula
| _ -> map') map c.definitions in | _ -> map') ~init:map c.definitions in
let exp_defs = IList.fold_left (fun defs clause -> let exp_defs = List.fold ~f:(fun defs clause ->
match clause with match clause with
| CSet (report_when_const, phi) -> | CSet (report_when_const, phi) ->
Logging.out " -Expanding report_when\n"; Logging.out " -Expanding report_when\n";
CSet (report_when_const, expand phi map) :: defs CSet (report_when_const, expand phi map) :: defs
| cl -> cl :: defs) [] c.definitions in | cl -> cl :: defs) ~init:[] c.definitions in
{ c with definitions = exp_defs} in { c with definitions = exp_defs} in
let expanded_checkers = IList.map expand_one_checker checkers in let expanded_checkers = IList.map expand_one_checker checkers in
expanded_checkers expanded_checkers

@ -351,7 +351,7 @@ let sil_method_annotation_of_args args : Annot.Method.t =
if CAst_utils.is_type_nullable qt_type_ptr then if CAst_utils.is_type_nullable qt_type_ptr then
[mk_annot arg_name Annotations.nullable] :: acc [mk_annot arg_name Annotations.nullable] :: acc
else Annot.Item.empty::acc in else Annot.Item.empty::acc in
let param_annots = IList.fold_right arg_to_sil_annot args [] in let param_annots = List.fold_right ~f:arg_to_sil_annot args ~init:[] in
(* TODO: parse annotations on return value *) (* TODO: parse annotations on return value *)
let retval_annot = [] in let retval_annot = [] in
retval_annot, param_annots retval_annot, param_annots

@ -53,7 +53,7 @@ let captured_variables_cxx_ref an =
| _ -> reference_captured_vars in | _ -> reference_captured_vars in
match an with match an with
| Ctl_parser_types.Decl (BlockDecl (_, bdi)) -> | Ctl_parser_types.Decl (BlockDecl (_, bdi)) ->
IList.fold_left capture_var_is_cxx_ref [] bdi.bdi_captured_variables List.fold ~f:capture_var_is_cxx_ref ~init:[] bdi.bdi_captured_variables
| _ -> [] | _ -> []

@ -105,4 +105,4 @@ let captured_vars_from_block_info context cvl =
(pvar, typ) :: vars (pvar, typ) :: vars
| _ -> assert false) | _ -> assert false)
| _ -> assert false in | _ -> assert false in
IList.fold_right sil_var_of_captured_var cvl [] List.fold_right ~f:sil_var_of_captured_var cvl ~init:[]

@ -43,4 +43,4 @@ let get_methods curr_class decl_list =
CGeneral_utils.mk_procname_from_objc_method class_name method_name method_kind in CGeneral_utils.mk_procname_from_objc_method class_name method_name method_kind in
meth_name:: list_methods meth_name:: list_methods
| _ -> list_methods in | _ -> list_methods in
IList.fold_right get_method decl_list [] List.fold_right ~f:get_method decl_list ~init:[]

@ -78,7 +78,10 @@ struct
TypeState.add pvar (typ, ta, []) typestate in TypeState.add pvar (typ, ta, []) typestate in
let get_initial_typestate () = let get_initial_typestate () =
let typestate_empty = TypeState.empty Extension.ext in let typestate_empty = TypeState.empty Extension.ext in
IList.fold_left add_formal typestate_empty annotated_signature.AnnotatedSignature.params in List.fold
~f:add_formal
~init:typestate_empty
annotated_signature.AnnotatedSignature.params in
(* Check the nullable flag computed for the return value and report inconsistencies. *) (* Check the nullable flag computed for the return value and report inconsistencies. *)
let check_return find_canonical_duplicate exit_node final_typestate ret_ia ret_type loc : unit = let check_return find_canonical_duplicate exit_node final_typestate ret_ia ret_type loc : unit =

@ -549,7 +549,7 @@ let check_overridden_annotations
and overridden_params = overriden_signature.AnnotatedSignature.params in and overridden_params = overriden_signature.AnnotatedSignature.params in
let initial_pos = if is_virtual current_params then 0 else 1 in let initial_pos = if is_virtual current_params then 0 else 1 in
if Int.equal (IList.length current_params) (IList.length overridden_params) then if Int.equal (IList.length current_params) (IList.length overridden_params) then
ignore (IList.fold_left2 compare initial_pos current_params overridden_params) in ignore (List.fold2_exn ~f:compare ~init:initial_pos current_params overridden_params) in
let check overriden_proc_name = let check overriden_proc_name =
match Specs.proc_resolve_attributes overriden_proc_name with match Specs.proc_resolve_attributes overriden_proc_name with

@ -470,7 +470,7 @@ let typecheck_instr
match instr with match instr with
| Sil.Remove_temps (idl, _) -> | Sil.Remove_temps (idl, _) ->
if remove_temps then IList.fold_right TypeState.remove_id idl typestate if remove_temps then List.fold_right ~f:TypeState.remove_id idl ~init:typestate
else typestate else typestate
| Sil.Declare_locals _ | Sil.Declare_locals _
| Sil.Abstract _ | Sil.Abstract _
@ -596,7 +596,7 @@ let typecheck_instr
typecheck_expr_for_errors typestate e1 loc; typecheck_expr_for_errors typestate e1 loc;
let e2, typestate2 = convert_complex_exp_to_pvar node false e1 typestate1 loc in let e2, typestate2 = convert_complex_exp_to_pvar node false e1 typestate1 loc in
(((e1, e2), t1) :: etl1), typestate2 in (((e1, e2), t1) :: etl1), typestate2 in
IList.fold_right handle_et etl ([], typestate) in List.fold_right ~f:handle_et etl ~init:([], typestate) in
let annotated_signature = let annotated_signature =
Models.get_modelled_annotated_signature callee_attributes in Models.get_modelled_annotated_signature callee_attributes in
@ -669,7 +669,7 @@ let typecheck_instr
pvar_apply loc clear_nullable_flag ts pvar1 pvar_apply loc clear_nullable_flag ts pvar1
| _ -> ts in | _ -> ts in
let vararg_values = PatternMatch.java_get_vararg_values node pvar idenv in let vararg_values = PatternMatch.java_get_vararg_values node pvar idenv in
IList.fold_right do_vararg_value vararg_values typestate' List.fold_right ~f:do_vararg_value vararg_values ~init:typestate'
else else
pvar_apply loc clear_nullable_flag typestate' pvar pvar_apply loc clear_nullable_flag typestate' pvar
| None -> typestate' in | None -> typestate' in
@ -1108,7 +1108,7 @@ let typecheck_node
(* This is used to track if it is set to true for all visit to the node. *) (* This is used to track if it is set to true for all visit to the node. *)
TypeErr.node_reset_forall canonical_node; TypeErr.node_reset_forall canonical_node;
let typestate_succ = IList.fold_left (do_instruction ext) typestate instrs in let typestate_succ = List.fold ~f:(do_instruction ext) ~init:typestate instrs in
let dont_propagate = let dont_propagate =
Procdesc.Node.equal_nodekind Procdesc.Node.equal_nodekind
(Procdesc.Node.get_kind node) (Procdesc.Node.get_kind node)

@ -97,10 +97,10 @@ let get_lifecycle_for_framework_typ_opt tenv lifecycle_typ lifecycle_proc_strs =
) methods in ) methods in
(* convert each of the framework lifecycle proc strings to a lifecycle method procname *) (* convert each of the framework lifecycle proc strings to a lifecycle method procname *)
let lifecycle_procs = let lifecycle_procs =
IList.fold_left (fun lifecycle_procs lifecycle_proc_str -> List.fold ~f:(fun lifecycle_procs lifecycle_proc_str ->
try (lookup_proc lifecycle_proc_str) :: lifecycle_procs try (lookup_proc lifecycle_proc_str) :: lifecycle_procs
with Not_found -> lifecycle_procs) with Not_found -> lifecycle_procs)
[] lifecycle_proc_strs in ~init:[] lifecycle_proc_strs in
lifecycle_procs lifecycle_procs
| _ -> [] | _ -> []

@ -22,13 +22,13 @@ let try_create_lifecycle_trace name lifecycle_name lifecycle_procs tenv =
if PatternMatch.is_subtype tenv name lifecycle_name && if PatternMatch.is_subtype tenv name lifecycle_name &&
not (AndroidFramework.is_android_lib_class name) then not (AndroidFramework.is_android_lib_class name) then
let ptr_to_struct_typ = Some (Typ.Tptr (Tstruct name, Pk_pointer)) in let ptr_to_struct_typ = Some (Typ.Tptr (Tstruct name, Pk_pointer)) in
IList.fold_left List.fold
(fun trace lifecycle_proc -> ~f:(fun trace lifecycle_proc ->
(* given a lifecycle subclass T, resolve the call T.lifecycle_proc() to the procname (* given a lifecycle subclass T, resolve the call T.lifecycle_proc() to the procname
* that will actually be called at runtime *) * that will actually be called at runtime *)
let resolved_proc = SymExec.resolve_method tenv name lifecycle_proc in let resolved_proc = SymExec.resolve_method tenv name lifecycle_proc in
(resolved_proc, ptr_to_struct_typ) :: trace) (resolved_proc, ptr_to_struct_typ) :: trace)
[] ~init:[]
lifecycle_procs lifecycle_procs
else else
[] []

@ -153,7 +153,7 @@ and inhabit_args tenv formals cfg env =
let inhabit_arg (_, formal_typ) (args, env) = let inhabit_arg (_, formal_typ) (args, env) =
let (exp, env) = inhabit_typ tenv formal_typ cfg env in let (exp, env) = inhabit_typ tenv formal_typ cfg env in
((exp, formal_typ) :: args, env) in ((exp, formal_typ) :: args, env) in
IList.fold_right inhabit_arg formals ([], env) List.fold_right ~f:inhabit_arg formals ~init:([], env)
(** create Sil that calls the constructor in constr_name on allocated_obj and inhabits the (** create Sil that calls the constructor in constr_name on allocated_obj and inhabits the
* remaining arguments *) * remaining arguments *)
@ -272,7 +272,11 @@ let inhabit_trace tenv trace harness_name cg cfg =
cur_inhabiting = TypSet.empty; cur_inhabiting = TypSet.empty;
harness_name = harness_name; } in harness_name = harness_name; } in
(* invoke lifecycle methods *) (* invoke lifecycle methods *)
let env'' = IList.fold_left (fun env to_call -> inhabit_call tenv to_call cfg env) empty_env trace in let env'' =
List.fold
~f:(fun env to_call -> inhabit_call tenv to_call cfg env)
~init:empty_env
trace in
try try
setup_harness_cfg harness_name env'' cg cfg; setup_harness_cfg harness_name env'' cg cfg;
write_harness_to_file (IList.rev env''.instrs) harness_filename write_harness_to_file (IList.rev env''.instrs) harness_filename

@ -114,7 +114,7 @@ let get_compilation_database_files_buck () =
(String.concat ~sep:"\n" lines); (String.concat ~sep:"\n" lines);
let scan_output compilation_database_files chan = let scan_output compilation_database_files chan =
Scanf.sscanf chan "%s %s" (fun _ file -> `Raw file::compilation_database_files) in Scanf.sscanf chan "%s %s" (fun _ file -> `Raw file::compilation_database_files) in
IList.fold_left scan_output [] lines List.fold ~f:scan_output ~init:[] lines
with Unix.Unix_error (err, _, _) -> with Unix.Unix_error (err, _, _) ->
Process.print_error_and_exit Process.print_error_and_exit
"Cannot execute %s\n%!" "Cannot execute %s\n%!"

@ -56,7 +56,7 @@ let collect_specs_filenames jar_filename =
let proc_filename = (Filename.chop_extension (Filename.basename filename)) in let proc_filename = (Filename.chop_extension (Filename.basename filename)) in
String.Set.add set proc_filename in String.Set.add set proc_filename in
models_specs_filenames := models_specs_filenames :=
IList.fold_left collect !models_specs_filenames (Zip.entries zip_channel); List.fold ~f:collect ~init:!models_specs_filenames (Zip.entries zip_channel);
models_tenv := load_models_tenv zip_channel; models_tenv := load_models_tenv zip_channel;
Zip.close_in zip_channel Zip.close_in zip_channel
@ -187,9 +187,9 @@ let load_from_verbose_output javac_verbose_out =
| End_of_file -> | End_of_file ->
In_channel.close file_in; In_channel.close file_in;
let classpath = let classpath =
IList.fold_left List.fold
append_path ~f:append_path
"" ~init:""
((String.Set.elements roots) @ paths) in ((String.Set.elements roots) @ paths) in
(classpath, sources, classes) in (classpath, sources, classes) in
loop [] String.Set.empty String.Map.empty JBasics.ClassSet.empty loop [] String.Set.empty String.Map.empty JBasics.ClassSet.empty
@ -207,15 +207,15 @@ let extract_classnames classnames jar_filename =
| basename, Some "class" -> | basename, Some "class" ->
(classname_of_class_filename basename) :: classes (classname_of_class_filename basename) :: classes
| _ -> classes in | _ -> classes in
let classnames_after = IList.fold_left collect classnames (Zip.entries file_in) in let classnames_after = List.fold ~f:collect ~init:classnames (Zip.entries file_in) in
Zip.close_in file_in; Zip.close_in file_in;
classnames_after classnames_after
let collect_classnames start_classmap jar_filename = let collect_classnames start_classmap jar_filename =
IList.fold_left List.fold
(fun map cn -> JBasics.ClassSet.add cn map) ~f:(fun map cn -> JBasics.ClassSet.add cn map)
start_classmap ~init:start_classmap
(extract_classnames [] jar_filename) (extract_classnames [] jar_filename)
@ -238,9 +238,9 @@ let search_classes path =
let search_sources () = let search_sources () =
let initial_map = let initial_map =
IList.fold_left List.fold
(fun map path -> add_source_file path map) ~f:(fun map path -> add_source_file path map)
String.Map.empty ~init:String.Map.empty
Config.sources in Config.sources in
match Config.sourcepath with match Config.sourcepath with
| None -> initial_map | None -> initial_map
@ -259,7 +259,7 @@ let load_from_arguments classes_out_path =
let split cp_option = let split cp_option =
Option.value_map ~f:split_classpath ~default:[] cp_option in Option.value_map ~f:split_classpath ~default:[] cp_option in
let combine path_list classpath = let combine path_list classpath =
IList.fold_left append_path classpath (IList.rev path_list) in List.fold ~f:append_path ~init:classpath (IList.rev path_list) in
let classpath = let classpath =
combine (split Config.classpath) "" combine (split Config.classpath) ""
|> combine (String.Set.elements roots) |> combine (String.Set.elements roots)
@ -317,9 +317,9 @@ let collect_classes start_classmap jar_filename =
with JBasics.Class_structure_error _ -> with JBasics.Class_structure_error _ ->
classmap in classmap in
let classmap = let classmap =
IList.fold_left List.fold
collect ~f:collect
start_classmap ~init:start_classmap
(extract_classnames [] jar_filename) in (extract_classnames [] jar_filename) in
Javalib.close_class_path classpath; Javalib.close_class_path classpath;
classmap classmap

@ -97,7 +97,8 @@ let add_cmethod source_file program linereader icfg cm proc_name =
let path_of_cached_classname cn = let path_of_cached_classname cn =
let root_path = Filename.concat Config.results_dir "classnames" in let root_path = Filename.concat Config.results_dir "classnames" in
let package_path = IList.fold_left Filename.concat root_path (JBasics.cn_package cn) in let package_path =
List.fold ~f:Filename.concat ~init:root_path (JBasics.cn_package cn) in
Filename.concat package_path ((JBasics.cn_simple_name cn)^".java") Filename.concat package_path ((JBasics.cn_simple_name cn)^".java")

@ -133,7 +133,7 @@ let formals_from_signature program tenv cn ms kind =
let init_arg_list = match kind with let init_arg_list = match kind with
| Procname.Static -> [] | Procname.Static -> []
| Procname.Non_Static -> [(JConfig.this, JTransType.get_class_type program tenv cn)] in | Procname.Non_Static -> [(JConfig.this, JTransType.get_class_type program tenv cn)] in
IList.rev (IList.fold_left collect init_arg_list (JBasics.ms_args ms)) IList.rev (List.fold ~f:collect ~init:init_arg_list (JBasics.ms_args ms))
(** Creates the list of formal variables from a procedure based on ... *) (** Creates the list of formal variables from a procedure based on ... *)
let translate_formals program tenv cn impl = let translate_formals program tenv cn impl =
@ -141,15 +141,15 @@ let translate_formals program tenv cn impl =
let name = Mangled.from_string (JBir.var_name_g var) in let name = Mangled.from_string (JBir.var_name_g var) in
let typ = JTransType.param_type program tenv cn var vt in let typ = JTransType.param_type program tenv cn var vt in
(name, typ):: l in (name, typ):: l in
IList.rev (IList.fold_left collect [] (JBir.params impl)) IList.rev (List.fold ~f:collect ~init:[] (JBir.params impl))
(** Creates the list of local variables from the bytecode and add the variables from (** Creates the list of local variables from the bytecode and add the variables from
the JBir representation *) the JBir representation *)
let translate_locals program tenv formals bytecode jbir_code = let translate_locals program tenv formals bytecode jbir_code =
let formal_set = let formal_set =
IList.fold_left List.fold
(fun set (var, _) -> Mangled.Set.add var set) ~f:(fun set (var, _) -> Mangled.Set.add var set)
Mangled.Set.empty ~init:Mangled.Set.empty
formals in formals in
let collect (seen_vars, l) (var, typ) = let collect (seen_vars, l) (var, typ) =
if Mangled.Set.mem var seen_vars then if Mangled.Set.mem var seen_vars then
@ -162,12 +162,12 @@ let translate_locals program tenv formals bytecode jbir_code =
match bytecode.JCode.c_local_variable_table with match bytecode.JCode.c_local_variable_table with
| None -> init | None -> init
| Some variable_table -> | Some variable_table ->
IList.fold_left List.fold
(fun accu (_, _, var_name, var_type, _) -> ~f:(fun accu (_, _, var_name, var_type, _) ->
let var = Mangled.from_string var_name let var = Mangled.from_string var_name
and typ = JTransType.value_type program tenv var_type in and typ = JTransType.value_type program tenv var_type in
collect accu (var, typ)) collect accu (var, typ))
init ~init
variable_table in variable_table in
(* TODO (#4040807): Needs to add the JBir temporary variables since other parts of the (* TODO (#4040807): Needs to add the JBir temporary variables since other parts of the
code are still relying on those *) code are still relying on those *)
@ -555,11 +555,11 @@ let method_invocation
| _ -> [] in | _ -> [] in
(instrs, [(sil_obj_expr, sil_obj_type)]) in (instrs, [(sil_obj_expr, sil_obj_type)]) in
let (instrs, call_args) = let (instrs, call_args) =
IList.fold_left List.fold
(fun (instrs_accu, args_accu) expr -> ~f:(fun (instrs_accu, args_accu) expr ->
let (instrs, sil_expr, sil_expr_type) = expression context pc expr in let (instrs, sil_expr, sil_expr_type) = expression context pc expr in
(instrs_accu @ instrs, args_accu @ [(sil_expr, sil_expr_type)])) (instrs_accu @ instrs, args_accu @ [(sil_expr, sil_expr_type)]))
init ~init
expr_list in expr_list in
let callee_procname = let callee_procname =
let proc = Procname.from_string_c_fun (JBasics.ms_name ms) in let proc = Procname.from_string_c_fun (JBasics.ms_name ms) in
@ -619,11 +619,11 @@ let get_array_length context pc expr_list content_type =
match other_instrs with match other_instrs with
| (other_instrs, other_exprs) -> | (other_instrs, other_exprs) ->
(instrs @ other_instrs, sil_len_expr :: other_exprs) in (instrs @ other_instrs, sil_len_expr :: other_exprs) in
let (instrs, sil_len_exprs) = (IList.fold_right get_expr_instr expr_list ([],[])) in let (instrs, sil_len_exprs) = List.fold_right ~f:get_expr_instr expr_list ~init:([],[]) in
let get_array_type_len sil_len_expr (content_type, _) = let get_array_type_len sil_len_expr (content_type, _) =
(Typ.Tarray (content_type, None), Some sil_len_expr) in (Typ.Tarray (content_type, None), Some sil_len_expr) in
let array_type, array_len = let array_type, array_len =
IList.fold_right get_array_type_len sil_len_exprs (content_type, None) in List.fold_right ~f:get_array_type_len sil_len_exprs ~init:(content_type, None) in
let array_size = Exp.Sizeof (array_type, array_len, Subtype.exact) in let array_size = Exp.Sizeof (array_type, array_len, Subtype.exact) in
(instrs, array_size) (instrs, array_size)

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

@ -265,8 +265,8 @@ let add_model_fields program classpath_fields cn =
let statics, nonstatics = classpath_fields in let statics, nonstatics = classpath_fields in
let classpath_field_map = let classpath_field_map =
let collect_fields map = let collect_fields map =
IList.fold_left List.fold
(fun map (fn, ft, _) -> Ident.FieldMap.add fn ft map) map in ~f:(fun map (fn, ft, _) -> Ident.FieldMap.add fn ft map) ~init:map in
collect_fields (collect_fields Ident.FieldMap.empty statics) nonstatics in collect_fields (collect_fields Ident.FieldMap.empty statics) nonstatics in
try try
match JBasics.ClassMap.find cn (JClasspath.get_models program) with match JBasics.ClassMap.find cn (JClasspath.get_models program) with

@ -217,7 +217,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct
end end
| None -> | None ->
access_tree_acc in access_tree_acc in
let access_tree' = IList.fold_left add_sink_to_actual access_tree sinks in let access_tree' = List.fold ~f:add_sink_to_actual ~init:access_tree sinks in
{ astate with Domain.access_tree = access_tree'; } { astate with Domain.access_tree = access_tree'; }
let apply_summary let apply_summary
@ -376,7 +376,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct
let initial_trace = let initial_trace =
access_path_get_trace access_path astate.access_tree proc_data callee_loc in access_path_get_trace access_path astate.access_tree proc_data callee_loc in
let trace_with_propagation = let trace_with_propagation =
IList.fold_left exp_join_traces initial_trace actuals in List.fold ~f:exp_join_traces ~init:initial_trace actuals in
let access_tree = let access_tree =
TaintDomain.add_trace access_path trace_with_propagation astate.access_tree in TaintDomain.add_trace access_path trace_with_propagation astate.access_tree in
{ astate with access_tree; } in { astate with access_tree; } in
@ -407,7 +407,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct
(Option.map ~f:snd ret) (Option.map ~f:snd ret)
actuals actuals
proc_data.tenv in proc_data.tenv in
IList.fold_left handle_unknown_call_ astate propagations in List.fold ~f:handle_unknown_call_ ~init:astate propagations in
let analyze_call astate_acc callee_pname = let analyze_call astate_acc callee_pname =
let call_site = CallSite.make callee_pname callee_loc in let call_site = CallSite.make callee_pname callee_loc in
@ -459,7 +459,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct
[called_pname] [called_pname]
end in end in
(* for each possible target of the call, apply the summary. join all results together *) (* for each possible target of the call, apply the summary. join all results together *)
IList.fold_left analyze_call Domain.empty targets List.fold ~f:analyze_call ~init:Domain.empty targets
| Sil.Call _ -> | Sil.Call _ ->
failwith "Unimp: non-pname call expressions" failwith "Unimp: non-pname call expressions"
| Sil.Nullify (pvar, _) -> | Sil.Nullify (pvar, _) ->
@ -467,9 +467,9 @@ module Make (TaintSpecification : TaintSpec.S) = struct
{ astate with id_map; } { astate with id_map; }
| Sil.Remove_temps (ids, _) -> | Sil.Remove_temps (ids, _) ->
let id_map = let id_map =
IList.fold_left List.fold
(fun acc id -> IdMapDomain.remove (Var.of_id id) acc) ~f:(fun acc id -> IdMapDomain.remove (Var.of_id id) acc)
astate.id_map ~init:astate.id_map
ids in ids in
{ astate with id_map; } { astate with id_map; }
| Sil.Prune _ | Abstract _ | Declare_locals _ -> | Sil.Prune _ | Abstract _ | Declare_locals _ ->
@ -500,14 +500,14 @@ module Make (TaintSpecification : TaintSpec.S) = struct
let make_initial pdesc = let make_initial pdesc =
let pname = Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
let access_tree = let access_tree =
IList.fold_left (fun acc (name, typ, taint_opt) -> List.fold ~f:(fun acc (name, typ, taint_opt) ->
match taint_opt with match taint_opt with
| Some source -> | Some source ->
let base_ap = AccessPath.Exact (AccessPath.of_pvar (Pvar.mk name pname) typ) in let base_ap = AccessPath.Exact (AccessPath.of_pvar (Pvar.mk name pname) typ) in
TaintDomain.add_trace base_ap (TraceDomain.of_source source) acc TaintDomain.add_trace base_ap (TraceDomain.of_source source) acc
| None -> | None ->
acc) acc)
TaintDomain.empty ~init:TaintDomain.empty
(TraceDomain.Source.get_tainted_formals pdesc tenv) in (TraceDomain.Source.get_tainted_formals pdesc tenv) in
if TaintDomain.BaseMap.is_empty access_tree if TaintDomain.BaseMap.is_empty access_tree
then Domain.empty then Domain.empty

@ -228,9 +228,9 @@ module Make (CFG : ProcCfg.S with type node = Procdesc.Node.t) (T : TransferFunc
(* add the assertion to be checked after analysis converges *) (* add the assertion to be checked after analysis converges *)
node, M.add (CFG.id node) (inv_str, inv_label) assert_map node, M.add (CFG.id node) (inv_str, inv_label) assert_map
and structured_instrs_to_node last_node assert_map exn_handlers instrs = and structured_instrs_to_node last_node assert_map exn_handlers instrs =
IList.fold_left List.fold
(fun acc instr -> structured_instr_to_node acc exn_handlers instr) ~f:(fun acc instr -> structured_instr_to_node acc exn_handlers instr)
(last_node, assert_map) ~init:(last_node, assert_map)
instrs in instrs in
let start_node = create_node (Procdesc.Node.Start_node pname) [] in let start_node = create_node (Procdesc.Node.Start_node pname) [] in
Procdesc.set_start_node pdesc start_node; Procdesc.set_start_node pdesc start_node;

Loading…
Cancel
Save