From 731dead4061532f2b5f243e202e6524fd3edee8a Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Tue, 21 Feb 2017 09:58:39 -0800 Subject: [PATCH] More IList deprecation: fold functions Reviewed By: jberdine Differential Revision: D4588244 fbshipit-source-id: 5df1d9b --- infer/src/IR/Cfg.re | 14 ++-- infer/src/IR/Exp.re | 6 +- infer/src/IR/Ident.re | 3 +- infer/src/IR/Localise.ml | 2 +- infer/src/IR/Procdesc.re | 18 +++-- infer/src/IR/Sil.re | 26 +++--- infer/src/IR/Subtype.re | 2 +- infer/src/Makefile | 6 +- infer/src/backend/Attribute.ml | 14 ++-- infer/src/backend/BuiltinDefn.ml | 4 +- infer/src/backend/PropUtil.re | 30 +++---- infer/src/backend/StatsAggregator.re | 4 +- infer/src/backend/abs.ml | 56 ++++++------- infer/src/backend/absarray.ml | 13 ++- infer/src/backend/callbacks.ml | 12 +-- infer/src/backend/crashcontext.ml | 8 +- infer/src/backend/dom.ml | 17 ++-- infer/src/backend/inferconfig.ml | 33 ++++---- infer/src/backend/interproc.ml | 58 ++++++------- infer/src/backend/match.ml | 2 +- infer/src/backend/mergeCapture.ml | 2 +- infer/src/backend/paths.ml | 2 +- infer/src/backend/preanal.ml | 28 +++---- infer/src/backend/prop.ml | 59 ++++++++------ infer/src/backend/propset.ml | 12 +-- infer/src/backend/prover.ml | 6 +- infer/src/backend/rearrange.ml | 47 ++++++----- infer/src/backend/state.ml | 9 ++- infer/src/backend/symExec.ml | 81 ++++++++++--------- infer/src/backend/tabulation.ml | 31 +++---- infer/src/backend/taint.ml | 25 +++--- infer/src/base/CommandLineOption.ml | 8 +- infer/src/base/Config.ml | 2 +- infer/src/base/IList.ml | 11 --- infer/src/base/IList.mli | 8 -- infer/src/base/SourceFile.ml | 20 ++--- infer/src/base/StatisticsToolbox.re | 2 +- infer/src/base/Utils.ml | 2 +- infer/src/base/ZipLib.ml | 2 +- .../src/bufferoverrun/bufferOverrunChecker.ml | 8 +- .../bufferoverrun/bufferOverrunSemantics.ml | 6 +- infer/src/checkers/AbstractInterpreter.ml | 8 +- infer/src/checkers/FormalMap.ml | 6 +- infer/src/checkers/SinkTrace.ml | 10 +-- infer/src/checkers/Siof.ml | 2 +- infer/src/checkers/SiofDomain.ml | 4 +- infer/src/checkers/SiofTrace.ml | 2 +- infer/src/checkers/ThreadSafety.ml | 35 ++++---- infer/src/checkers/Trace.ml | 10 ++- infer/src/checkers/addressTaken.ml | 2 +- infer/src/checkers/annotationReachability.ml | 22 ++--- infer/src/checkers/checkTraceCallSequence.ml | 2 +- infer/src/checkers/constantPropagation.ml | 6 +- infer/src/checkers/copyPropagation.ml | 2 +- infer/src/checkers/dataflow.ml | 6 +- infer/src/checkers/liveness.ml | 12 ++- infer/src/checkers/procCfg.ml | 4 +- infer/src/checkers/scheduler.ml | 2 +- infer/src/clang/ClangCommand.re | 6 +- infer/src/clang/cAst_utils.ml | 2 +- infer/src/clang/cField_decl.ml | 2 +- infer/src/clang/cFrontend_checkers.ml | 2 +- infer/src/clang/cFrontend_errors.ml | 12 +-- infer/src/clang/cMethod_trans.ml | 2 +- infer/src/clang/cPredicates.ml | 2 +- infer/src/clang/cVar_decl.ml | 2 +- infer/src/clang/objcProperty_decl.ml | 2 +- infer/src/eradicate/eradicate.ml | 5 +- infer/src/eradicate/eradicateChecks.ml | 2 +- infer/src/eradicate/typeCheck.ml | 8 +- infer/src/harness/androidFramework.ml | 4 +- infer/src/harness/harness.ml | 14 ++-- infer/src/harness/inhabit.ml | 8 +- .../integration/CaptureCompilationDatabase.ml | 2 +- infer/src/java/jClasspath.ml | 30 +++---- infer/src/java/jFrontend.ml | 3 +- infer/src/java/jTrans.ml | 36 ++++----- infer/src/java/jTransExn.ml | 2 +- infer/src/java/jTransType.ml | 4 +- infer/src/quandary/TaintAnalysis.ml | 18 ++--- infer/src/unit/analyzerTester.ml | 6 +- 81 files changed, 526 insertions(+), 482 deletions(-) diff --git a/infer/src/IR/Cfg.re b/infer/src/IR/Cfg.re index a5d2d3c09..604c04e86 100644 --- a/infer/src/IR/Cfg.re +++ b/infer/src/IR/Cfg.re @@ -51,9 +51,9 @@ let iter_all_nodes sorted::sorted=false f cfg => { Procname.Hash.fold ( fun _ pdesc desc_nodes => - IList.fold_left - (fun desc_nodes node => [(pdesc, node), ...desc_nodes]) - desc_nodes + List.fold + f::(fun desc_nodes node => [(pdesc, node), ...desc_nodes]) + init::desc_nodes (Procdesc.get_nodes pdesc) ) cfg.proc_desc_table @@ -434,7 +434,7 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => { let rec convert_node node => { let loc = Procdesc.Node.get_loc 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 } 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 callee_attributes = Procdesc.get_attributes callee_pdesc; let (resolved_params, substitutions) = - IList.fold_left2 - ( + List.fold2_exn + f::( fun (params, subts) (param_name, param_typ) (_, arg_typ) => switch arg_typ { | Typ.Tptr (Tstruct typename) Pk_pointer => @@ -481,7 +481,7 @@ let specialize_types callee_pdesc resolved_pname args => { | _ => ([(param_name, param_typ), ...params], subts) } ) - ([], Mangled.Map.empty) + init::([], Mangled.Map.empty) callee_attributes.formals args; let resolved_attributes = { diff --git a/infer/src/IR/Exp.re b/infer/src/IR/Exp.re index 656d0fcb4..d0bda8a6b 100644 --- a/infer/src/IR/Exp.re +++ b/infer/src/IR/Exp.re @@ -192,8 +192,10 @@ let get_vars exp => { | BinOp _ e1 e2 | Lindex e1 e2 => get_vars_ e1 vars |> get_vars_ e2 | Closure {captured_vars} => - IList.fold_left - (fun vars_acc (captured_exp, _, _) => get_vars_ captured_exp vars_acc) vars captured_vars + List.fold + 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 /* TODO: Sizeof length expressions may contain variables, do not ignore them. */ /* | Sizeof _ None _ => vars */ diff --git a/infer/src/IR/Ident.re b/infer/src/IR/Ident.re index f7e8cc00b..451924afb 100644 --- a/infer/src/IR/Ident.re +++ b/infer/src/IR/Ident.re @@ -104,7 +104,8 @@ let module FieldMap = Caml.Map.Make { 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} */ diff --git a/infer/src/IR/Localise.ml b/infer/src/IR/Localise.ml index ee778c235..f1cf14871 100644 --- a/infer/src/IR/Localise.ml +++ b/infer/src/IR/Localise.ml @@ -425,7 +425,7 @@ let desc_context_leak pname context_typ fieldname leak_path : error_desc = let path_str = let path_prefix = 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 let preamble = let pname_str = match pname with diff --git a/infer/src/IR/Procdesc.re b/infer/src/IR/Procdesc.re index eb8779d8d..01847ebe9 100644 --- a/infer/src/IR/Procdesc.re +++ b/infer/src/IR/Procdesc.re @@ -92,7 +92,7 @@ let module Node = { 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) }; @@ -108,7 +108,7 @@ let module Node = { 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) }; @@ -158,7 +158,7 @@ let module Node = { } | _ => callees }; - IList.fold_left collect [] (get_instrs node) + List.fold f::collect init::[] (get_instrs 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 do_node a node => - IList.fold_left - (fun b callee_pname => f b (callee_pname, Node.get_loc node)) a (Node.get_callees node); - IList.fold_left do_node acc (get_nodes pdesc) + List.fold + f::(fun b callee_pname => f b (callee_pname, Node.get_loc node)) + 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 }; -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_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 }; diff --git a/infer/src/IR/Sil.re b/infer/src/IR/Sil.re index 9ac3a45d9..c61fa4259 100644 --- a/infer/src/IR/Sil.re +++ b/infer/src/IR/Sil.re @@ -269,7 +269,7 @@ let is_static_local_name pname pvar => { /** {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} */ @@ -1223,7 +1223,7 @@ let hpred_get_lexp acc => | Hdllseg _ _ e1 _ _ e2 _ => [e1, e2, ...acc]; 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 }; @@ -1254,7 +1254,7 @@ let atom_fpv = | Aeq e1 e2 => exp_fpv e1 @ exp_fpv e2 | Aneq e1 e2 => exp_fpv e1 @ exp_fpv e2 | 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 = fun @@ -2099,8 +2099,8 @@ let compare_structural_instr instr1 instr2 exp_map => { if (n != 0) { (n, exp_map) } else { - IList.fold_left2 - ( + List.fold2_exn + f::( fun (n, exp_map) id1 id2 => if (n != 0) { (n, exp_map) @@ -2108,7 +2108,7 @@ let compare_structural_instr instr1 instr2 exp_map => { exp_compare_structural (Var id1) (Var id2) exp_map } ) - (0, exp_map) + init::(0, exp_map) ids1 ids2 } @@ -2162,8 +2162,8 @@ let compare_structural_instr instr1 instr2 exp_map => { if (n != 0) { (n, exp_map) } else { - IList.fold_left2 - ( + List.fold2_exn + f::( fun (n, exp_map) arg1 arg2 => if (n != 0) { (n, exp_map) @@ -2171,7 +2171,7 @@ let compare_structural_instr instr1 instr2 exp_map => { exp_typ_compare_structural arg1 arg2 exp_map } ) - (0, exp_map) + init::(0, exp_map) args1 args2 } @@ -2204,8 +2204,8 @@ let compare_structural_instr instr1 instr2 exp_map => { if (n != 0) { (n, exp_map) } else { - IList.fold_left2 - ( + List.fold2_exn + f::( fun (n, exp_map) (pv1, t1) (pv2, t2) => if (n != 0) { (n, exp_map) @@ -2218,7 +2218,7 @@ let compare_structural_instr instr1 instr2 exp_map => { } } ) - (0, exp_map) + init::(0, exp_map) ptl1 ptl2 } @@ -2386,7 +2386,7 @@ let sigma_to_sigma_ne sigma :list (list atom, list hpred) => ]; List.concat (IList.map g eqs_sigma_list) }; - IList.fold_left f [([], [])] sigma + List.fold f::f init::[([], [])] sigma } else { [([], sigma)] }; diff --git a/infer/src/IR/Subtype.re b/infer/src/IR/Subtype.re index 65b8ce912..e225d454b 100644 --- a/infer/src/IR/Subtype.re +++ b/infer/src/IR/Subtype.re @@ -238,7 +238,7 @@ let check_redundancies tenv c l => { }; (l, add && should_add) }; - IList.fold_left aux ([], true) l + List.fold f::aux init::([], true) l }; let rec updates_head f c l => diff --git a/infer/src/Makefile b/infer/src/Makefile index 8256ad9cf..d0d288e5b 100644 --- a/infer/src/Makefile +++ b/infer/src/Makefile @@ -116,7 +116,7 @@ CHECKCOPYRIGHT_MAIN = $(SCRIPT_SOURCES)/checkCopyright #### End of declarations #### ifeq ($(IS_FACEBOOK_TREE),yes) -EXTRA_DEPS = facebook facebook/scripts +EXTRA_DEPS = facebook else EXTRA_DEPS = opensource endif @@ -258,7 +258,7 @@ rei: roots:=Infer InferAnalyzeExe InferClang InferPrintExe StatsAggregator 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\)*') inc_flags:=$(foreach dir,$(DEPENDENCIES),-I $(dir)) root_flags:=$(foreach root,$(roots),-r $(root)) @@ -297,7 +297,7 @@ toplevel.mlpack: base/Version.ml $(OCAML_CONFIG_SOURCES) $(MAKEFILE_LIST) $(foreach module,\ $(filter-out $(foreach root,$(roots),%/$(root)),\ $(foreach source,\ - $(filter-out unit/% facebook/scripts/eradicate_stats.ml,$(OCAML_CONFIG_SOURCES)),\ + $(filter-out unit/%,$(OCAML_CONFIG_SOURCES)),\ $(call to_ocaml_module,$(source)))),\ $(shell echo $(module) >> $($@_tmp))) mv $($@_tmp) $@ diff --git a/infer/src/backend/Attribute.ml b/infer/src/backend/Attribute.ml index c6f14e873..9a441e176 100644 --- a/infer/src/backend/Attribute.ml +++ b/infer/src/backend/Attribute.ml @@ -82,7 +82,7 @@ let get_for_exp tenv (prop: 'a Prop.t) exp = | Sil.Apred (_, es) | Anpred (_, es) when List.mem ~equal:Exp.equal es nexp -> atom :: attributes | _ -> 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 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 | Exp.Var _ | Lvar _ -> add_or_replace tenv prop (Apred (att_undef, [exp])) | _ -> 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 arith_problem = @@ -291,14 +291,14 @@ let deallocate_stack_vars tenv (p: 'a Prop.t) pvars = end in IList.iter do_var !fresh_address_vars; !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 formal variable that is equal to the expression, or the OBJC_NULL attribute of the expression. *) let find_equal_formal_path tenv e prop = let rec find_in_sigma e seen_hpreds = - IList.fold_right ( + List.fold_right ~f:( fun hpred res -> if List.mem ~equal:Sil.equal_hpred seen_hpreds hpred then None else @@ -312,7 +312,7 @@ let find_equal_formal_path tenv e prop = (Pvar.is_local pvar1 || Pvar.is_seed pvar1) -> Some (Exp.Lvar pvar1) | Sil.Hpointsto (exp1, Sil.Estruct (fields, _), _) -> - IList.fold_right (fun (field, strexp) res -> + List.fold_right ~f:(fun (field, strexp) res -> match res with | Some _ -> res | None -> @@ -321,8 +321,8 @@ let find_equal_formal_path tenv e prop = (match find_in_sigma exp1 seen_hpreds with | Some vfs -> Some (Exp.Lfield (vfs, field, Typ.Tvoid)) | None -> None) - | _ -> None) fields None - | _ -> None) prop.Prop.sigma None in + | _ -> None) fields ~init:None + | _ -> None) prop.Prop.sigma ~init:None in match find_in_sigma e [] with | Some vfs -> Some vfs | None -> diff --git a/infer/src/backend/BuiltinDefn.ml b/infer/src/backend/BuiltinDefn.ml index 2d661bc9e..076c8f9d8 100644 --- a/infer/src/backend/BuiltinDefn.ml +++ b/infer/src/backend/BuiltinDefn.ml @@ -565,7 +565,7 @@ let execute___release_autorelease_pool ) ~default:res | _ -> 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 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 | Some _ -> 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 IList.rev prop_list end diff --git a/infer/src/backend/PropUtil.re b/infer/src/backend/PropUtil.re index 90e3875d6..4f8f5bac8 100644 --- a/infer/src/backend/PropUtil.re +++ b/infer/src/backend/PropUtil.re @@ -53,9 +53,9 @@ let remove_abduced_retvars tenv p => { | Sil.Eexp (Exp.Exn e) _ => Exp.Set.add e exps | Sil.Eexp e _ => Exp.Set.add e exps | 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 _ => - 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 add_hpred_if_reachable (reach, exps) => fun @@ -67,21 +67,23 @@ let remove_abduced_retvars tenv p => { | Sil.Hlseg _ _ exp1 exp2 exp_l as hpred => { let reach' = Sil.HpredSet.add hpred reach; let exps' = - IList.fold_left - (fun exps_acc exp => Exp.Set.add exp exps_acc) exps [exp1, exp2, ...exp_l]; + List.fold + f::(fun exps_acc exp => Exp.Set.add exp exps_acc) + init::exps + [exp1, exp2, ...exp_l]; (reach', exps') } | Sil.Hdllseg _ _ exp1 exp2 exp3 exp4 exp_l as hpred => { let reach' = Sil.HpredSet.add hpred reach; let exps' = - IList.fold_left - (fun exps_acc exp => Exp.Set.add exp exps_acc) - exps + List.fold + f::(fun exps_acc exp => Exp.Set.add exp exps_acc) + init::exps [exp1, exp2, exp3, exp4, ...exp_l]; (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')) { (reach, exps) } else { @@ -115,8 +117,8 @@ let remove_abduced_retvars tenv p => { }; /* separate the abduced pvars from the normal ones, deallocate the abduced ones*/ let (abduceds, normal_pvars) = - IList.fold_left - ( + List.fold + f::( fun pvars hpred => switch hpred { | Sil.Hpointsto (Exp.Lvar pvar) _ _ => @@ -129,13 +131,13 @@ let remove_abduced_retvars tenv p => { | _ => pvars } ) - ([], []) + init::([], []) p.Prop.sigma; let (_, p') = Attribute.deallocate_stack_vars tenv p abduceds; let normal_pvar_set = - IList.fold_left - (fun normal_pvar_set pvar => Exp.Set.add (Exp.Lvar pvar) normal_pvar_set) - Exp.Set.empty + List.fold + f::(fun normal_pvar_set pvar => Exp.Set.add (Exp.Lvar pvar) normal_pvar_set) + init::Exp.Set.empty normal_pvars; /* walk forward from non-abduced pvars, keep everything reachable. remove everything else */ let (sigma_reach, pi_reach) = compute_reachable p' normal_pvar_set; diff --git a/infer/src/backend/StatsAggregator.re b/infer/src/backend/StatsAggregator.re index db8f2ef95..e588d2331 100644 --- a/infer/src/backend/StatsAggregator.re +++ b/infer/src/backend/StatsAggregator.re @@ -135,7 +135,7 @@ let aggregate_all_stats origin => { let stats_paths = switch origin { | 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 }; { @@ -152,7 +152,7 @@ let aggregate_stats_by_target tp => { | Some v => [(t, v), ...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 { | [] => None | _ as v => Some (`Assoc v) diff --git a/infer/src/backend/abs.ml b/infer/src/backend/abs.ml index 14270c578..8f3b62374 100644 --- a/infer/src/backend/abs.ml +++ b/infer/src/backend/abs.ml @@ -33,7 +33,7 @@ let sigma_rewrite tenv p r : Prop.normal Prop.t option = else let res_pi = r.r_new_pi p p_leftover sub in let res_sigma = Prop.sigma_sub sub r.r_new_sigma in - let p_with_res_pi = 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 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 new_found = 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 find_all_consecutive_edges new_found new_edges_seen edges_notseen in let sigma = p.Prop.sigma in @@ -514,7 +514,7 @@ let discover_para_dll_candidates tenv p = match se with | Sil.Eexp (e, _) -> e:: acc | _ -> 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 | [] -> () | 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 new_found = 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 find_all_consecutive_edges new_found new_edges_seen edges_notseen 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 | None -> paras | 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 = (* @@ -563,7 +563,7 @@ let discover_para_dll tenv p = match (discover_para_dll_roots tenv p iF oB iF' iF' iF oF) with | None -> paras | 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 ******************) (****************** 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 | Some (ids_res, sub) -> (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 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 let rec apply_rule_set p rset = 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 - 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 new_rsets = ref [] in @@ -773,25 +773,25 @@ let abstract_pure_part tenv p ~(from_abstract_footprint: bool) = else true) in List.filter ~f:filter pure in let new_pure = - IList.fold_left - (fun pi a -> - match a with - (* 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.BinOp (Binop.Lt, _, _), Exp.Const (Const.Cint i)) - | Sil.Aeq (Exp.Const (Const.Cint i), Exp.BinOp (Binop.Le, _, _)) - | Sil.Aeq (Exp.BinOp (Binop.Le, _, _), Exp.Const (Const.Cint i)) when IntLit.isone i -> - a :: pi - | Sil.Aeq (Exp.Var name, e) when not (Ident.is_primed name) -> - (match e with - | Exp.Var _ - | Exp.Const _ -> a :: pi - | _ -> pi) - | Sil.Aneq (Var _, _) - | Sil.Apred (_, Var _ :: _) | Anpred (_, Var _ :: _) -> a :: pi - | Sil.Aeq _ | Aneq _ | Apred _ | Anpred _ -> pi - ) - [] pi_filtered in + List.fold + ~f:(fun pi a -> + match a with + (* 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.BinOp (Binop.Lt, _, _), Exp.Const (Const.Cint i)) + | Sil.Aeq (Exp.Const (Const.Cint i), Exp.BinOp (Binop.Le, _, _)) + | Sil.Aeq (Exp.BinOp (Binop.Le, _, _), Exp.Const (Const.Cint i)) when IntLit.isone i -> + a :: pi + | Sil.Aeq (Exp.Var name, e) when not (Ident.is_primed name) -> + (match e with + | Exp.Var _ + | Exp.Const _ -> a :: pi + | _ -> pi) + | Sil.Aneq (Var _, _) + | Sil.Apred (_, Var _ :: _) | Anpred (_, Var _ :: _) -> a :: pi + | Sil.Aeq _ | Aneq _ | Apred _ | Anpred _ -> pi + ) + ~init:[] pi_filtered in IList.rev new_pure in let new_pure = do_pure (Prop.get_pure p) in diff --git a/infer/src/backend/absarray.ml b/infer/src/backend/absarray.ml index 4642a2492..825ff4f73 100644 --- a/infer/src/backend/absarray.ml +++ b/infer/src/backend/absarray.ml @@ -275,13 +275,13 @@ let prop_replace_path_index tenv = let elist_path = StrexpMatch.path_to_exps path in let expmap_list = - IList.fold_left (fun acc_outer e_path -> - IList.fold_left (fun acc_inner (old_index, new_index) -> + List.fold ~f:(fun acc_outer e_path -> + 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 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 - ) acc_outer map - ) [] elist_path in + ) ~init:acc_outer map + ) ~init:[] elist_path in let expmap_fun e' = Option.value_map ~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 (p: Prop.normal Prop.t) (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 - (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 *) diff --git a/infer/src/backend/callbacks.ml b/infer/src/backend/callbacks.ml index cbf606605..8380afa09 100644 --- a/infer/src/backend/callbacks.ml +++ b/infer/src/backend/callbacks.ml @@ -150,12 +150,12 @@ let iterate_callbacks store_summary call_graph exe_env = "unknown" in let cluster proc_names = let cluster_map = - IList.fold_left - (fun map proc_name -> - let proc_cluster = cluster_id proc_name 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.empty + List.fold + ~f:(fun map proc_name -> + let proc_cluster = cluster_id proc_name 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) + ~init:String.Map.empty proc_names in (* Return all values of the map *) String.Map.data cluster_map in diff --git a/infer/src/backend/crashcontext.ml b/infer/src/backend/crashcontext.ml index d9334587c..88b166dc8 100644 --- a/infer/src/backend/crashcontext.ml +++ b/infer/src/backend/crashcontext.ml @@ -52,10 +52,10 @@ let stitch_summaries stacktrace_file summary_files out_file = let summaries = IList.map (Ag_util.Json.from_file Stacktree_j.read_stacktree) summary_files in - let summary_map = IList.fold_left - (fun acc stacktree -> - String.Map.add ~key:(frame_id_of_summary stacktree) ~data:stacktree acc) - String.Map.empty + let summary_map = List.fold + ~f:(fun acc stacktree -> + String.Map.add ~key:(frame_id_of_summary stacktree) ~data:stacktree acc) + ~init:String.Map.empty summaries in let expand_stack_frame frame = (* TODO: Implement k > 1 case *) diff --git a/infer/src/backend/dom.ml b/infer/src/backend/dom.ml index ef3765a47..6fee41360 100644 --- a/infer/src/backend/dom.ml +++ b/infer/src/backend/dom.ml @@ -213,7 +213,7 @@ end = struct let get_lexp_set' sigma = 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 = lexps1 := get_lexp_set' sigma1; lexps2 := get_lexp_set' sigma2 @@ -511,7 +511,7 @@ end = struct let e_upper1 = Exp.int upper1 in get_induced_atom tenv acc e_strict_lower1 e_upper1 e | _ -> acc in - IList.fold_left f_ineqs eqs t_minimal + List.fold ~f:f_ineqs ~init:eqs t_minimal end @@ -1664,11 +1664,11 @@ let pi_partial_join tenv mode end; let atom_list1 = 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 ()); let atom_list2 = 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 (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 @@ -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 pi2 = ep2.Prop.pi in - let p_pi1 = IList.fold_left f1 p pi1 in - let p_pi2 = IList.fold_left f2 p_pi1 pi2 in - if (Prover.check_inconsistency_base tenv p_pi2) then (L.d_strln "check_inconsistency_base failed"; raise IList.Fail) + let p_pi1 = List.fold ~f:f1 ~init:p pi1 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) else p_pi2 (** {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"; let pi_from_fresh_vars = FreshVarExp.get_induced_pi tenv () 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 | _ -> L.d_strln "leftovers not empty"; raise IList.Fail diff --git a/infer/src/backend/inferconfig.ml b/infer/src/backend/inferconfig.ml index f791088e8..70bb293f5 100644 --- a/infer/src/backend/inferconfig.ml +++ b/infer/src/backend/inferconfig.ml @@ -118,14 +118,14 @@ module FileOrProcMatcher = struct default_matcher else let pattern_map = - IList.fold_left - (fun map pattern -> - let previous = - try - String.Map.find_exn map pattern.class_name - with Not_found -> [] in - String.Map.add ~key:pattern.class_name ~data:(pattern :: previous) map) - String.Map.empty + List.fold + ~f:(fun map pattern -> + let previous = + try + String.Map.find_exn map pattern.class_name + with Not_found -> [] in + String.Map.add ~key:pattern.class_name ~data:(pattern :: previous) map) + ~init:String.Map.empty m_patterns in let do_java 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 | Source_contains (_, s) -> (s:: s_patterns, m_patterns) | 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 matcher = FileContainsStringMatcher.create_matcher s_patterns in fun source_file _ -> matcher source_file @@ -253,7 +253,7 @@ let patterns_of_json_with_key (json_key, json) = let collect accu = function | `String s -> s:: accu | _ -> 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 loop mp = function | (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) } | (key, _) when String.equal key "language" -> mp | _ -> 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 = let loop sc = function | (key, `String pattern) when String.equal key "source_contains" -> pattern | (key, _) when String.equal key "language" -> sc | _ -> 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 | Ok (Method_pattern (language, _)) -> Ok (Method_pattern (language, create_method_pattern assoc)) @@ -293,7 +293,7 @@ let patterns_of_json_with_key (json_key, json) = warn_user msg; accu) | `List l -> - IList.fold_left translate accu l + List.fold ~f:translate ~init:accu l | json -> warn_user (Printf.sprintf "expected list or assoc json type, but got value %s" (Yojson.Basic.to_string json)); @@ -369,9 +369,10 @@ let test () = (fun (name, analyzer) -> (name, analyzer, create_filters analyzer)) Config.string_to_analyzer in let matching_analyzers path = - IList.fold_left - (fun l (n, a, f) -> if f.path_filter path then (n,a) :: l else l) - [] filters in + List.fold + ~f:(fun l (n, a, f) -> if f.path_filter path then (n,a) :: l else l) + ~init:[] + filters in Utils.directory_iter (fun path -> if DB.is_source_file path then diff --git a/infer/src/backend/interproc.ml b/infer/src/backend/interproc.ml index 29e605679..797f037f0 100644 --- a/infer/src/backend/interproc.ml +++ b/infer/src/backend/interproc.ml @@ -496,12 +496,12 @@ let add_taint_attrs tenv proc_name proc_desc prop = let formal_params' = IList.map (fun (p, _) -> Pvar.mk p proc_name) formal_params in Taint.get_params_to_taint tainted_param_nums formal_params' - |> IList.fold_left - (fun prop_acc (param, taint_kind) -> - let attr = - PredSymb.Ataint { taint_source = proc_name; taint_kind; } in - Taint.add_tainting_attribute tenv attr param prop_acc) - prop + |> List.fold + ~f:(fun prop_acc (param, taint_kind) -> + let attr = + PredSymb.Ataint { taint_source = proc_name; taint_kind; } in + Taint.add_tainting_attribute tenv attr param prop_acc) + ~init:prop let forward_tabulate tenv pdesc wl source = let pname = Procdesc.get_proc_name pdesc in @@ -668,15 +668,15 @@ let report_context_leaks pname sigma tenv = context_exps in (* get the set of pointed-to expressions of type T <: Context *) let context_exps = - IList.fold_left - (fun exps hpred -> match hpred with - | Sil.Hpointsto (_, Eexp (exp, _), Sizeof (Tptr (Tstruct name, _), _, _)) - when not (Exp.is_null_literal exp) - && AndroidFramework.is_context tenv name - && not (AndroidFramework.is_application tenv name) -> - (exp, name) :: exps - | _ -> exps) - [] + List.fold + ~f:(fun exps hpred -> match hpred with + | Sil.Hpointsto (_, Eexp (exp, _), Sizeof (Tptr (Tstruct name, _), _, _)) + when not (Exp.is_null_literal exp) + && AndroidFramework.is_context tenv name + && not (AndroidFramework.is_application tenv name) -> + (exp, name) :: exps + | _ -> exps) + ~init:[] sigma in IList.iter (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 let new_visited = Specs.Visitedset.union visited current_visited 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 add_spec pre ((posts : Paths.PathSet.t), visited) = 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 (Pvar.to_seed pv), se, typ) :: sigma | _ -> 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 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) | _ -> (exns, false) in let collect_spec errors spec = - IList.fold_left (collect_exceptions spec.Specs.pre) errors spec.Specs.posts in - IList.fold_left collect_spec ([], true) (Specs.get_specs_from_payload summary) + List.fold ~f:(collect_exceptions spec.Specs.pre) ~init:errors spec.Specs.posts in + 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 *) let custom_error_preconditions summary = @@ -1135,8 +1135,8 @@ let custom_error_preconditions summary = | None -> (errors, false) | Some e -> ((pre, e) :: errors, all_post_error) in let collect_spec errors spec = - IList.fold_left (collect_errors spec.Specs.pre) errors spec.Specs.posts in - IList.fold_left collect_spec ([], true) (Specs.get_specs_from_payload summary) + List.fold ~f:(collect_errors spec.Specs.pre) ~init:errors spec.Specs.posts in + 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 *) @@ -1150,11 +1150,11 @@ let remove_this_not_null tenv prop = | Sil.Aneq (Exp.Var v, e) when Ident.equal v var && Exp.equal e Exp.null -> atoms | 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 | Some var, filtered_hpreds -> 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 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 current_specs = ref - (IList.fold_left - (fun map spec -> - SpecMap.add - spec.Specs.pre - (Paths.PathSet.from_renamed_list spec.Specs.posts, spec.Specs.visited) map) - SpecMap.empty old_specs) in + (List.fold + ~f:(fun map spec -> + SpecMap.add + spec.Specs.pre + (Paths.PathSet.from_renamed_list spec.Specs.posts, spec.Specs.visited) map) + ~init:SpecMap.empty old_specs) in let re_exe_filter old_spec = (* filter out pres which failed re-exe *) if Specs.equal_phase phase Specs.RE_EXECUTION && not (List.exists diff --git a/infer/src/backend/match.ml b/infer/src/backend/match.ml index 0e3301d26..1a9a38122 100644 --- a/infer/src/backend/match.ml +++ b/infer/src/backend/match.ml @@ -88,7 +88,7 @@ let exp_list_match es1 sub vars es2 = | None -> None | Some (sub_acc, vars_leftover) -> exp_match e1 sub_acc vars_leftover e2 in 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) (** Checks sexp1 = sexp2[sub ++ sub'] for some sub' with diff --git a/infer/src/backend/mergeCapture.ml b/infer/src/backend/mergeCapture.ml index 16174c4de..dcdae3ee5 100644 --- a/infer/src/backend/mergeCapture.ml +++ b/infer/src/backend/mergeCapture.ml @@ -30,7 +30,7 @@ let modified_targets = ref String.Set.empty let modified_file file = match Utils.read_file file with | 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 -> () diff --git a/infer/src/backend/paths.ml b/infer/src/backend/paths.ml index d61516425..392454d87 100644 --- a/infer/src/backend/paths.ml +++ b/infer/src/backend/paths.ml @@ -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 *) 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 of the PathSet module ===============*) diff --git a/infer/src/backend/preanal.ml b/infer/src/backend/preanal.ml index f4ae1667e..2dda0cabf 100644 --- a/infer/src/backend/preanal.ml +++ b/infer/src/backend/preanal.ml @@ -274,20 +274,20 @@ let do_copy_propagation pdesc tenv = (* perform copy-propagation on each instruction in [node] *) let rev_transform_node_instrs node = - IList.fold_left - (fun (instrs, changed) (instr, id_opt) -> - match id_opt with - | Some id -> - begin - match CopyProp.extract_pre id copy_prop_inv_map with - | Some pre when not (CopyPropagation.Domain.is_empty pre) -> - let instr' = Sil.instr_sub_ids ~sub_id_binders:false (id_sub pre) instr in - instr' :: instrs, changed || not (phys_equal instr' instr) - | _ -> - instr :: instrs, changed - end - | None -> instr :: instrs, changed) - ([], false) + List.fold + ~f:(fun (instrs, changed) (instr, id_opt) -> + match id_opt with + | Some id -> + begin + match CopyProp.extract_pre id copy_prop_inv_map with + | Some pre when not (CopyPropagation.Domain.is_empty pre) -> + let instr' = Sil.instr_sub_ids ~sub_id_binders:false (id_sub pre) instr in + instr' :: instrs, changed || not (phys_equal instr' instr) + | _ -> + instr :: instrs, changed + end + | None -> instr :: instrs, changed) + ~init:([], false) (ExceptionalOneInstrPerNodeCfg.instr_ids node) in IList.iter diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index a34919142..16b031044 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -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) else ((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 ([], inst) @@ -593,19 +593,28 @@ let strexp_get_exps strexp = | Eexp (Exn e, _) -> Exp.Set.add e exps | Eexp (e, _) -> Exp.Set.add e exps | 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, _) -> - 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 (** get the set of expressions on the righthand side of [hpred] *) let hpred_get_targets (hpred : Sil.hpred) = match hpred with | Hpointsto (_, rhs, _) -> strexp_get_exps rhs | 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) -> (* 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 [exps] *) @@ -617,7 +626,7 @@ let compute_reachable_hpreds sigma exps = let reach_exps = hpred_get_targets hpred in (reach', Exp.Set.union exps reach_exps) | _ -> 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) else compute_reachable_hpreds_rec sigma (reach', exps') in compute_reachable_hpreds_rec sigma (Sil.HpredSet.empty, exps) @@ -1425,7 +1434,7 @@ module Normalize = struct | Aneq (Const (Cint n), e) | Aneq(e, Const (Cint n)) -> (e, n) :: acc | _ -> 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 = List.exists ~f:(fun (e', n') -> Exp.equal e e' && IntLit.eq n n') diseq_list in let le_list_tightened = @@ -1438,7 +1447,7 @@ module Normalize = struct | (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) 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 let lt_list_tightened = let get_lt_inequality_info acc a = @@ -1452,7 +1461,7 @@ module Normalize = struct if is_neq e n_plus_one 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 - 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 let ineq_list' = let le_ineq_list = @@ -1573,7 +1582,7 @@ module Normalize = struct let p' = unsafe_cast_to_normal (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 -> p | Aneq (e1, e2) -> @@ -1615,7 +1624,7 @@ module Normalize = struct let p0 = unsafe_cast_to_normal (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 (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 | Estruct (fsel, _) -> 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, _) -> - 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 - 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 | Hpointsto (_, se, _) -> @@ -1854,7 +1863,7 @@ let hpred_get_array_indices acc (hpred : Sil.hpred) = match hpred with acc 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 let compute_reindexing fav_add get_id_offset list = @@ -1909,7 +1918,7 @@ let apply_reindexing tenv subst prop = let p' = unsafe_cast_to_normal (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 = if !Config.footprint then prop @@ -2234,9 +2243,10 @@ let prop_iter_to_prop tenv iter = ~sigma:sigma ~pi_fp:iter.pit_pi_fp ~sigma_fp:iter.pit_sigma_fp) in - IList.fold_left - (fun p (footprint, atom) -> Normalize.prop_atom_and tenv ~footprint: footprint p atom) - prop iter.pit_newpi + List.fold + ~f:(fun p (footprint, atom) -> Normalize.prop_atom_and tenv ~footprint: footprint p atom) + ~init:prop + iter.pit_newpi (** Add an atom to the pi part of prop iter. The first parameter records whether it is done @@ -2265,9 +2275,10 @@ let prop_iter_current tenv iter = unsafe_cast_to_normal (set prop_emp ~sigma:[curr]) in let prop' = - IList.fold_left - (fun p (footprint, atom) -> Normalize.prop_atom_and tenv ~footprint: footprint p atom) - prop iter.pit_newpi in + List.fold + ~f:(fun p (footprint, atom) -> Normalize.prop_atom_and tenv ~footprint: footprint p atom) + ~init:prop + iter.pit_newpi in match prop'.sigma with | [curr'] -> (curr', iter.pit_state) | _ -> assert false @@ -2465,8 +2476,8 @@ let prop_case_split tenv prop = let prop' = unsafe_cast_to_normal (set prop ~sigma:sigma') in - (IList.fold_left (Normalize.prop_atom_and tenv) prop' pi):: props_acc in - IList.fold_left f [] pi_sigma_list + (List.fold ~f:(Normalize.prop_atom_and tenv) ~init:prop' pi):: props_acc in + List.fold ~f ~init:[] pi_sigma_list let prop_expand prop = (* diff --git a/infer/src/backend/propset.ml b/infer/src/backend/propset.ml index 43576cc9b..2e04beabf 100644 --- a/infer/src/backend/propset.ml +++ b/infer/src/backend/propset.ml @@ -31,9 +31,11 @@ type t = PropSet.t let add tenv p pset = let ps = Prop.prop_expand tenv p in - IList.fold_left (fun pset' p' -> - PropSet.add (Prop.prop_rename_primed_footprint_vars tenv p') pset' - ) pset ps + List.fold + ~f:(fun pset' p' -> + PropSet.add (Prop.prop_rename_primed_footprint_vars tenv p') pset') + ~init:pset + ps (** Singleton set. *) let singleton tenv p = @@ -64,7 +66,7 @@ let size = PropSet.cardinal let filter = PropSet.filter 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 = PropSet.elements pset @@ -84,7 +86,7 @@ let map tenv f pset = where [p1 ... pN] are the elements of pset, in increasing order. *) let fold f a pset = 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) where [p1 ... pN] are the elements of pset, in increasing order. *) diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index a10b6558a..3ef4794c3 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -286,9 +286,9 @@ end = struct let saturate { leqs = leqs; lts = lts; neqs = neqs } = let diff_constraints1 = - IList.fold_left - DiffConstr.from_lt - (IList.fold_left DiffConstr.from_leq [] leqs) + List.fold + ~f:DiffConstr.from_lt + ~init:(List.fold ~f:DiffConstr.from_leq ~init:[] leqs) lts in let inconsistent, diff_constraints2 = DiffConstr.saturate diff_constraints1 in if inconsistent then inconsistent_ineq diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index c85076644..eaac8c4da 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -18,9 +18,10 @@ module F = Format let list_product l1 l2 = let l1' = IList.rev l1 in let l2' = IList.rev l2 in - IList.fold_left - (fun acc x -> IList.fold_left (fun acc' y -> (x, y):: acc') acc l2') - [] l1' + List.fold + ~f:(fun acc x -> List.fold ~f:(fun acc' y -> (x, y):: acc') ~init:acc l2') + ~init:[] + l1' let rec list_rev_and_concat l1 l2 = match l1 with @@ -228,7 +229,7 @@ let rec _strexp_extend_values IList.sort StructTyp.compare_field (IList.map replace_fta fields) in ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; (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 -> let atoms', se', res_typ' = create_struct_values @@ -280,7 +281,7 @@ let rec _strexp_extend_values :: acc else raise (Exceptions.Bad_footprint __POS__) in - IList.fold_left replace [] atoms_se_typ_list' + List.fold ~f:replace ~init:[] atoms_se_typ_list' | None -> array_case_analysis_index pname tenv orig_prop footprint_part kind max_stamp @@ -341,14 +342,16 @@ and array_case_analysis_index pname tenv orig_prop _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se typ_cont off inst in let atoms_se_typ_list' = - IList.fold_left (fun acc' (atoms', se', typ') -> - check_sound typ'; - let atoms_new = Sil.Aeq (index, i) :: atoms' in - let isel_new = list_rev_and_concat isel_seen_rev ((i, se'):: isel_unseen) in - let array_new = Sil.Earray (array_len, isel_new, inst_arr) in - let typ_new = Typ.Tarray (typ', typ_array_len) in - (atoms_new, array_new, typ_new):: acc' - ) [] atoms_se_typ_list in + List.fold + ~f:(fun acc' (atoms', se', typ') -> + check_sound typ'; + let atoms_new = Sil.Aeq (index, i) :: atoms' in + let isel_new = list_rev_and_concat isel_seen_rev ((i, se'):: isel_unseen) in + let array_new = Sil.Earray (array_len, isel_new, inst_arr) in + let typ_new = Typ.Tarray (typ', typ_array_len) in + (atoms_new, array_new, typ_new):: acc') + ~init:[] + atoms_se_typ_list in let acc_new = atoms_se_typ_list' :: acc in let isel_seen_rev_new = ise :: isel_seen_rev 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 | _ -> assert false in 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 let do_extend e se te = 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 = list_product iter_list atoms_fp_sigma_list in 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 ) iter_atoms_fp_sigma_list in 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 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_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 | None -> 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 let hpred_check_flds prop_acc = function | 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 match lexp with @@ -904,7 +909,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = enforce_guarded_access fld typ prop | _ -> (* 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 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 (); 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_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 offsets_default = Sil.exp_get_offsets lexp in 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 pname tenv orig_prop false Ident.kprimed max_stamp se te offset inst in 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 let filter it = let p = Prop.prop_iter_to_prop tenv it in diff --git a/infer/src/backend/state.ml b/infer/src/backend/state.ml index 8a221ec97..2882b1bc9 100644 --- a/infer/src/backend/state.ml +++ b/infer/src/backend/state.ml @@ -149,7 +149,7 @@ let instrs_normalize instrs = let do_instr ids = function | Sil.Load (id, _, _, _) -> id :: ids | _ -> ids in - IList.fold_left do_instr [] instrs in + List.fold ~f:do_instr ~init:[] instrs in let subst = let count = ref Int.min_value in 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') = List.equal ~equal:Sil.equal_instr node_normalized_instrs normalized_instrs' in List.filter ~f:equal_normalized_instrs elements in - IList.fold_left - (fun nset (node', _) -> Procdesc.NodeSet.add node' nset) - Procdesc.NodeSet.empty duplicates + List.fold + ~f:(fun nset (node', _) -> Procdesc.NodeSet.add node' nset) + ~init:Procdesc.NodeSet.empty + duplicates with Not_found -> Procdesc.NodeSet.singleton node in find_duplicate_nodes diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index ec60e78cc..ae78d0342 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -250,7 +250,7 @@ let ptsto_update pdesc tenv p (lexp, se, typ, len, st) offlist exp = let update_iter iter pi sigma = 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 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 else let resolved_params = - IList.fold_left2 - (fun accu (arg_exp, _) name -> - match resolve_typename prop arg_exp with - | Some class_name -> - (Procname.split_classname (Typename.name class_name)) :: accu - | None -> name :: accu) - [] args (Procname.java_get_parameters resolved_pname_java) |> IList.rev in + List.fold2_exn + ~f:(fun accu (arg_exp, _) name -> + match resolve_typename prop arg_exp with + | Some class_name -> + (Procname.split_classname (Typename.name class_name)) :: accu + | None -> name :: accu) + ~init:[] args (Procname.java_get_parameters resolved_pname_java) |> IList.rev in Procname.java_replace_parameters resolved_pname_java resolved_params in let resolved_pname_java, other_args = match args with @@ -791,7 +791,7 @@ let normalize_params tenv pdesc prop actual_params = let norm_arg (p, args) (e, t) = let e', p' = check_arith_norm_exp tenv pdesc e p 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) 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 -> Prop.conjoin_eq tenv exp_to_bind rhs prop | _ -> 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 *) let add_ret_non_null exp typ prop = if has_nullable_annot @@ -920,7 +920,7 @@ let execute_load ?(report_deref_errors=true) pname pdesc tenv id rhs_exp typ loc begin match pred_insts_op with | 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 | (Sil.Hpointsto _, _) -> 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 | None, Sil.Apred (Aundef _, _) -> Some atom | _ -> 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' = if Config.angelic_execution then (* 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 let iter_list = 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 -> if Int.equal Config.array_level 0 then assert false else @@ -988,14 +988,14 @@ let execute_store ?(report_deref_errors=true) pname pdesc tenv lhs_exp typ rhs_e prop' :: acc in match pred_insts_op with | 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 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 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 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 -> if Int.equal Config.array_level 0 then assert false else [prop_] @@ -1128,7 +1128,10 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path | Some callee_summary -> let handled_args = call_args norm_prop pname url_handled_args ret_id loc 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 *) let (prop_r, n_actual_params) = 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(); [(p, path)] 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 = (* 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) prop.Prop.sigma in Prop.normalize tenv (Prop.set prop ~sigma:filtered_sigma) in - IList.fold_left - (fun p hpred -> - match hpred with - | Sil.Hpointsto (Exp.Lvar pv, rhs, texp) when Pvar.equal pv abduced_ref_pv -> - let new_hpred = Sil.Hpointsto (actual, rhs, texp) in - Prop.normalize tenv (Prop.set p ~sigma:(new_hpred :: prop'.Prop.sigma)) - | _ -> p) - prop' + List.fold + ~f:(fun p hpred -> + match hpred with + | Sil.Hpointsto (Exp.Lvar pv, rhs, texp) when Pvar.equal pv abduced_ref_pv -> + let new_hpred = Sil.Hpointsto (actual, rhs, texp) in + Prop.normalize tenv (Prop.set p ~sigma:(new_hpred :: prop'.Prop.sigma)) + | _ -> p) + ~init:prop' prop'.Prop.sigma | _ -> assert false in (* 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 -> true 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 = 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 | Sil.Apred ((Aresource {ra_res = Rfile} as res), _) -> Attribute.remove_for_attr tenv q res | _ -> 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 = match args, instr with | _:: other_args, Sil.Call (_, _, _, _, { CallFlags.cf_virtual }) when cf_virtual -> (* Do not remove the file attribute on the reciver for virtual calls *) other_args | _ -> 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 = if Config.taint_analysis then 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 | None -> prop_acc in prop_acc', param_num + 1 in - IList.fold_left - check_taint_if_nums_match - (prop, 0) + List.fold + ~f:check_taint_if_nums_match + ~init:(prop, 0) actuals |> fst 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 *) let exps_to_mark = let ret_exps = Option.value_map ~f:(fun (id, _) -> [Exp.Var id]) ~default:[] ret_id in - IList.fold_left - (fun exps_to_mark (exp, _, _) -> exp :: exps_to_mark) ret_exps actuals_by_ref in + List.fold + ~f:(fun exps_to_mark (exp, _, _) -> exp :: exps_to_mark) + ~init:ret_exps + actuals_by_ref in let prop_with_undef_attr = let path_pos = State.get_path_pos () in Attribute.mark_vars_as_undefined tenv @@ -1479,8 +1484,8 @@ and check_variadic_sentinel let mk_non_terminal_argsi (acc, i) a = if i < first_var_arg_pos || i >= sentinel_pos then (acc, i +1) else ((a, i):: acc, i +1) in - (* IList.fold_left reverses the arguments *) - let non_terminal_argsi = fst (IList.fold_left mk_non_terminal_argsi ([], 0) args) in + (* fold_left reverses the arguments *) + let non_terminal_argsi = fst (List.fold ~f:mk_non_terminal_argsi ~init:([], 0) args) in let check_allocated result ((lexp, typ), i) = (* simulate a Load for [lexp] *) 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__)) else 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 *) - 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 ({ 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 let exe_instr_pset pset instr = 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) diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index d44e5439e..64b33be28 100644 --- a/infer/src/backend/tabulation.ml +++ b/infer/src/backend/tabulation.ml @@ -329,10 +329,13 @@ let check_dereferences tenv callee_pname actual_pre sub spec_pre formal_params = | Sil.Hpointsto (lexp, se, _) -> check_dereference (Exp.root_of_lexp lexp) se | _ -> None in - let deref_err_list = IList.fold_left (fun deref_errs hpred -> match check_hpred hpred with - | Some reason -> reason :: deref_errs - | None -> deref_errs - ) [] spec_pre.Prop.sigma in + let deref_err_list = + List.fold + ~f:(fun deref_errs hpred -> match check_hpred hpred with + | Some reason -> reason :: deref_errs + | None -> deref_errs) + ~init:[] + spec_pre.Prop.sigma in match deref_err_list with | [] -> None | 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 else 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 *) let exp_is_exn = function @@ -807,11 +810,11 @@ let mk_pre tenv pre formal_params callee_pname callee_attrs = | [] -> pre | tainted_param_nums -> Taint.get_params_to_taint tainted_param_nums formal_params - |> IList.fold_left - (fun prop_acc (param, taint_kind) -> - let attr = PredSymb.Auntaint { taint_source = callee_pname; taint_kind; } in - Taint.add_tainting_attribute tenv attr param prop_acc) - (Prop.normalize tenv pre) + |> List.fold + ~f:(fun prop_acc (param, taint_kind) -> + let attr = PredSymb.Auntaint { taint_source = callee_pname; taint_kind; } in + Taint.add_tainting_attribute tenv attr param prop_acc) + ~init:(Prop.normalize tenv pre) |> Prop.expose else pre @@ -933,7 +936,7 @@ let inconsistent_actualpre_missing tenv actual_pre split_opt = match split_opt with | Some split -> 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'' | 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 | _ -> acc_map in let taint_untaint_exp_map = - IList.fold_left - collect_taint_untaint_exprs - Exp.Map.empty + List.fold + ~f:collect_taint_untaint_exprs + ~init:Exp.Map.empty combined_pi |> 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 diff --git a/infer/src/backend/taint.ml b/infer/src/backend/taint.ml index e18f6a4a6..c7e508d5b 100644 --- a/infer/src/backend/taint.ml +++ b/infer/src/backend/taint.ml @@ -336,7 +336,7 @@ let accepts_sensitive_params callee_pname callee_attrs_opt = else if Annotations.ia_is_privacy_sink attr then (index, PredSymb.Tk_privacy_annotation) :: acc 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) -> IList.map (fun param_num -> param_num, taint_info.PredSymb.taint_kind) tainted_param_indices @@ -364,17 +364,18 @@ let get_params_to_taint tainted_param_nums formal_params = | Some (_, taint_kind) -> (param, taint_kind) :: params_to_taint_acc | None -> params_to_taint_acc 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 *) let add_tainting_attribute tenv att pvar_param prop = - IList.fold_left - (fun prop_acc hpred -> - match hpred with - | Sil.Hpointsto (Exp.Lvar pvar, (Sil.Eexp (rhs, _)), _) - when Pvar.equal pvar pvar_param -> - L.d_strln ("TAINT ANALYSIS: setting taint/untaint attribute of parameter " ^ - (Pvar.to_string pvar)); - Attribute.add_or_replace tenv prop_acc (Apred (att, [rhs])) - | _ -> prop_acc) - prop prop.Prop.sigma + List.fold + ~f:(fun prop_acc hpred -> + match hpred with + | Sil.Hpointsto (Exp.Lvar pvar, (Sil.Eexp (rhs, _)), _) + when Pvar.equal pvar pvar_param -> + L.d_strln ("TAINT ANALYSIS: setting taint/untaint attribute of parameter " ^ + (Pvar.to_string pvar)); + Attribute.add_or_replace tenv prop_acc (Apred (att, [rhs])) + | _ -> prop_acc) + ~init:prop + prop.Prop.sigma diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index 3a49755b1..e92dd5dfc 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/infer/src/base/CommandLineOption.ml @@ -155,7 +155,8 @@ let wrap_line indent_string wrap_length line = (new_line::rev_lines, false, indent_string, indent_length) else (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) 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 have short names *) 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 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 *) @@ -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@." path (Yojson.Basic.to_string json) key msg ; 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 *) diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index 8e61742dc..d612f2572 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -1675,7 +1675,7 @@ let specs_library = Zip.close_in zip_channel in extract_specs key_dir filename; key_dir :: specs_library in - IList.fold_left add_spec_lib [] !specs_library + List.fold ~f:add_spec_lib ~init:[] !specs_library | _ -> !specs_library diff --git a/infer/src/base/IList.ml b/infer/src/base/IList.ml index 43a4e5c73..0263c91ee 100644 --- a/infer/src/base/IList.ml +++ b/infer/src/base/IList.ml @@ -9,7 +9,6 @@ let exists = List.exists let fold_left = List.fold_left -let fold_left2 = List.fold_left2 let for_all = List.for_all let for_all2 = List.for_all2 let iter = List.iter @@ -29,16 +28,6 @@ let rec last = function | [x] -> Some x | _ :: 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 = fold_left (fun list -> function | Some x -> x:: list | None -> list) [] list |> rev diff --git a/infer/src/base/IList.mli b/infer/src/base/IList.mli index 93ffcb938..e1957ec6d 100644 --- a/infer/src/base/IList.mli +++ b/infer/src/base/IList.mli @@ -10,8 +10,6 @@ (** Remove all None elements from the 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_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool 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 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 *) val map : ('a -> 'b) -> 'a list -> 'b list diff --git a/infer/src/base/SourceFile.ml b/infer/src/base/SourceFile.ml index c77aa04e1..17aa45ed1 100644 --- a/infer/src/base/SourceFile.ml +++ b/infer/src/base/SourceFile.ml @@ -142,14 +142,14 @@ let changed_files_set = from_abs_path path in Option.bind Config.changed_files_index Utils.read_file |> Option.map ~f:( - IList.fold_left - (fun changed_files line -> - let source_file = create_source_file line in - let changed_files' = Set.add source_file changed_files in - (* Add source corresponding to changed header if it exists *) - match of_header source_file with - | Some src -> Set.add src changed_files' - | None -> changed_files' - ) - Set.empty + List.fold + ~f:(fun changed_files line -> + let source_file = create_source_file line in + let changed_files' = Set.add source_file changed_files in + (* Add source corresponding to changed header if it exists *) + match of_header source_file with + | Some src -> Set.add src changed_files' + | None -> changed_files' + ) + ~init:Set.empty ) diff --git a/infer/src/base/StatisticsToolbox.re b/infer/src/base/StatisticsToolbox.re index 90ec2dbde..5b322cd26 100644 --- a/infer/src/base/StatisticsToolbox.re +++ b/infer/src/base/StatisticsToolbox.re @@ -47,7 +47,7 @@ let from_json json => { let compute_statistics 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 values_arr = Array.of_list values; Array.sort diff --git a/infer/src/base/Utils.ml b/infer/src/base/Utils.ml index 682ccb96d..4e44dfbe7 100644 --- a/infer/src/base/Utils.ml +++ b/infer/src/base/Utils.ml @@ -117,7 +117,7 @@ let filename_to_absolute ~root fname = | _ -> entry :: rev_done 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. *) diff --git a/infer/src/base/ZipLib.ml b/infer/src/base/ZipLib.ml index 48f2e9a2b..d364f9a3d 100644 --- a/infer/src/base/ZipLib.ml +++ b/infer/src/base/ZipLib.ml @@ -78,7 +78,7 @@ let zip_libraries = else (* fname is a dir of specs *) 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 zip_libs else if (Sys.file_exists Config.models_jar) = `Yes then diff --git a/infer/src/bufferoverrun/bufferOverrunChecker.ml b/infer/src/bufferoverrun/bufferOverrunChecker.ml index 781420c06..cf00e0cf8 100644 --- a/infer/src/bufferoverrun/bufferOverrunChecker.ml +++ b/infer/src/bufferoverrun/bufferOverrunChecker.ml @@ -161,7 +161,7 @@ struct | Typ.Tstruct typename -> (match Tenv.lookup tenv typename with | 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) @@ -183,7 +183,7 @@ struct (mem, inst_num + 1, sym_num) | _ -> (mem, inst_num, sym_num) (* TODO: add other cases if necessary *) 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 let instantiate_ret @@ -260,7 +260,7 @@ struct handle_unknown_call pname ret callee_pname params node mem loc) | Declare_locals (locals, _) -> (* 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 | Call _ | Remove_temps _ @@ -373,7 +373,7 @@ struct : extras ProcData.t -> CFG.node -> Sil.instr list -> Dom.Mem.t -> Dom.ConditionSet.t -> Dom.ConditionSet.t = 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 let collect_node diff --git a/infer/src/bufferoverrun/bufferOverrunSemantics.ml b/infer/src/bufferoverrun/bufferOverrunSemantics.ml index 42e91e41c..9ae5e59c8 100644 --- a/infer/src/bufferoverrun/bufferOverrunSemantics.ml +++ b/infer/src/bufferoverrun/bufferOverrunSemantics.ml @@ -299,7 +299,7 @@ struct (match Tenv.lookup tenv typename with | Some str -> 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) | Typ.Tptr (_ ,_) -> let v1' = deref_ptr v1 callee_mem in @@ -321,13 +321,13 @@ struct else assert false | _ -> assert false 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 : Val.t -> ('a -> Val.t -> 'b -> 'b) -> 'a list -> Val.t list -> 'b -> 'b = fun default f xs ys acc -> 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 | 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) diff --git a/infer/src/checkers/AbstractInterpreter.ml b/infer/src/checkers/AbstractInterpreter.ml index 4166ae613..24cef212b 100644 --- a/infer/src/checkers/AbstractInterpreter.ml +++ b/infer/src/checkers/AbstractInterpreter.ml @@ -83,7 +83,8 @@ module MakeNoCFG | l -> l in let underlying_node = CFG.underlying_node node in 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 then begin @@ -120,9 +121,10 @@ module MakeNoCFG let normal_posts = IList.map extract_post_ (CFG.normal_preds cfg node) in (* 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 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 - | post :: posts -> Some (IList.fold_left Domain.join post posts) + | post :: posts -> Some (List.fold ~f:Domain.join ~init:post posts) | [] -> None in match Scheduler.pop work_queue with | Some (_, [], work_queue') -> diff --git a/infer/src/checkers/FormalMap.ml b/infer/src/checkers/FormalMap.ml index 1172a18ed..86733e3c4 100644 --- a/infer/src/checkers/FormalMap.ml +++ b/infer/src/checkers/FormalMap.ml @@ -23,9 +23,9 @@ let make pdesc = let pvar = Pvar.mk name pname in AccessPath.base_of_pvar pvar typ, index) attrs.ProcAttributes.formals in - IList.fold_left - (fun formal_map (base, index) -> AccessPath.BaseMap.add base index formal_map) - AccessPath.BaseMap.empty + List.fold + ~f:(fun formal_map (base, index) -> AccessPath.BaseMap.add base index formal_map) + ~init:AccessPath.BaseMap.empty formals_with_nums let empty = AccessPath.BaseMap.empty diff --git a/infer/src/checkers/SinkTrace.ml b/infer/src/checkers/SinkTrace.ml index dcb1f9031..2c98ee41c 100644 --- a/infer/src/checkers/SinkTrace.ml +++ b/infer/src/checkers/SinkTrace.ml @@ -59,11 +59,11 @@ module Make (TraceElem : TraceElem.S) = struct to_loc_trace ?desc_of_sink ?sink_should_nest (passthroughs, [], sinks) let with_callsite t call_site = - IList.fold_left - (fun t_acc sink -> - let callee_sink = Sink.with_callsite sink call_site in - add_sink callee_sink t_acc) - empty + List.fold + ~f:(fun t_acc sink -> + let callee_sink = Sink.with_callsite sink call_site in + add_sink callee_sink t_acc) + ~init:empty (Sinks.elements (sinks t)) let pp fmt t = diff --git a/infer/src/checkers/Siof.ml b/infer/src/checkers/Siof.ml index 64d033948..ee01baf12 100644 --- a/infer/src/checkers/Siof.ml +++ b/infer/src/checkers/Siof.ml @@ -109,7 +109,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let add_params_globals astate pdesc call_loc 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) let at_least_nonbottom = diff --git a/infer/src/checkers/SiofDomain.ml b/infer/src/checkers/SiofDomain.ml index 29a20cc87..e641fb07c 100644 --- a/infer/src/checkers/SiofDomain.ml +++ b/infer/src/checkers/SiofDomain.ml @@ -31,7 +31,9 @@ let normalize ((trace, initialized) as astate) = match trace with let loc = CallSite.loc (SiofTrace.Sink.call_site access) in let kind = 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' = SiofTrace.make_access kind loc::indirect |> SiofTrace.Sinks.of_list diff --git a/infer/src/checkers/SiofTrace.ml b/infer/src/checkers/SiofTrace.ml index 7d6beee0e..28ec30e43 100644 --- a/infer/src/checkers/SiofTrace.ml +++ b/infer/src/checkers/SiofTrace.ml @@ -93,7 +93,7 @@ let trace_of_error loc gname path = [] ::err_trace in GlobalsAccesses.elements globals - |> IList.fold_left add_trace_elem_of_access rest + |> List.fold ~f:add_trace_elem_of_access ~init:rest |> IList.rev | _ -> trace_with_set_of_globals in diff --git a/infer/src/checkers/ThreadSafety.ml b/infer/src/checkers/ThreadSafety.ml index f8b918dfb..730689b64 100644 --- a/infer/src/checkers/ThreadSafety.ml +++ b/infer/src/checkers/ThreadSafety.ml @@ -173,13 +173,13 @@ module TransferFunctions (CFG : ProcCfg.S) = struct then path_state else - IList.fold_left - (fun acc rawpath -> - if not (is_owned (AccessPath.Raw.truncate rawpath) attribute_map) && - not (is_safe_write rawpath tenv) - then Domain.PathDomain.add_sink (Domain.make_access rawpath loc) acc - else acc) - path_state + List.fold + ~f:(fun acc rawpath -> + if not (is_owned (AccessPath.Raw.truncate rawpath) attribute_map) && + not (is_safe_write rawpath tenv) + then Domain.PathDomain.add_sink (Domain.make_access rawpath loc) acc + else acc) + ~init:path_state (AccessPath.of_exp exp typ ~f_resolve_id) 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 the current state *) 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 then acc @@ -419,9 +419,9 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let combined_unconditional_writes = PathDomain.with_callsite callee_unconditional_writes call_site |> PathDomain.join astate.unconditional_writes in - IList.fold_lefti - add_conditional_writes - (astate.conditional_writes, combined_unconditional_writes) + List.foldi + ~f:add_conditional_writes + ~init:(astate.conditional_writes, combined_unconditional_writes) actuals in let reads = PathDomain.with_callsite callee_reads call_site @@ -572,9 +572,9 @@ module TransferFunctions (CFG : ProcCfg.S) = struct | Sil.Remove_temps (ids, _) -> let id_map = - IList.fold_left - (fun acc id -> IdAccessPathMapDomain.remove (Var.of_id id) acc) - astate.id_map + List.fold + ~f:(fun acc id -> IdAccessPathMapDomain.remove (Var.of_id id) acc) + ~init:astate.id_map ids in { 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 = (* make a Map sending each element e of list l to (f e) *) let map_post_computation_over_procs f l = - IList.fold_left (fun m p -> ResultsTableType.add p (f p) m - ) ResultsTableType.empty l - in + List.fold + ~f:(fun m p -> ResultsTableType.add p (f p) m) + ~init:ResultsTableType.empty + l in let is_initializer tenv proc_name = Procname.is_constructor proc_name || FbThreadSafety.is_custom_init tenv proc_name in let compute_post_for_procedure = (* takes proc_env as arg *) diff --git a/infer/src/checkers/Trace.ml b/infer/src/checkers/Trace.ml index ccd55dae1..16f47ccbd 100644 --- a/infer/src/checkers/Trace.ml +++ b/infer/src/checkers/Trace.ml @@ -290,7 +290,7 @@ module Make (Spec : Spec) = struct let loc2 = CallSite.loc (Passthrough.site passthrough2) in Int.compare loc1.Location.line loc2.Location.line) (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 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 sinks_with_level = get_nesting sink_should_nest sinks 0 in 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 - IList.fold_left - (fun acc source -> trace_elems_of_source source acc) trace_prefix sources_with_level + List.fold + ~f:(fun acc source -> trace_elems_of_source source acc) + ~init:trace_prefix + sources_with_level let of_source source = let sources = Sources.singleton source in diff --git a/infer/src/checkers/addressTaken.ml b/infer/src/checkers/addressTaken.ml index 93966dd93..7fc880634 100644 --- a/infer/src/checkers/addressTaken.ml +++ b/infer/src/checkers/addressTaken.ml @@ -37,7 +37,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let add_actual_by_ref astate_acc = function | actual_exp, Typ.Tptr _ -> add_address_taken_pvars actual_exp astate_acc | _ -> 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 _ | Declare_locals _ -> astate diff --git a/infer/src/checkers/annotationReachability.ml b/infer/src/checkers/annotationReachability.ml index cfa9aec5c..2550fe922 100644 --- a/infer/src/checkers/annotationReachability.ml +++ b/infer/src/checkers/annotationReachability.ml @@ -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_trace = update_trace call_loc trace |> update_trace callee_def_loc in let unseen_pnames, updated_visited = - IList.fold_left - (fun (accu, set) call_site -> - let p = CallSite.pname call_site in - let loc = CallSite.loc call_site in - if Procname.Set.mem p set then (accu, set) - else ((p, loc) :: accu, Procname.Set.add p set)) - ([], visited_pnames) next_calls in + List.fold + ~f:(fun (accu, set) call_site -> + let p = CallSite.pname call_site in + let loc = CallSite.loc call_site in + if Procname.Set.mem p set then (accu, set) + else ((p, loc) :: accu, Procname.Set.add p set)) + ~init:([], visited_pnames) + next_calls in IList.iter (loop fst_call_loc updated_visited (new_trace, new_stack_str)) unseen_pnames in IList.iter (fun fst_call_site -> @@ -390,9 +391,10 @@ module Interprocedural = struct let initial = let init_map = - IList.fold_left - (fun astate_acc (_, snk_annot) -> CallsDomain.add snk_annot CallSiteSet.empty astate_acc) - CallsDomain.empty + List.fold + ~f:(fun astate_acc (_, snk_annot) -> + CallsDomain.add snk_annot CallSiteSet.empty astate_acc) + ~init:CallsDomain.empty (src_snk_pairs ()) in Domain.NonBottom (init_map, Domain.TrackingVar.empty) in diff --git a/infer/src/checkers/checkTraceCallSequence.ml b/infer/src/checkers/checkTraceCallSequence.ml index cd8aa144e..567420993 100644 --- a/infer/src/checkers/checkTraceCallSequence.ml +++ b/infer/src/checkers/checkTraceCallSequence.ml @@ -123,7 +123,7 @@ module State = struct let map2 (f : Elem.t -> Elem.t list) (s : t) : t = let l = ElemSet.elements s 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 = map2 (fun elem -> [f elem]) s diff --git a/infer/src/checkers/constantPropagation.ml b/infer/src/checkers/constantPropagation.ml index d68172009..a35768cde 100644 --- a/infer/src/checkers/constantPropagation.ml +++ b/infer/src/checkers/constantPropagation.ml @@ -117,9 +117,9 @@ module ConstantFlow = Dataflow.MakeDF(struct (Procdesc.Node.get_instrs node) end; let constants = - IList.fold_left - do_instr - constants + List.fold + ~f:do_instr + ~init:constants (Procdesc.Node.get_instrs node) in if verbose then L.stdout "%a\n@." pp constants; [constants], [constants] diff --git a/infer/src/checkers/copyPropagation.ml b/infer/src/checkers/copyPropagation.ml index 9aac9d252..b6587e94a 100644 --- a/infer/src/checkers/copyPropagation.ml +++ b/infer/src/checkers/copyPropagation.ml @@ -104,7 +104,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let astate' = Option.value_map ~f:kill_ret_id ~default:astate ret_id in if Config.curr_language_is Config.Java 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 _ -> (* none of these can assign to program vars or logical vars *) astate diff --git a/infer/src/checkers/dataflow.ml b/infer/src/checkers/dataflow.ml index a0110fb64..d66108c37 100644 --- a/infer/src/checkers/dataflow.ml +++ b/infer/src/checkers/dataflow.ml @@ -100,9 +100,9 @@ module MakeDF(St: DFStateType) : DF with type state = St.t = struct | Transition of state * state list * state list let join states initial_state = - IList.fold_left - St.join - initial_state + List.fold + ~f:St.join + ~init:initial_state states (** Propagate [new_state] to all the nodes immediately reachable. *) diff --git a/infer/src/checkers/liveness.ml b/infer/src/checkers/liveness.ml index fe49c6887..6892adced 100644 --- a/infer/src/checkers/liveness.ml +++ b/infer/src/checkers/liveness.ml @@ -27,8 +27,14 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let exp_add_live exp astate = let (ids, pvars) = Exp.get_vars exp in let astate' = - IList.fold_left (fun astate_acc id -> Domain.add (Var.of_id id) astate_acc) astate ids in - IList.fold_left (fun astate_acc pvar -> Domain.add (Var.of_pvar pvar) astate_acc) astate' pvars + List.fold + ~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 | 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) ~default:astate ret_id |> 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 _ -> astate end diff --git a/infer/src/checkers/procCfg.ml b/infer/src/checkers/procCfg.ml index 597c01c7a..58d988dd2 100644 --- a/infer/src/checkers/procCfg.ml +++ b/infer/src/checkers/procCfg.ml @@ -156,9 +156,9 @@ module Exceptional = struct Procdesc.IdMap.add exn_succ_node_id (n :: existing_exn_preds) exn_preds_acc else 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 = - 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 let instrs = Procdesc.Node.get_instrs diff --git a/infer/src/checkers/scheduler.ml b/infer/src/checkers/scheduler.ml index 9145c4162..d388cfb26 100644 --- a/infer/src/checkers/scheduler.ml +++ b/infer/src/checkers/scheduler.ml @@ -77,7 +77,7 @@ module ReversePostorder (CFG : ProcCfg.S) = struct 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 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; } (* remove and return the node with the highest priority (note that smaller integers have higher diff --git a/infer/src/clang/ClangCommand.re b/infer/src/clang/ClangCommand.re index ca9ae7f69..0273c7c5e 100644 --- a/infer/src/clang/ClangCommand.re +++ b/infer/src/clang/ClangCommand.re @@ -32,8 +32,8 @@ let plugin_name = "BiniouASTExporter"; let infer_cxx_models = Config.cxx; let value_of_argv_option argv opt_name => - IList.fold_left - ( + List.fold + f::( fun (prev_arg, result) arg => { let result' = if (Option.is_some result) { @@ -46,7 +46,7 @@ let value_of_argv_option argv opt_name => (arg, result') } ) - ("", None) + init::("", None) argv |> snd; let value_of_option {orig_argv} => value_of_argv_option orig_argv; diff --git a/infer/src/clang/cAst_utils.ml b/infer/src/clang/cAst_utils.ml index 684e90947..b145e7957 100644 --- a/infer/src/clang/cAst_utils.ml +++ b/infer/src/clang/cAst_utils.ml @@ -60,7 +60,7 @@ let fold_qual_name qual_name_list = match qual_name_list with | [] -> "" | 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 no_slash_space diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index 10b1c1fe9..9c6445942 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -98,4 +98,4 @@ let modelled_field class_name_info = let name = CGeneral_utils.mk_class_field_name field_name_qualified in (name, typ, Annot.Item.empty) :: res 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 diff --git a/infer/src/clang/cFrontend_checkers.ml b/infer/src/clang/cFrontend_checkers.ml index 767f98296..616049580 100644 --- a/infer/src/clang/cFrontend_checkers.ml +++ b/infer/src/clang/cFrontend_checkers.ml @@ -99,4 +99,4 @@ let cxx_ref_captured_in_block an = | _ -> [] in let var_desc vars var_named_decl_info = vars ^ "'" ^ var_named_decl_info.ni_name ^ "'" in - IList.fold_left var_desc "" capt_refs + List.fold ~f:var_desc ~init:"" capt_refs diff --git a/infer/src/clang/cFrontend_errors.ml b/infer/src/clang/cFrontend_errors.ml index 5224dfb65..183e54af0 100644 --- a/infer/src/clang/cFrontend_errors.ml +++ b/infer/src/clang/cFrontend_errors.ml @@ -103,7 +103,7 @@ let make_condition_issue_desc_pair checkers = severity = Exceptions.Kwarning; mode = CIssue.On; } in - let issue, condition = IList.fold_left (fun (issue', cond') d -> + let issue, condition = List.fold ~f:(fun (issue', cond') d -> match d with | CSet (s, phi) when String.equal s report_when_const -> issue', phi @@ -115,7 +115,7 @@ let make_condition_issue_desc_pair checkers = {issue' with severity = string_to_err_kind sev}, cond' | CDesc (s, m) when String.equal s mode_const -> {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 ( Logging.out "\nMaking condition and issue desc for checker '%s'\n" c.name; @@ -159,15 +159,15 @@ let expand_checkers checkers = let expand_one_checker c = 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 = 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 - | _ -> map') map c.definitions in - let exp_defs = IList.fold_left (fun defs clause -> + | _ -> map') ~init:map c.definitions in + let exp_defs = List.fold ~f:(fun defs clause -> match clause with | CSet (report_when_const, phi) -> Logging.out " -Expanding report_when\n"; 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 let expanded_checkers = IList.map expand_one_checker checkers in expanded_checkers diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index b209b63e1..de34b8069 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -351,7 +351,7 @@ let sil_method_annotation_of_args args : Annot.Method.t = if CAst_utils.is_type_nullable qt_type_ptr then [mk_annot arg_name Annotations.nullable] :: acc 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 *) let retval_annot = [] in retval_annot, param_annots diff --git a/infer/src/clang/cPredicates.ml b/infer/src/clang/cPredicates.ml index 7babf3e0f..4f794087f 100644 --- a/infer/src/clang/cPredicates.ml +++ b/infer/src/clang/cPredicates.ml @@ -53,7 +53,7 @@ let captured_variables_cxx_ref an = | _ -> reference_captured_vars in match an with | 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 | _ -> [] diff --git a/infer/src/clang/cVar_decl.ml b/infer/src/clang/cVar_decl.ml index b29ead81f..36d570e4b 100644 --- a/infer/src/clang/cVar_decl.ml +++ b/infer/src/clang/cVar_decl.ml @@ -105,4 +105,4 @@ let captured_vars_from_block_info context cvl = (pvar, typ) :: vars | _ -> assert false) | _ -> assert false in - IList.fold_right sil_var_of_captured_var cvl [] + List.fold_right ~f:sil_var_of_captured_var cvl ~init:[] diff --git a/infer/src/clang/objcProperty_decl.ml b/infer/src/clang/objcProperty_decl.ml index 5aa2aad8e..7a9e8386f 100644 --- a/infer/src/clang/objcProperty_decl.ml +++ b/infer/src/clang/objcProperty_decl.ml @@ -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 meth_name:: list_methods | _ -> list_methods in - IList.fold_right get_method decl_list [] + List.fold_right ~f:get_method decl_list ~init:[] diff --git a/infer/src/eradicate/eradicate.ml b/infer/src/eradicate/eradicate.ml index 5ffa99119..c86ee0d65 100644 --- a/infer/src/eradicate/eradicate.ml +++ b/infer/src/eradicate/eradicate.ml @@ -78,7 +78,10 @@ struct TypeState.add pvar (typ, ta, []) typestate in let get_initial_typestate () = 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. *) let check_return find_canonical_duplicate exit_node final_typestate ret_ia ret_type loc : unit = diff --git a/infer/src/eradicate/eradicateChecks.ml b/infer/src/eradicate/eradicateChecks.ml index 059536ec0..dc89a3656 100644 --- a/infer/src/eradicate/eradicateChecks.ml +++ b/infer/src/eradicate/eradicateChecks.ml @@ -549,7 +549,7 @@ let check_overridden_annotations and overridden_params = overriden_signature.AnnotatedSignature.params 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 - 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 = match Specs.proc_resolve_attributes overriden_proc_name with diff --git a/infer/src/eradicate/typeCheck.ml b/infer/src/eradicate/typeCheck.ml index 5a41eaeb3..ce0efd29e 100644 --- a/infer/src/eradicate/typeCheck.ml +++ b/infer/src/eradicate/typeCheck.ml @@ -470,7 +470,7 @@ let typecheck_instr match instr with | 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 | Sil.Declare_locals _ | Sil.Abstract _ @@ -596,7 +596,7 @@ let typecheck_instr typecheck_expr_for_errors typestate e1 loc; let e2, typestate2 = convert_complex_exp_to_pvar node false e1 typestate1 loc in (((e1, e2), t1) :: etl1), typestate2 in - IList.fold_right handle_et etl ([], typestate) in + List.fold_right ~f:handle_et etl ~init:([], typestate) in let annotated_signature = Models.get_modelled_annotated_signature callee_attributes in @@ -669,7 +669,7 @@ let typecheck_instr pvar_apply loc clear_nullable_flag ts pvar1 | _ -> ts 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 pvar_apply loc clear_nullable_flag typestate' pvar | 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. *) 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 = Procdesc.Node.equal_nodekind (Procdesc.Node.get_kind node) diff --git a/infer/src/harness/androidFramework.ml b/infer/src/harness/androidFramework.ml index 69b2ffd90..917d8598f 100644 --- a/infer/src/harness/androidFramework.ml +++ b/infer/src/harness/androidFramework.ml @@ -97,10 +97,10 @@ let get_lifecycle_for_framework_typ_opt tenv lifecycle_typ lifecycle_proc_strs = ) methods in (* convert each of the framework lifecycle proc strings to a lifecycle method procname *) 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 with Not_found -> lifecycle_procs) - [] lifecycle_proc_strs in + ~init:[] lifecycle_proc_strs in lifecycle_procs | _ -> [] diff --git a/infer/src/harness/harness.ml b/infer/src/harness/harness.ml index 160049f5d..f05d66670 100644 --- a/infer/src/harness/harness.ml +++ b/infer/src/harness/harness.ml @@ -22,13 +22,13 @@ let try_create_lifecycle_trace name lifecycle_name lifecycle_procs tenv = if PatternMatch.is_subtype tenv name lifecycle_name && not (AndroidFramework.is_android_lib_class name) then let ptr_to_struct_typ = Some (Typ.Tptr (Tstruct name, Pk_pointer)) in - IList.fold_left - (fun trace lifecycle_proc -> - (* given a lifecycle subclass T, resolve the call T.lifecycle_proc() to the procname - * that will actually be called at runtime *) - let resolved_proc = SymExec.resolve_method tenv name lifecycle_proc in - (resolved_proc, ptr_to_struct_typ) :: trace) - [] + List.fold + ~f:(fun trace lifecycle_proc -> + (* given a lifecycle subclass T, resolve the call T.lifecycle_proc() to the procname + * that will actually be called at runtime *) + let resolved_proc = SymExec.resolve_method tenv name lifecycle_proc in + (resolved_proc, ptr_to_struct_typ) :: trace) + ~init:[] lifecycle_procs else [] diff --git a/infer/src/harness/inhabit.ml b/infer/src/harness/inhabit.ml index 34f5a9880..7c6dd26b4 100644 --- a/infer/src/harness/inhabit.ml +++ b/infer/src/harness/inhabit.ml @@ -153,7 +153,7 @@ and inhabit_args tenv formals cfg env = let inhabit_arg (_, formal_typ) (args, env) = let (exp, env) = inhabit_typ tenv formal_typ cfg 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 * remaining arguments *) @@ -272,7 +272,11 @@ let inhabit_trace tenv trace harness_name cg cfg = cur_inhabiting = TypSet.empty; harness_name = harness_name; } in (* 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 setup_harness_cfg harness_name env'' cg cfg; write_harness_to_file (IList.rev env''.instrs) harness_filename diff --git a/infer/src/integration/CaptureCompilationDatabase.ml b/infer/src/integration/CaptureCompilationDatabase.ml index d407ed674..bd9af3c92 100644 --- a/infer/src/integration/CaptureCompilationDatabase.ml +++ b/infer/src/integration/CaptureCompilationDatabase.ml @@ -114,7 +114,7 @@ let get_compilation_database_files_buck () = (String.concat ~sep:"\n" lines); let scan_output compilation_database_files chan = 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, _, _) -> Process.print_error_and_exit "Cannot execute %s\n%!" diff --git a/infer/src/java/jClasspath.ml b/infer/src/java/jClasspath.ml index 8d1348320..783f35e8e 100644 --- a/infer/src/java/jClasspath.ml +++ b/infer/src/java/jClasspath.ml @@ -56,7 +56,7 @@ let collect_specs_filenames jar_filename = let proc_filename = (Filename.chop_extension (Filename.basename filename)) in String.Set.add set proc_filename in 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; Zip.close_in zip_channel @@ -187,9 +187,9 @@ let load_from_verbose_output javac_verbose_out = | End_of_file -> In_channel.close file_in; let classpath = - IList.fold_left - append_path - "" + List.fold + ~f:append_path + ~init:"" ((String.Set.elements roots) @ paths) in (classpath, sources, classes) in loop [] String.Set.empty String.Map.empty JBasics.ClassSet.empty @@ -207,15 +207,15 @@ let extract_classnames classnames jar_filename = | basename, Some "class" -> (classname_of_class_filename basename) :: classes | _ -> 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; classnames_after let collect_classnames start_classmap jar_filename = - IList.fold_left - (fun map cn -> JBasics.ClassSet.add cn map) - start_classmap + List.fold + ~f:(fun map cn -> JBasics.ClassSet.add cn map) + ~init:start_classmap (extract_classnames [] jar_filename) @@ -238,9 +238,9 @@ let search_classes path = let search_sources () = let initial_map = - IList.fold_left - (fun map path -> add_source_file path map) - String.Map.empty + List.fold + ~f:(fun map path -> add_source_file path map) + ~init:String.Map.empty Config.sources in match Config.sourcepath with | None -> initial_map @@ -259,7 +259,7 @@ let load_from_arguments classes_out_path = let split cp_option = Option.value_map ~f:split_classpath ~default:[] cp_option in 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 = combine (split Config.classpath) "" |> combine (String.Set.elements roots) @@ -317,9 +317,9 @@ let collect_classes start_classmap jar_filename = with JBasics.Class_structure_error _ -> classmap in let classmap = - IList.fold_left - collect - start_classmap + List.fold + ~f:collect + ~init:start_classmap (extract_classnames [] jar_filename) in Javalib.close_class_path classpath; classmap diff --git a/infer/src/java/jFrontend.ml b/infer/src/java/jFrontend.ml index cdf620b95..0a3aa6630 100644 --- a/infer/src/java/jFrontend.ml +++ b/infer/src/java/jFrontend.ml @@ -97,7 +97,8 @@ let add_cmethod source_file program linereader icfg cm proc_name = let path_of_cached_classname cn = 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") diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index b26878bc8..0db4003f4 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -133,7 +133,7 @@ let formals_from_signature program tenv cn ms kind = let init_arg_list = match kind with | Procname.Static -> [] | Procname.Non_Static -> [(JConfig.this, JTransType.get_class_type program tenv cn)] in - 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 ... *) 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 typ = JTransType.param_type program tenv cn var vt 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 the JBir representation *) let translate_locals program tenv formals bytecode jbir_code = let formal_set = - IList.fold_left - (fun set (var, _) -> Mangled.Set.add var set) - Mangled.Set.empty + List.fold + ~f:(fun set (var, _) -> Mangled.Set.add var set) + ~init:Mangled.Set.empty formals in let collect (seen_vars, l) (var, typ) = 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 | None -> init | Some variable_table -> - IList.fold_left - (fun accu (_, _, var_name, var_type, _) -> - let var = Mangled.from_string var_name - and typ = JTransType.value_type program tenv var_type in - collect accu (var, typ)) - init + List.fold + ~f:(fun accu (_, _, var_name, var_type, _) -> + let var = Mangled.from_string var_name + and typ = JTransType.value_type program tenv var_type in + collect accu (var, typ)) + ~init variable_table in (* TODO (#4040807): Needs to add the JBir temporary variables since other parts of the code are still relying on those *) @@ -555,11 +555,11 @@ let method_invocation | _ -> [] in (instrs, [(sil_obj_expr, sil_obj_type)]) in let (instrs, call_args) = - IList.fold_left - (fun (instrs_accu, args_accu) expr -> - let (instrs, sil_expr, sil_expr_type) = expression context pc expr in - (instrs_accu @ instrs, args_accu @ [(sil_expr, sil_expr_type)])) - init + List.fold + ~f:(fun (instrs_accu, args_accu) expr -> + let (instrs, sil_expr, sil_expr_type) = expression context pc expr in + (instrs_accu @ instrs, args_accu @ [(sil_expr, sil_expr_type)])) + ~init expr_list in let callee_procname = 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 | (other_instrs, other_exprs) -> (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, _) = (Typ.Tarray (content_type, None), Some sil_len_expr) in 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 (instrs, array_size) diff --git a/infer/src/java/jTransExn.ml b/infer/src/java/jTransExn.ml index c5a15b6ce..ac8965f64 100644 --- a/infer/src/java/jTransExn.ml +++ b/infer/src/java/jTransExn.ml @@ -105,7 +105,7 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle collect succ_nodes remove_temps handler in 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 | n:: _ -> Procdesc.Node.get_loc n | [] -> Location.dummy in diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 4ac1e5dcb..5d2abc129 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -265,8 +265,8 @@ let add_model_fields program classpath_fields cn = let statics, nonstatics = classpath_fields in let classpath_field_map = let collect_fields map = - IList.fold_left - (fun map (fn, ft, _) -> Ident.FieldMap.add fn ft map) map in + List.fold + ~f:(fun map (fn, ft, _) -> Ident.FieldMap.add fn ft map) ~init:map in collect_fields (collect_fields Ident.FieldMap.empty statics) nonstatics in try match JBasics.ClassMap.find cn (JClasspath.get_models program) with diff --git a/infer/src/quandary/TaintAnalysis.ml b/infer/src/quandary/TaintAnalysis.ml index 6a0b006cd..29e44c486 100644 --- a/infer/src/quandary/TaintAnalysis.ml +++ b/infer/src/quandary/TaintAnalysis.ml @@ -217,7 +217,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct end | None -> 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'; } let apply_summary @@ -376,7 +376,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct let initial_trace = access_path_get_trace access_path astate.access_tree proc_data callee_loc in 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 = TaintDomain.add_trace access_path trace_with_propagation astate.access_tree in { astate with access_tree; } in @@ -407,7 +407,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct (Option.map ~f:snd ret) actuals 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 call_site = CallSite.make callee_pname callee_loc in @@ -459,7 +459,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct [called_pname] end in (* 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 _ -> failwith "Unimp: non-pname call expressions" | Sil.Nullify (pvar, _) -> @@ -467,9 +467,9 @@ module Make (TaintSpecification : TaintSpec.S) = struct { astate with id_map; } | Sil.Remove_temps (ids, _) -> let id_map = - IList.fold_left - (fun acc id -> IdMapDomain.remove (Var.of_id id) acc) - astate.id_map + List.fold + ~f:(fun acc id -> IdMapDomain.remove (Var.of_id id) acc) + ~init:astate.id_map ids in { astate with id_map; } | Sil.Prune _ | Abstract _ | Declare_locals _ -> @@ -500,14 +500,14 @@ module Make (TaintSpecification : TaintSpec.S) = struct let make_initial pdesc = let pname = Procdesc.get_proc_name pdesc in 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 | Some source -> let base_ap = AccessPath.Exact (AccessPath.of_pvar (Pvar.mk name pname) typ) in TaintDomain.add_trace base_ap (TraceDomain.of_source source) acc | None -> acc) - TaintDomain.empty + ~init:TaintDomain.empty (TraceDomain.Source.get_tainted_formals pdesc tenv) in if TaintDomain.BaseMap.is_empty access_tree then Domain.empty diff --git a/infer/src/unit/analyzerTester.ml b/infer/src/unit/analyzerTester.ml index 65d12c6af..2104957ca 100644 --- a/infer/src/unit/analyzerTester.ml +++ b/infer/src/unit/analyzerTester.ml @@ -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 *) node, M.add (CFG.id node) (inv_str, inv_label) assert_map and structured_instrs_to_node last_node assert_map exn_handlers instrs = - IList.fold_left - (fun acc instr -> structured_instr_to_node acc exn_handlers instr) - (last_node, assert_map) + List.fold + ~f:(fun acc instr -> structured_instr_to_node acc exn_handlers instr) + ~init:(last_node, assert_map) instrs in let start_node = create_node (Procdesc.Node.Start_node pname) [] in Procdesc.set_start_node pdesc start_node;