From b1b5460529579106d1438743c81063bcbcac54c4 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 23 Feb 2017 08:19:08 -0800 Subject: [PATCH] Deprecate further IList functions Reviewed By: jberdine Differential Revision: D4597524 fbshipit-source-id: 87a5e34 --- infer/src/IR/AttributesTable.re | 6 +- infer/src/IR/Cfg.re | 20 +- infer/src/IR/Cg.re | 8 +- infer/src/IR/Exp.re | 2 +- infer/src/IR/Procdesc.re | 4 +- infer/src/IR/Procname.re | 2 +- infer/src/IR/Sil.re | 94 ++++---- infer/src/IR/Sil.rei | 4 +- infer/src/backend/Attribute.ml | 8 +- infer/src/backend/BuiltinDefn.ml | 32 +-- infer/src/backend/InferAnalyze.re | 6 +- infer/src/backend/InferPrint.re | 25 +-- infer/src/backend/PerfStats.ml | 4 +- infer/src/backend/PropUtil.re | 8 +- infer/src/backend/StatsAggregator.re | 12 +- infer/src/backend/abs.ml | 86 ++++---- infer/src/backend/absarray.ml | 42 ++-- infer/src/backend/buckets.ml | 2 +- infer/src/backend/callbacks.ml | 11 +- infer/src/backend/crashcontext.ml | 6 +- infer/src/backend/dom.ml | 203 +++++++++--------- infer/src/backend/dotty.ml | 69 +++--- infer/src/backend/errdesc.ml | 14 +- infer/src/backend/infer.ml | 4 +- infer/src/backend/inferconfig.ml | 10 +- infer/src/backend/interproc.ml | 87 ++++---- infer/src/backend/match.ml | 32 +-- infer/src/backend/mergeCapture.ml | 2 +- infer/src/backend/paths.ml | 2 +- infer/src/backend/preanal.ml | 10 +- infer/src/backend/printer.ml | 32 +-- infer/src/backend/prop.ml | 130 +++++------ infer/src/backend/propgraph.ml | 16 +- infer/src/backend/propset.ml | 6 +- infer/src/backend/prover.ml | 34 +-- infer/src/backend/rearrange.ml | 54 +++-- infer/src/backend/specs.ml | 25 +-- infer/src/backend/state.ml | 10 +- infer/src/backend/symExec.ml | 90 ++++---- infer/src/backend/tabulation.ml | 126 +++++------ infer/src/backend/taint.ml | 16 +- infer/src/base/CommandLineOption.ml | 16 +- infer/src/base/Config.ml | 16 +- infer/src/base/IList.ml | 41 +--- infer/src/base/IList.mli | 18 -- infer/src/base/SourceFile.ml | 2 +- infer/src/base/StatisticsToolbox.re | 2 +- infer/src/bufferoverrun/arrayBlk.ml | 2 +- .../src/bufferoverrun/bufferOverrunChecker.ml | 2 +- .../src/bufferoverrun/bufferOverrunDomain.ml | 2 +- .../bufferoverrun/bufferOverrunSemantics.ml | 6 +- infer/src/bufferoverrun/itv.ml | 102 ++++----- infer/src/checkers/AbstractInterpreter.ml | 6 +- infer/src/checkers/BoundedCallTree.ml | 28 +-- infer/src/checkers/FormalMap.ml | 4 +- infer/src/checkers/Sink.ml | 4 +- infer/src/checkers/SinkTrace.ml | 4 +- infer/src/checkers/Siof.ml | 4 +- infer/src/checkers/SiofDomain.ml | 2 +- infer/src/checkers/Source.ml | 9 +- infer/src/checkers/Stacktrace.ml | 8 +- infer/src/checkers/Trace.ml | 24 +-- infer/src/checkers/annotationReachability.ml | 8 +- infer/src/checkers/checkDeadCode.ml | 2 +- infer/src/checkers/checkTraceCallSequence.ml | 2 +- infer/src/checkers/checkers.ml | 12 +- infer/src/checkers/liveness.ml | 2 +- infer/src/checkers/patternMatch.ml | 10 +- infer/src/checkers/printfArgs.ml | 12 +- infer/src/checkers/procCfg.ml | 8 +- infer/src/checkers/registerCheckers.ml | 4 +- infer/src/checkers/scheduler.ml | 2 +- infer/src/checkers/sqlChecker.ml | 2 +- infer/src/clang/CType_decl.ml | 10 +- infer/src/clang/ClangCommand.re | 2 +- infer/src/clang/ComponentKit.ml | 6 +- infer/src/clang/ast_expressions.ml | 2 +- infer/src/clang/cAst_utils.ml | 2 +- infer/src/clang/cContext.ml | 2 +- infer/src/clang/cField_decl.ml | 2 +- infer/src/clang/cFrontend_errors.ml | 8 +- infer/src/clang/cGeneral_utils.ml | 2 +- infer/src/clang/cMethod_signature.ml | 4 +- infer/src/clang/cMethod_trans.ml | 14 +- infer/src/clang/cPredicates.ml | 2 +- infer/src/clang/cTL.ml | 6 +- infer/src/clang/cTrans.ml | 52 ++--- infer/src/clang/cTrans_utils.ml | 16 +- infer/src/clang/objcInterface_decl.ml | 4 +- infer/src/eradicate/eradicate.ml | 2 +- infer/src/eradicate/eradicateChecks.ml | 6 +- infer/src/eradicate/modelTables.ml | 2 +- infer/src/eradicate/typeCheck.ml | 20 +- infer/src/harness/inhabit.ml | 2 +- .../integration/CaptureCompilationDatabase.ml | 2 +- infer/src/integration/ClangQuotes.re | 2 +- infer/src/java/jAnnotation.ml | 6 +- infer/src/java/jTrans.ml | 10 +- infer/src/java/jTransType.ml | 2 +- infer/src/quandary/ClangTrace.ml | 4 +- infer/src/quandary/JavaTrace.ml | 6 +- infer/src/quandary/QuandaryConfig.ml | 4 +- infer/src/quandary/TaintAnalysis.ml | 15 +- infer/src/unit/TraceTests.ml | 2 +- infer/src/unit/accessPathTestUtils.ml | 4 +- infer/src/unit/accessTreeTests.ml | 2 +- infer/src/unit/addressTakenTests.ml | 2 +- infer/src/unit/analyzerTester.ml | 4 +- infer/src/unit/livenessTests.ml | 2 +- infer/src/unit/procCfgTests.ml | 2 +- infer/src/unit/schedulerTests.ml | 10 +- 111 files changed, 974 insertions(+), 991 deletions(-) diff --git a/infer/src/IR/AttributesTable.re b/infer/src/IR/AttributesTable.re index 491207c65..82ba499bf 100644 --- a/infer/src/IR/AttributesTable.re +++ b/infer/src/IR/AttributesTable.re @@ -170,9 +170,9 @@ let from_json json => { }; let aggregate s => { - let all_num_bindings = IList.map (fun stats => float_of_int stats.num_bindings) s; - let all_num_buckets = IList.map (fun stats => float_of_int stats.num_buckets) s; - let all_max_bucket_length = IList.map (fun stats => float_of_int stats.max_bucket_length) s; + let all_num_bindings = List.map f::(fun stats => float_of_int stats.num_bindings) s; + let all_num_buckets = List.map f::(fun stats => float_of_int stats.num_buckets) s; + let all_max_bucket_length = List.map f::(fun stats => float_of_int stats.max_bucket_length) s; let aggr_num_bindings = StatisticsToolbox.compute_statistics all_num_bindings; let aggr_num_buckets = StatisticsToolbox.compute_statistics all_num_buckets; let aggr_max_bucket_length = StatisticsToolbox.compute_statistics all_max_bucket_length; diff --git a/infer/src/IR/Cfg.re b/infer/src/IR/Cfg.re index cabdafb6e..f7ac82a9f 100644 --- a/infer/src/IR/Cfg.re +++ b/infer/src/IR/Cfg.re @@ -88,19 +88,19 @@ let check_cfg_connectedness cfg => { let succs = Procdesc.Node.get_succs n; let preds = Procdesc.Node.get_preds n; switch (Procdesc.Node.get_kind n) { - | Procdesc.Node.Start_node _ => Int.equal (IList.length succs) 0 || IList.length preds > 0 - | Procdesc.Node.Exit_node _ => IList.length succs > 0 || Int.equal (IList.length preds) 0 + | Procdesc.Node.Start_node _ => Int.equal (List.length succs) 0 || List.length preds > 0 + | Procdesc.Node.Exit_node _ => List.length succs > 0 || Int.equal (List.length preds) 0 | Procdesc.Node.Stmt_node _ | Procdesc.Node.Prune_node _ | Procdesc.Node.Skip_node _ => - Int.equal (IList.length succs) 0 || Int.equal (IList.length preds) 0 + Int.equal (List.length succs) 0 || Int.equal (List.length preds) 0 | Procdesc.Node.Join_node => /* Join node has the exception that it may be without predecessors and pointing to an exit node */ /* if the if brances end with a return */ switch succs { | [n'] when is_exit_node n' => false - | _ => Int.equal (IList.length preds) 0 + | _ => Int.equal (List.length preds) 0 } } }; @@ -183,13 +183,13 @@ let inline_synthetic_method ret_id etl pdesc loc_call :option Sil.instr => { | (Sil.Call ret_id' (Exp.Const (Const.Cfun pn)) etl' _ cf, _, _) when Bool.equal (is_none ret_id) (is_none ret_id') && - Int.equal (IList.length etl') (IList.length etl) => + Int.equal (List.length etl') (List.length etl) => let instr' = Sil.Call ret_id (Exp.Const (Const.Cfun pn)) etl loc_call cf; found instr instr' | (Sil.Call ret_id' (Exp.Const (Const.Cfun pn)) etl' _ cf, _, _) when Bool.equal (is_none ret_id) (is_none ret_id') && - Int.equal (IList.length etl' + 1) (IList.length etl) => + Int.equal (List.length etl' + 1) (List.length etl) => let etl1 = switch (IList.rev etl) { /* remove last element */ @@ -234,7 +234,7 @@ let proc_inline_synthetic_methods cfg pdesc :unit => { instr' }; let instrs = Procdesc.Node.get_instrs node; - let instrs' = IList.map do_instr instrs; + let instrs' = List.map f::do_instr instrs; if !modified { Procdesc.Node.replace_instrs node instrs' } @@ -399,7 +399,7 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => { Procname.replace_class (Procname.Java callee_pname_java) (Typename.name redirected_typename); let args = { - let other_args = IList.map (fun (exp, typ) => (convert_exp exp, typ)) origin_args; + let other_args = List.map f::(fun (exp, typ) => (convert_exp exp, typ)) origin_args; [(Exp.Var id, redirected_typ), ...other_args] }; let call_instr = @@ -407,7 +407,7 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => { [call_instr, ...instrs] } | Sil.Call return_ids origin_call_exp origin_args loc call_flags => { - let converted_args = IList.map (fun (exp, typ) => (convert_exp exp, typ)) origin_args; + let converted_args = List.map f::(fun (exp, typ) => (convert_exp exp, typ)) origin_args; let call_instr = Sil.Call return_ids (convert_exp origin_call_exp) converted_args loc call_flags; [call_instr, ...instrs] @@ -417,7 +417,7 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => { ...instrs ] | Sil.Declare_locals typed_vars loc => { - let new_typed_vars = IList.map (fun (pvar, typ) => (convert_pvar pvar, typ)) typed_vars; + let new_typed_vars = List.map f::(fun (pvar, typ) => (convert_pvar pvar, typ)) typed_vars; [Sil.Declare_locals new_typed_vars loc, ...instrs] } | Sil.Nullify _ diff --git a/infer/src/IR/Cg.re b/infer/src/IR/Cg.re index a1c8759db..92002aee0 100644 --- a/infer/src/IR/Cg.re +++ b/infer/src/IR/Cg.re @@ -220,7 +220,7 @@ let get_calls (g: t) node => { let get_all_nodes (g: t) => { let nodes = Procname.Set.elements (get_nodes g); - IList.map (fun node => (node, get_calls g node)) nodes + List.map f::(fun node => (node, get_calls g node)) nodes }; let get_nodes_and_calls (g: t) => @@ -306,7 +306,7 @@ let get_nodes_and_defined_children (g: t) => { ) g; let nodes_list = Procname.Set.elements !nodes; - IList.map (fun n => (n, get_defined_children g n)) nodes_list + List.map f::(fun n => (n, get_defined_children g n)) nodes_list }; @@ -332,7 +332,7 @@ let get_nodes_and_edges (g: t) :nodes_and_edges => { let get_defined_nodes (g: t) => { let (nodes, _) = get_nodes_and_edges g; let get_node (node, _) => node; - IList.map get_node (List.filter f::(fun (_, defined) => defined) nodes) + List.map f::get_node (List.filter f::(fun (_, defined) => defined) nodes) }; @@ -380,7 +380,7 @@ let store_to_file (filename: DB.filename) (call_graph: t) => let pp_graph_dotty get_specs (g: t) fmt => { let nodes_with_calls = get_all_nodes g; let num_specs n => - try (IList.length (get_specs n)) { + try (List.length (get_specs n)) { | exn when SymOp.exn_not_failure exn => (-1) }; let get_color (n, _) => diff --git a/infer/src/IR/Exp.re b/infer/src/IR/Exp.re index d0bda8a6b..0f3421b19 100644 --- a/infer/src/IR/Exp.re +++ b/infer/src/IR/Exp.re @@ -230,7 +230,7 @@ let rec pp_ pe pp_t f e => { | BinOp op e1 e2 => F.fprintf f "(%a %s %a)" pp_exp e1 (Binop.str pe op) pp_exp e2 | Exn e => F.fprintf f "EXN %a" pp_exp e | Closure {name, captured_vars} => - let id_exps = IList.map (fun (id_exp, _, _) => id_exp) captured_vars; + let id_exps = List.map f::(fun (id_exp, _, _) => id_exp) captured_vars; F.fprintf f "(%a)" (Pp.comma_seq pp_exp) [Const (Cfun name), ...id_exps] | Lvar pv => Pvar.pp pe f pv | Lfield e fld _ => F.fprintf f "%a.%a" pp_exp e Ident.pp_fieldname fld diff --git a/infer/src/IR/Procdesc.re b/infer/src/IR/Procdesc.re index 6bc9ee93a..cf27ec5dc 100644 --- a/infer/src/IR/Procdesc.re +++ b/infer/src/IR/Procdesc.re @@ -192,7 +192,7 @@ let module Node = { (Pvar.get_ret_pvar pname, ret_type) }; let construct_decl (x, typ) => (Pvar.mk x pname, typ); - let ptl = [ret_var, ...IList.map construct_decl locals]; + let ptl = [ret_var, ...List.map f::construct_decl locals]; let instr = Sil.Declare_locals ptl loc; prepend_instrs node [instr] }; @@ -541,7 +541,7 @@ let get_loop_heads pdesc => { } else { let ancester = NodeSet.add n ancester; let succs = List.append (Node.get_succs n) (Node.get_exn n); - let works = IList.map (fun m => (m, ancester)) succs; + let works = List.map f::(fun m => (m, ancester)) succs; set_loop_head_rec (NodeSet.add n visited) heads (List.append works wl') } }; diff --git a/infer/src/IR/Procname.re b/infer/src/IR/Procname.re index 96f700b43..51ca72e32 100644 --- a/infer/src/IR/Procname.re +++ b/infer/src/IR/Procname.re @@ -258,7 +258,7 @@ let java_get_parameters j => j.parameters; /** Return the parameters of a java procname as strings. */ let java_get_parameters_as_strings j => - IList.map (fun param => java_type_to_string param) j.parameters; + List.map f::(fun param => java_type_to_string param) j.parameters; /** Return true if the java procedure is static */ diff --git a/infer/src/IR/Sil.re b/infer/src/IR/Sil.re index 219adc751..34bfc0a3a 100644 --- a/infer/src/IR/Sil.re +++ b/infer/src/IR/Sil.re @@ -458,7 +458,7 @@ let instr_get_exps = ] | Nullify pvar _ => [Exp.Lvar pvar] | Abstract _ => [] - | Remove_temps temps _ => IList.map (fun id => Exp.Var id) temps + | Remove_temps temps _ => List.map f::(fun id => Exp.Var id) temps | Declare_locals _ => []; @@ -787,12 +787,14 @@ let inst_to_string inst => { } }; +exception JoinFail; -/** join of instrumentations */ + +/** join of instrumentations, can raise JoinFail */ let inst_partial_join inst1 inst2 => { let fail () => { L.d_strln ("inst_partial_join failed on " ^ inst_to_string inst1 ^ " " ^ inst_to_string inst2); - raise IList.Fail + raise JoinFail }; if (equal_inst inst1 inst2) { inst1 @@ -1137,7 +1139,7 @@ let rec strexp_expmap (f: (Exp.t, option inst) => (Exp.t, option inst)) => { } | Estruct fld_se_list inst => { let f_fld_se (fld, se) => (fld, strexp_expmap f se); - Estruct (IList.map f_fld_se fld_se_list) inst + Estruct (List.map f::f_fld_se fld_se_list) inst } | Earray len idx_se_list inst => { let len' = fe len; @@ -1145,7 +1147,7 @@ let rec strexp_expmap (f: (Exp.t, option inst) => (Exp.t, option inst)) => { let idx' = fe idx; (idx', strexp_expmap f se) }; - Earray len' (IList.map f_idx_se idx_se_list) inst + Earray len' (List.map f::f_idx_se idx_se_list) inst } }; @@ -1161,7 +1163,7 @@ let hpred_expmap (f: (Exp.t, option inst) => (Exp.t, option inst)) => { | Hlseg k hpara root next shared => { let root' = fe root; let next' = fe next; - let shared' = IList.map fe shared; + let shared' = List.map f::fe shared; Hlseg k hpara root' next' shared' } | Hdllseg k hpara iF oB oF iB shared => { @@ -1169,7 +1171,7 @@ let hpred_expmap (f: (Exp.t, option inst) => (Exp.t, option inst)) => { let oB' = fe oB; let oF' = fe oF; let iB' = fe iB; - let shared' = IList.map fe shared; + let shared' = List.map f::fe shared; Hdllseg k hpara iF' oB' oF' iB' shared' } }; @@ -1179,19 +1181,19 @@ let rec strexp_instmap (f: inst => inst) strexp => | Eexp e inst => Eexp e (f inst) | Estruct fld_se_list inst => let f_fld_se (fld, se) => (fld, strexp_instmap f se); - Estruct (IList.map f_fld_se fld_se_list) (f inst) + Estruct (List.map f::f_fld_se fld_se_list) (f inst) | Earray len idx_se_list inst => let f_idx_se (idx, se) => (idx, strexp_instmap f se); - Earray len (IList.map f_idx_se idx_se_list) (f inst) + Earray len (List.map f::f_idx_se idx_se_list) (f inst) }; let rec hpara_instmap (f: inst => inst) hpara => { ...hpara, - body: IList.map (hpred_instmap f) hpara.body + body: List.map f::(hpred_instmap f) hpara.body } and hpara_dll_instmap (f: inst => inst) hpara_dll => { ...hpara_dll, - body_dll: IList.map (hpred_instmap f) hpara_dll.body_dll + body_dll: List.map f::(hpred_instmap f) hpara_dll.body_dll } and hpred_instmap (fn: inst => inst) (hpred: hpred) :hpred => switch hpred { @@ -1203,16 +1205,16 @@ and hpred_instmap (fn: inst => inst) (hpred: hpred) :hpred => }; let hpred_list_expmap (f: (Exp.t, option inst) => (Exp.t, option inst)) (hlist: list hpred) => - IList.map (hpred_expmap f) hlist; + List.map f::(hpred_expmap f) hlist; let atom_expmap (f: Exp.t => Exp.t) => fun | Aeq e1 e2 => Aeq (f e1) (f e2) | Aneq e1 e2 => Aneq (f e1) (f e2) - | Apred a es => Apred a (IList.map f es) - | Anpred a es => Anpred a (IList.map f es); + | Apred a es => Apred a (List.map f::f es) + | Anpred a es => Anpred a (List.map f::f es); -let atom_list_expmap (f: Exp.t => Exp.t) (alist: list atom) => IList.map (atom_expmap f) alist; +let atom_list_expmap (f: Exp.t => Exp.t) (alist: list atom) => List.map f::(atom_expmap f) alist; /** {2 Function for computing lexps in sigma} */ @@ -1233,7 +1235,7 @@ let rec exp_fpv e => switch (e: Exp.t) { | Var _ => [] | Exn e => exp_fpv e - | Closure {captured_vars} => IList.map (fun (_, pvar, _) => pvar) captured_vars + | Closure {captured_vars} => List.map f::(fun (_, pvar, _) => pvar) captured_vars | Const _ => [] | Cast _ e | UnOp _ e _ => exp_fpv e @@ -1247,7 +1249,7 @@ let rec exp_fpv e => | Sizeof _ _ _ => [] }; -let exp_list_fpv el => List.concat (IList.map exp_fpv el); +let exp_list_fpv el => List.concat_map f::exp_fpv el; let atom_fpv = fun @@ -1261,12 +1263,12 @@ let rec strexp_fpv = | Eexp e _ => exp_fpv e | Estruct fld_se_list _ => { let f (_, se) => strexp_fpv se; - List.concat (IList.map f fld_se_list) + List.concat_map f::f fld_se_list } | Earray len idx_se_list _ => { let fpv_in_len = exp_fpv len; let f (idx, se) => exp_fpv idx @ strexp_fpv se; - fpv_in_len @ List.concat (IList.map f idx_se_list) + fpv_in_len @ List.concat_map f::f idx_se_list }; let rec hpred_fpv = @@ -1287,7 +1289,7 @@ let rec hpred_fpv = analysis. In interprocedural analysis, we should consider the issue of scopes of program variables. */ and hpara_fpv para => { - let fpvars_in_body = List.concat (IList.map hpred_fpv para.body); + let fpvars_in_body = List.concat_map f::hpred_fpv para.body; switch fpvars_in_body { | [] => [] | _ => assert false @@ -1298,7 +1300,7 @@ and hpara_fpv para => { analysis. In interprocedural analysis, we should consider the issue of scopes of program variables. */ and hpara_dll_fpv para => { - let fpvars_in_body = List.concat (IList.map hpred_fpv para.body_dll); + let fpvars_in_body = List.concat_map f::hpred_fpv para.body_dll; switch fpvars_in_body { | [] => [] | _ => assert false @@ -1380,7 +1382,7 @@ let pp_fav pe f fav => (Pp.seq (Ident.pp pe)) f (fav_to_list fav); /** Copy a [fav]. */ -let fav_copy fav => ref (IList.map (fun x => x) !fav); +let fav_copy fav => ref (List.map f::(fun x => x) !fav); /** Turn a xxx_fav_add function into a xxx_fav function */ @@ -1755,20 +1757,20 @@ let sub_domain_partition filter (sub: subst) => IList.partition (fun (i, _) => f /** Return the list of identifiers in the domain of the substitution. */ -let sub_domain sub => IList.map fst sub; +let sub_domain sub => List.map f::fst sub; /** Return the list of expressions in the range of the substitution. */ -let sub_range sub => IList.map snd sub; +let sub_range sub => List.map f::snd sub; /** [sub_range_map f sub] applies [f] to the expressions in the range of [sub]. */ -let sub_range_map f sub => sub_of_list (IList.map (fun (i, e) => (i, f e)) sub); +let sub_range_map f sub => sub_of_list (List.map f::(fun (i, e) => (i, f e)) sub); /** [sub_map f g sub] applies the renaming [f] to identifiers in the domain of [sub] and the substitution [g] to the expressions in the range of [sub]. */ -let sub_map f g sub => sub_of_list (IList.map (fun (i, e) => (f i, g e)) sub); +let sub_map f g sub => sub_of_list (List.map f::(fun (i, e) => (f i, g e)) sub); let mem_sub id sub => List.exists f::(fun (id1, _) => Ident.equal id id1) sub; @@ -1796,7 +1798,7 @@ let sub_fav_add fav (sub: subst) => ) sub; -let sub_fpv (sub: subst) => List.concat (IList.map (fun (_, e) => exp_fpv e) sub); +let sub_fpv (sub: subst) => List.concat_map f::(fun (_, e) => exp_fpv e) sub; /** Substitutions do not contain binders */ @@ -2095,7 +2097,7 @@ let compare_structural_instr instr1 instr2 exp_map => { } }; let id_list_compare_structural ids1 ids2 exp_map => { - let n = Int.compare (IList.length ids1) (IList.length ids2); + let n = Int.compare (List.length ids1) (List.length ids2); if (n != 0) { (n, exp_map) } else { @@ -2158,7 +2160,7 @@ let compare_structural_instr instr1 instr2 exp_map => { ) | (Call ret_id1 e1 arg_ts1 _ cf1, Call ret_id2 e2 arg_ts2 _ cf2) => let args_compare_structural args1 args2 exp_map => { - let n = Int.compare (IList.length args1) (IList.length args2); + let n = Int.compare (List.length args1) (List.length args2); if (n != 0) { (n, exp_map) } else { @@ -2200,7 +2202,7 @@ let compare_structural_instr instr1 instr2 exp_map => { | (Remove_temps temps1 _, Remove_temps temps2 _) => id_list_compare_structural temps1 temps2 exp_map | (Declare_locals ptl1 _, Declare_locals ptl2 _) => - let n = Int.compare (IList.length ptl1) (IList.length ptl2); + let n = Int.compare (List.length ptl1) (List.length ptl2); if (n != 0) { (n, exp_map) } else { @@ -2245,7 +2247,7 @@ let rec strexp_replace_exp epairs => | Eexp e inst => Eexp (exp_replace_exp epairs e) inst | Estruct fsel inst => { let f (fld, se) => (fld, strexp_replace_exp epairs se); - Estruct (IList.map f fsel) inst + Estruct (List.map f::f fsel) inst } | Earray len isel inst => { let len' = exp_replace_exp epairs len; @@ -2253,7 +2255,7 @@ let rec strexp_replace_exp epairs => let idx' = exp_replace_exp epairs idx; (idx', strexp_replace_exp epairs se) }; - Earray len' (IList.map f isel) inst + Earray len' (List.map f::f isel) inst }; let hpred_replace_exp epairs => @@ -2267,7 +2269,7 @@ let hpred_replace_exp epairs => | Hlseg k para root next shared => { let root_repl = exp_replace_exp epairs root; let next_repl = exp_replace_exp epairs next; - let shared_repl = IList.map (exp_replace_exp epairs) shared; + let shared_repl = List.map f::(exp_replace_exp epairs) shared; Hlseg k para root_repl next_repl shared_repl } | Hdllseg k para e1 e2 e3 e4 shared => { @@ -2275,7 +2277,7 @@ let hpred_replace_exp epairs => let e2' = exp_replace_exp epairs e2; let e3' = exp_replace_exp epairs e3; let e4' = exp_replace_exp epairs e4; - let shared_repl = IList.map (exp_replace_exp epairs) shared; + let shared_repl = List.map f::(exp_replace_exp epairs) shared; Hdllseg k para e1' e2' e3' e4' shared_repl }; @@ -2305,7 +2307,7 @@ let exp_compact sh e => let rec sexp_compact sh se => switch se { | Eexp e inst => Eexp (exp_compact sh e) inst - | Estruct fsel inst => Estruct (IList.map (fun (f, se) => (f, sexp_compact sh se)) fsel) inst + | Estruct fsel inst => Estruct (List.map f::(fun (f, se) => (f, sexp_compact sh se)) fsel) inst | Earray _ => se }; @@ -2372,19 +2374,19 @@ let sigma_to_sigma_ne sigma :list (list atom, list hpred) => | Hlseg Lseg_NE _ _ _ _ | Hdllseg Lseg_NE _ _ _ _ _ _ => let g (eqs, sigma) => (eqs, [hpred, ...sigma]); - IList.map g eqs_sigma_list + List.map f::g eqs_sigma_list | Hlseg Lseg_PE para e1 e2 el => let g (eqs, sigma) => [ ([Aeq e1 e2, ...eqs], sigma), (eqs, [Hlseg Lseg_NE para e1 e2 el, ...sigma]) ]; - List.concat (IList.map g eqs_sigma_list) + List.concat_map f::g eqs_sigma_list | Hdllseg Lseg_PE para_dll e1 e2 e3 e4 el => let g (eqs, sigma) => [ ([Aeq e1 e3, Aeq e2 e4, ...eqs], sigma), (eqs, [Hdllseg Lseg_NE para_dll e1 e2 e3 e4 el, ...sigma]) ]; - List.concat (IList.map g eqs_sigma_list) + List.concat_map f::g eqs_sigma_list }; List.fold f::f init::[([], [])] sigma } else { @@ -2399,24 +2401,24 @@ let sigma_to_sigma_ne sigma :list (list atom, list hpred) => let hpara_instantiate para e1 e2 elist => { let subst_for_svars = { let g id e => (id, e); - try (IList.map2 g para.svars elist) { + try (List.map2_exn f::g para.svars elist) { | Invalid_argument _ => assert false } }; let ids_evars = { let g _ => Ident.create_fresh Ident.kprimed; - IList.map g para.evars + List.map f::g para.evars }; let subst_for_evars = { let g id id' => (id, Exp.Var id'); - try (IList.map2 g para.evars ids_evars) { + try (List.map2_exn f::g para.evars ids_evars) { | Invalid_argument _ => assert false } }; let subst = sub_of_list ( [(para.root, e1), (para.next, e2), ...subst_for_svars] @ subst_for_evars ); - (ids_evars, IList.map (hpred_sub subst) para.body) + (ids_evars, List.map f::(hpred_sub subst) para.body) }; @@ -2428,24 +2430,24 @@ let hpara_instantiate para e1 e2 elist => { let hpara_dll_instantiate (para: hpara_dll) cell blink flink elist => { let subst_for_svars = { let g id e => (id, e); - try (IList.map2 g para.svars_dll elist) { + try (List.map2_exn f::g para.svars_dll elist) { | Invalid_argument _ => assert false } }; let ids_evars = { let g _ => Ident.create_fresh Ident.kprimed; - IList.map g para.evars_dll + List.map f::g para.evars_dll }; let subst_for_evars = { let g id id' => (id, Exp.Var id'); - try (IList.map2 g para.evars_dll ids_evars) { + try (List.map2_exn f::g para.evars_dll ids_evars) { | Invalid_argument _ => assert false } }; let subst = sub_of_list ( [(para.cell, cell), (para.blink, blink), (para.flink, flink), ...subst_for_svars] @ subst_for_evars ); - (ids_evars, IList.map (hpred_sub subst) para.body_dll) + (ids_evars, List.map f::(hpred_sub subst) para.body_dll) }; let custom_error = Pvar.mk_global (Mangled.from_string "INFER_CUSTOM_ERROR") SourceFile.empty; diff --git a/infer/src/IR/Sil.rei b/infer/src/IR/Sil.rei index 2cc2b84df..65dbb53cb 100644 --- a/infer/src/IR/Sil.rei +++ b/infer/src/IR/Sil.rei @@ -169,8 +169,10 @@ let inst_new_loc: Location.t => inst => inst; /** Update [inst_old] to [inst_new] preserving the zero flag */ let update_inst: inst => inst => inst; +exception JoinFail; -/** join of instrumentations */ + +/** join of instrumentations, can raise JoinFail */ let inst_partial_join: inst => inst => inst; diff --git a/infer/src/backend/Attribute.ml b/infer/src/backend/Attribute.ml index 48993224c..8ccbb48ee 100644 --- a/infer/src/backend/Attribute.ml +++ b/infer/src/backend/Attribute.ml @@ -37,7 +37,7 @@ let add_or_replace_check_changed tenv check_attribute_change prop atom0 = match atom0 with | Sil.Apred (att0, ((_ :: _) as exps0)) | Anpred (att0, ((_ :: _) as exps0)) -> let pairs = - IList.map (fun e -> (e, Prop.exp_normalize_prop tenv prop e)) exps0 in + List.map ~f:(fun e -> (e, Prop.exp_normalize_prop tenv prop e)) exps0 in let _, nexp = List.hd_exn pairs in (* len exps0 > 0 by match *) let natom = Sil.atom_replace_exp pairs atom0 in let atom_map = function @@ -266,14 +266,14 @@ let deallocate_stack_vars tenv (p: 'a Prop.t) pvars = let sigma_stack, sigma_other = IList.partition filter p.sigma in let fresh_address_vars = ref [] in (* fresh vars substituted for the address of stack vars *) let stack_vars_address_in_post = ref [] in (* stack vars whose address is still present *) - let exp_replace = IList.map (function + let exp_replace = List.map ~f:(function | Sil.Hpointsto (Exp.Lvar v, _, _) -> let freshv = Ident.create_fresh Ident.kprimed in fresh_address_vars := (v, freshv) :: !fresh_address_vars; (Exp.Lvar v, Exp.Var freshv) | _ -> assert false) sigma_stack in - let pi1 = IList.map (fun (id, e) -> Sil.Aeq (Exp.Var id, e)) (Sil.sub_to_list p.sub) in - let pi = IList.map (Sil.atom_replace_exp exp_replace) (p.pi @ pi1) in + let pi1 = List.map ~f:(fun (id, e) -> Sil.Aeq (Exp.Var id, e)) (Sil.sub_to_list p.sub) in + let pi = List.map ~f:(Sil.atom_replace_exp exp_replace) (p.pi @ pi1) in let p' = Prop.normalize tenv (Prop.set p diff --git a/infer/src/backend/BuiltinDefn.ml b/infer/src/backend/BuiltinDefn.ml index 126f4c03d..649e5cdc3 100644 --- a/infer/src/backend/BuiltinDefn.ml +++ b/infer/src/backend/BuiltinDefn.ml @@ -186,9 +186,9 @@ let create_type tenv n_lexp typ prop = let sil_is_nonnull = Exp.UnOp (Unop.LNot, sil_is_null, None) in let null_case = Propset.to_proplist (prune tenv ~positive:true sil_is_null prop) in let non_null_case = Propset.to_proplist (prune tenv ~positive:true sil_is_nonnull prop_type) in - if ((IList.length non_null_case) > 0) && (!Config.footprint) then + if ((List.length non_null_case) > 0) && (!Config.footprint) then non_null_case - else if ((IList.length non_null_case) > 0) && (is_undefined_opt tenv prop n_lexp) then + else if ((List.length non_null_case) > 0) && (is_undefined_opt tenv prop n_lexp) then non_null_case else null_case @ non_null_case @@ -209,7 +209,7 @@ let execute___get_type_of { Builtin.pdesc; tenv; prop_; path; ret_id; args; } ((return_result tenv texp prop ret_id), path) | None -> ((return_result tenv Exp.zero prop ret_id), path) in - (IList.map aux props) + (List.map ~f:aux props) | _ -> raise (Exceptions.Wrong_argument_number __POS__) (** replace the type of the ptsto rooted at [root_e] with [texp] in [prop] *) @@ -297,7 +297,7 @@ let execute___instanceof_cast ~instof | None -> [(return_result tenv val1 prop ret_id, path)] in let props = create_type tenv val1 typ1 prop in - List.concat (IList.map exe_one_prop props) + List.concat_map ~f:exe_one_prop props | _ -> raise (Exceptions.Wrong_argument_number __POS__) let execute___instanceof builtin_args @@ -409,8 +409,8 @@ let execute___get_hidden_field { Builtin.tenv; pdesc; prop_; path; ret_id; args; set_ret_val(); hpred | _ -> hpred in - let sigma' = IList.map (do_hpred false) prop.Prop.sigma in - let sigma_fp' = IList.map (do_hpred true) prop.Prop.sigma_fp in + let sigma' = List.map ~f:(do_hpred false) prop.Prop.sigma in + let sigma_fp' = List.map ~f:(do_hpred true) prop.Prop.sigma_fp in let prop' = Prop.set prop ~sigma:sigma' ~sigma_fp:sigma_fp' in let prop'' = return_val (Prop.normalize tenv prop') in [(prop'', path)] @@ -443,8 +443,8 @@ let execute___set_hidden_field { Builtin.tenv; pdesc; prop_; path; args; } let fsel' = (Ident.fieldname_hidden, se) :: fsel in Sil.Hpointsto(e, Sil.Estruct (fsel', inst), texp) | _ -> hpred in - let sigma' = IList.map (do_hpred false) prop.Prop.sigma in - let sigma_fp' = IList.map (do_hpred true) prop.Prop.sigma_fp in + let sigma' = List.map ~f:(do_hpred false) prop.Prop.sigma in + let sigma_fp' = List.map ~f:(do_hpred true) prop.Prop.sigma_fp in let prop' = Prop.set prop ~sigma:sigma' ~sigma_fp:sigma_fp' in let prop'' = Prop.normalize tenv prop' in [(prop'', path)] @@ -729,10 +729,12 @@ let execute_free mk { Builtin.pdesc; instr; tenv; prop_; path; args; loc; } Propset.to_proplist (prune tenv ~positive:false n_lexp prop) in let plist = prop_zero @ (* model: if 0 then skip else _execute_free_nonzero *) - List.concat (IList.map (fun p -> - _execute_free_nonzero mk pdesc tenv instr p - (Prop.exp_normalize_prop tenv p lexp) typ loc) prop_nonzero) in - IList.map (fun p -> (p, path)) plist + List.concat_map + ~f:(fun p -> + _execute_free_nonzero mk pdesc tenv instr p + (Prop.exp_normalize_prop tenv p lexp) typ loc) + prop_nonzero in + List.map ~f:(fun p -> (p, path)) plist end | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -850,7 +852,7 @@ let execute_skip { Builtin.prop_; path; } : Builtin.ret_typ = let execute_scan_function skip_n_arguments ({ Builtin.args } as call_args) : Builtin.ret_typ = match args with - | _ when IList.length args >= skip_n_arguments -> + | _ when List.length args >= skip_n_arguments -> let varargs = ref args in varargs := List.drop !varargs skip_n_arguments; SymExec.unknown_or_scan_call @@ -898,7 +900,7 @@ let execute___split_get_nth { Builtin.tenv; pdesc; prop_; path; ret_id; args; } (let n = IntLit.to_int n_sil in try let parts = Str.split (Str.regexp_string str2) str1 in - let n_part = IList.nth parts n in + let n_part = List.nth_exn parts n in let res = Exp.Const (Const.Cstr n_part) in [(return_result tenv res prop ret_id, path)] with Not_found -> assert false) @@ -938,7 +940,7 @@ let execute___infer_fail { Builtin.pdesc; tenv; prop_; path; args; loc; } let execute___assert_fail { Builtin.pdesc; tenv; prop_; path; args; loc; } : Builtin.ret_typ = let error_str = - match IList.length args with + match List.length args with | 4 -> Config.default_failure_name | _ -> diff --git a/infer/src/backend/InferAnalyze.re b/infer/src/backend/InferAnalyze.re index 1919b439d..8cb9dedd9 100644 --- a/infer/src/backend/InferAnalyze.re +++ b/infer/src/backend/InferAnalyze.re @@ -48,14 +48,14 @@ let exe_env_from_cluster cluster => { let analyze_cluster cluster_num (cluster: Cluster.t) => { let exe_env = exe_env_from_cluster cluster; let defined_procs = Cg.get_defined_nodes (Exe_env.get_cg exe_env); - let num_procs = IList.length defined_procs; + let num_procs = List.length defined_procs; L.err "@.Processing cluster #%d with %d procedures@." (cluster_num + 1) num_procs; analyze_exe_env exe_env }; let output_json_makefile_stats clusters => { let clusters_to_analyze = List.filter f::ClusterMakefile.cluster_should_be_analyzed clusters; - let num_files = IList.length clusters_to_analyze; + let num_files = List.length clusters_to_analyze; let num_procs = 0; /* can't compute it at this stage */ let num_lines = 0; @@ -111,7 +111,7 @@ let main makefile => { MergeCapture.merge_captured_targets () }; let clusters = DB.find_source_dirs (); - L.stdout "Found %d source files in %s@." (IList.length clusters) Config.results_dir; + L.stdout "Found %d source files in %s@." (List.length clusters) Config.results_dir; if (makefile != "") { ClusterMakefile.create_cluster_makefile clusters makefile } else { diff --git a/infer/src/backend/InferPrint.re b/infer/src/backend/InferPrint.re index 32d23bff2..0418bf469 100644 --- a/infer/src/backend/InferPrint.re +++ b/infer/src/backend/InferPrint.re @@ -32,14 +32,14 @@ let load_specfiles () => { try (Array.to_list (Sys.readdir dir)) { | Sys_error _ => [] }; - let all_filepaths = IList.map (fun fname => Filename.concat dir fname) all_filenames; + let all_filepaths = List.map f::(fun fname => Filename.concat dir fname) all_filenames; List.filter f::is_specs_file all_filepaths }; let specs_dirs = { let result_specs_dir = DB.filename_to_string DB.Results_dir.specs_dir; [result_specs_dir, ...Config.specs_library] }; - List.concat (IList.map specs_files_in_dir specs_dirs) + List.concat_map f::specs_files_in_dir specs_dirs }; @@ -76,7 +76,7 @@ let error_desc_to_xml_string error_desc => { let error_desc_to_xml_tags error_desc => { let tags = Localise.error_desc_get_tags error_desc; let subtree label contents => Io_infer.Xml.create_tree label [] [Io_infer.Xml.String contents]; - IList.map (fun (tag, value) => subtree tag (Escape.escape_xml value)) tags + List.map f::(fun (tag, value) => subtree tag (Escape.escape_xml value)) tags }; let get_bug_hash @@ -105,7 +105,7 @@ let loc_trace_to_jsonbug_record trace_list ekind => | _ => /* writes a trace as a record for atdgen conversion */ let node_tags_to_records tags_list => - IList.map (fun tag => {Jsonbug_j.tag: fst tag, value: snd tag}) tags_list; + List.map f::(fun tag => {Jsonbug_j.tag: fst tag, value: snd tag}) tags_list; let trace_item_to_record trace_item => { Jsonbug_j.level: trace_item.Errlog.lt_level, filename: SourceFile.to_string trace_item.Errlog.lt_loc.Location.file, @@ -113,14 +113,14 @@ let loc_trace_to_jsonbug_record trace_list ekind => description: trace_item.Errlog.lt_description, node_tags: node_tags_to_records trace_item.Errlog.lt_node_tags }; - let record_list = IList.rev (IList.rev_map trace_item_to_record trace_list); + let record_list = IList.rev (List.rev_map f::trace_item_to_record trace_list); record_list }; let error_desc_to_qualifier_tags_records error_desc => { let tag_value_pairs = Localise.error_desc_to_tag_value_pairs error_desc; let tag_value_to_record (tag, value) => {Jsonbug_j.tag: tag, value}; - IList.map (fun tag_value => tag_value_to_record tag_value) tag_value_pairs + List.map f::(fun tag_value => tag_value_to_record tag_value) tag_value_pairs }; type summary_val = { @@ -151,7 +151,7 @@ let summary_values summary => { let err_log = attributes.ProcAttributes.err_log; let proc_name = Specs.get_proc_name summary; let signature = Specs.get_signature summary; - let nodes_nr = IList.length summary.Specs.nodes; + let nodes_nr = List.length summary.Specs.nodes; let specs = Specs.get_specs_from_payload summary; let (nr_nodes_visited, lines_visited) = { let visited = ref Specs.Visitedset.empty; @@ -188,7 +188,7 @@ let summary_values summary => { { vname: Procname.to_string proc_name, vname_id: Procname.to_filename proc_name, - vspecs: IList.length specs, + vspecs: List.length specs, vtime: Printf.sprintf "%.0f" stats.Specs.stats_time, vto: Option.value_map f::pp_failure default::"NONE" stats.Specs.stats_failure, vsymop: stats.Specs.symops, @@ -605,7 +605,8 @@ let module IssuesXml = { let code_to_xml code => subtree Io_infer.Xml.tag_code code; let description_to_xml descr => subtree Io_infer.Xml.tag_description (Escape.escape_xml descr); let node_tags_to_xml node_tags => { - let escaped_tags = IList.map (fun (tag, value) => (tag, Escape.escape_xml value)) node_tags; + let escaped_tags = + List.map f::(fun (tag, value) => (tag, Escape.escape_xml value)) node_tags; Io_infer.Xml.create_tree Io_infer.Xml.tag_node escaped_tags [] }; let num = ref 0; @@ -629,7 +630,7 @@ let module IssuesXml = { node_tags_to_xml lt.Errlog.lt_node_tags ] }; - IList.rev (IList.rev_map loc_to_xml ltr) + IList.rev (List.rev_map f::loc_to_xml ltr) }; /** print issues from summary in xml */ @@ -815,7 +816,7 @@ let module Stats = { | _ => true }; stats.nprocs = stats.nprocs + 1; - stats.nspecs = stats.nspecs + IList.length specs; + stats.nspecs = stats.nspecs + List.length specs; if is_verified { stats.nverified = stats.nverified + 1 }; @@ -938,7 +939,7 @@ let module PreconditionStats = { let nr_dataconstraints = ref 0; let do_summary proc_name summary => { let specs = Specs.get_specs_from_payload summary; - let preconditions = IList.map (fun spec => Specs.Jprop.to_prop spec.Specs.pre) specs; + let preconditions = List.map f::(fun spec => Specs.Jprop.to_prop spec.Specs.pre) specs; switch (Prop.CategorizePreconditions.categorize preconditions) { | Prop.CategorizePreconditions.Empty => incr nr_empty; diff --git a/infer/src/backend/PerfStats.ml b/infer/src/backend/PerfStats.ml index 4f22ca328..6fbc33437 100644 --- a/infer/src/backend/PerfStats.ml +++ b/infer/src/backend/PerfStats.ml @@ -73,7 +73,7 @@ let from_json json = } let aggregate s = - let mk_stats f = StatisticsToolbox.compute_statistics (IList.map f s) in + let mk_stats f = StatisticsToolbox.compute_statistics (List.map ~f:f s) in let aggr_rtime = mk_stats (fun stats -> stats.rtime) in let aggr_utime = mk_stats (fun stats -> stats.utime) in let aggr_stime = mk_stats (fun stats -> stats.stime) in @@ -90,7 +90,7 @@ let aggregate s = let aggr_stack_kb = mk_stats (fun stats -> stats.stack_kb) in let aggr_minor_heap_kb = mk_stats (fun stats -> stats.minor_heap_kb) in let aggr_attributes_table = - AttributesTable.aggregate (IList.map (fun stats -> stats.attributes_table) s) in + AttributesTable.aggregate (List.map ~f:(fun stats -> stats.attributes_table) s) in `Assoc [ ("rtime", StatisticsToolbox.to_json aggr_rtime); ("utime", StatisticsToolbox.to_json aggr_utime); diff --git a/infer/src/backend/PropUtil.re b/infer/src/backend/PropUtil.re index 4f8f5bac8..022eef928 100644 --- a/infer/src/backend/PropUtil.re +++ b/infer/src/backend/PropUtil.re @@ -24,7 +24,7 @@ let get_name_of_objc_static_locals (curr_f: Procdesc.t) p => { | Sil.Hpointsto e _ _ => [local_static e] | _ => [] }; - let vars_sigma = IList.map hpred_local_static p.Prop.sigma; + let vars_sigma = List.map f::hpred_local_static p.Prop.sigma; List.concat (List.concat vars_sigma) }; @@ -40,7 +40,7 @@ let get_name_of_objc_block_locals p => { | Sil.Hpointsto e _ _ => [local_blocks e] | _ => [] }; - let vars_sigma = IList.map hpred_local_blocks p.Prop.sigma; + let vars_sigma = List.map f::hpred_local_blocks p.Prop.sigma; List.concat (List.concat vars_sigma) }; @@ -145,7 +145,7 @@ let remove_abduced_retvars tenv p => { }; let remove_locals tenv (curr_f: Procdesc.t) p => { - let names_of_locals = IList.map (get_name_of_local curr_f) (Procdesc.get_locals curr_f); + let names_of_locals = List.map f::(get_name_of_local curr_f) (Procdesc.get_locals curr_f); let names_of_locals' = switch !Config.curr_language { | Config.Clang => @@ -168,7 +168,7 @@ let remove_locals tenv (curr_f: Procdesc.t) p => { let remove_formals tenv (curr_f: Procdesc.t) p => { let pname = Procdesc.get_proc_name curr_f; - let formal_vars = IList.map (fun (n, _) => Pvar.mk n pname) (Procdesc.get_formals curr_f); + let formal_vars = List.map f::(fun (n, _) => Pvar.mk n pname) (Procdesc.get_formals curr_f); Attribute.deallocate_stack_vars tenv p formal_vars }; diff --git a/infer/src/backend/StatsAggregator.re b/infer/src/backend/StatsAggregator.re index e588d2331..406fca3d6 100644 --- a/infer/src/backend/StatsAggregator.re +++ b/infer/src/backend/StatsAggregator.re @@ -32,7 +32,7 @@ let find_json_files_in_dir dir => { dir_exists dir ? { let content = Array.to_list (Sys.readdir dir); - let content_with_path = IList.map (fun p => Filename.concat dir p) content; + let content_with_path = List.map f::(fun p => Filename.concat dir p) content; List.filter f::is_valid_json_file content_with_path } : [] @@ -71,7 +71,7 @@ let load_data_from_infer_deps file => { let lines = Utils.read_file file; try ( switch lines { - | Some l => Ok (IList.map extract_target_and_path l) + | Some l => Ok (List.map f::extract_target_and_path l) | None => raise (Failure ("Error reading '" ^ file ^ "'")) } ) { @@ -97,8 +97,9 @@ let collect_all_stats_files () => { | Ok r => let buck_out_parent = Filename.concat p Filename.parent_dir_name; let targets_files = - IList.map - (fun (t, p) => (t, find_stats_files_in_dir (concatenate_paths buck_out_parent p))) r; + List.map + f::(fun (t, p) => (t, find_stats_files_in_dir (concatenate_paths buck_out_parent p))) + r; Ok (Buck_out targets_files) | Error _ as e => e } @@ -111,7 +112,8 @@ let collect_all_stats_files () => { let aggregate_stats_files paths => { let open_json_file file => Yojson.Basic.from_file file; - let load_stats paths => IList.map (fun path => PerfStats.from_json (open_json_file path)) paths; + let load_stats paths => + List.map f::(fun path => PerfStats.from_json (open_json_file path)) paths; let all_perf_stats = load_stats paths; switch all_perf_stats { | [] => None diff --git a/infer/src/backend/abs.ml b/infer/src/backend/abs.ml index 626ecbbe0..13e004a75 100644 --- a/infer/src/backend/abs.ml +++ b/infer/src/backend/abs.ml @@ -54,12 +54,12 @@ let create_fresh_primeds_ls para = let ids_shared = let svars = para.Sil.svars in let f _ = Ident.create_fresh Ident.kprimed in - IList.map f svars in + List.map ~f svars in let ids_tuple = (id_base, id_next, id_end, ids_shared) in let exp_base = Exp.Var id_base in let exp_next = Exp.Var id_next in let exp_end = Exp.Var id_end in - let exps_shared = IList.map (fun id -> Exp.Var id) ids_shared in + let exps_shared = List.map ~f:(fun id -> Exp.Var id) ids_shared in let exps_tuple = (exp_base, exp_next, exp_end, exps_shared) in (ids_tuple, exps_tuple) @@ -71,13 +71,13 @@ let create_condition_ls ids_private id_base p_leftover (inst: Sil.subst) = let inst_of_base = try Sil.sub_find (Ident.equal id_base) inst_public with Not_found -> assert false in let insts_of_private_ids = Sil.sub_range inst_private in (insts_of_private_ids, insts_of_public_ids, inst_of_base) in - let fav_insts_of_public_ids = List.concat (IList.map Sil.exp_fav_list insts_of_public_ids) in - let fav_insts_of_private_ids = List.concat (IList.map Sil.exp_fav_list insts_of_private_ids) in + let fav_insts_of_public_ids = List.concat_map ~f:Sil.exp_fav_list insts_of_public_ids in + let fav_insts_of_private_ids = List.concat_map ~f:Sil.exp_fav_list insts_of_private_ids in let (fav_p_leftover, _) = let sigma = p_leftover.Prop.sigma in (sigma_fav_list sigma, sigma_fav_in_pvars_list sigma) in let fpv_inst_of_base = Sil.exp_fpv inst_of_base in - let fpv_insts_of_private_ids = List.concat (IList.map Sil.exp_fpv insts_of_private_ids) in + let fpv_insts_of_private_ids = List.concat_map ~f:Sil.exp_fpv insts_of_private_ids in (* let fav_inst_of_base = Sil.exp_fav_list inst_of_base in L.out "@[.... application of condition ....@\n@."; @@ -102,12 +102,12 @@ let mk_rule_ptspts_ls tenv impl_ok1 impl_ok2 (para: Sil.hpara) = | [] -> L.out "@.@.ERROR (Empty Para): %a @.@." (Sil.pp_hpara Pp.text) para; assert false | hpred :: hpreds -> let hpat = mark_impl_flag hpred in - let hpats = IList.map mark_impl_flag hpreds in + let hpats = List.map ~f:mark_impl_flag hpreds in (hpat, hpats) in let (ids_exist_snd, para_snd) = let mark_impl_flag hpred = { Match.hpred = hpred; Match.flag = impl_ok2 } in let (ids, para_body) = Sil.hpara_instantiate para exp_next exp_end exps_shared in - let para_body_hpats = IList.map mark_impl_flag para_body in + let para_body_hpats = List.map ~f:mark_impl_flag para_body in (ids, para_body_hpats) in let lseg_res = Prop.mk_lseg tenv Sil.Lseg_NE para exp_base exp_end exps_shared in let gen_pi_res _ _ (_: Sil.subst) = [] in @@ -131,7 +131,7 @@ let mk_rule_ptsls_ls tenv k2 impl_ok1 impl_ok2 para = | [] -> L.out "@.@.ERROR (Empty Para): %a @.@." (Sil.pp_hpara Pp.text) para; assert false | hpred :: hpreds -> let allow_impl hpred = { Match.hpred = hpred; Match.flag = impl_ok1 } in - (allow_impl hpred, IList.map allow_impl hpreds) in + (allow_impl hpred, List.map ~f:allow_impl hpreds) in let lseg_pat = { Match.hpred = Prop.mk_lseg tenv k2 para exp_next exp_end exps_shared; Match.flag = impl_ok2 } in let lseg_res = Prop.mk_lseg tenv Sil.Lseg_NE para exp_base exp_end exps_shared in let gen_pi_res _ _ (_: Sil.subst) = [] in @@ -153,7 +153,7 @@ let mk_rule_lspts_ls tenv k1 impl_ok1 impl_ok2 para = let (ids_exist, para_inst_pat) = let (ids, para_body) = Sil.hpara_instantiate para exp_next exp_end exps_shared in let allow_impl hpred = { Match.hpred = hpred; Match.flag = impl_ok2 } in - let para_body_pat = IList.map allow_impl para_body in + let para_body_pat = List.map ~f:allow_impl para_body in (ids, para_body_pat) in let lseg_res = Prop.mk_lseg tenv Sil.Lseg_NE para exp_base exp_end exps_shared in let gen_pi_res _ _ (_: Sil.subst) = [] in @@ -242,12 +242,12 @@ let mk_rule_ptspts_dll tenv impl_ok1 impl_ok2 para = let ids_shared = let svars = para.Sil.svars_dll in let f _ = Ident.create_fresh Ident.kprimed in - IList.map f svars in + List.map ~f:f svars in let exp_iF = Exp.Var id_iF in let exp_iF' = Exp.Var id_iF' in let exp_oB = Exp.Var id_oB in let exp_oF = Exp.Var id_oF in - let exps_shared = IList.map (fun id -> Exp.Var id) ids_shared in + let exps_shared = List.map ~f:(fun id -> Exp.Var id) ids_shared in let (ids_exist_fst, para_fst) = Sil.hpara_dll_instantiate para exp_iF exp_oB exp_iF' exps_shared in let (para_fst_start, para_fst_rest) = let mark_impl_flag hpred = { Match.hpred = hpred; Match.flag = impl_ok1 } in @@ -255,12 +255,12 @@ let mk_rule_ptspts_dll tenv impl_ok1 impl_ok2 para = | [] -> L.out "@.@.ERROR (Empty DLL para): %a@.@." (Sil.pp_hpara_dll Pp.text) para; assert false | hpred :: hpreds -> let hpat = mark_impl_flag hpred in - let hpats = IList.map mark_impl_flag hpreds in + let hpats = List.map ~f:mark_impl_flag hpreds in (hpat, hpats) in let (ids_exist_snd, para_snd) = let mark_impl_flag hpred = { Match.hpred = hpred; Match.flag = impl_ok2 } in let (ids, para_body) = Sil.hpara_dll_instantiate para exp_iF' exp_iF exp_oF exps_shared in - let para_body_hpats = IList.map mark_impl_flag para_body in + let para_body_hpats = List.map ~f:mark_impl_flag para_body in (ids, para_body_hpats) in let dllseg_res = Prop.mk_dllseg tenv Sil.Lseg_NE para exp_iF exp_oB exp_oF exp_iF' exps_shared in let gen_pi_res _ _ (_: Sil.subst) = [] in @@ -290,20 +290,20 @@ let mk_rule_ptsdll_dll tenv k2 impl_ok1 impl_ok2 para = let ids_shared = let svars = para.Sil.svars_dll in let f _ = Ident.create_fresh Ident.kprimed in - IList.map f svars in + List.map ~f:f svars in let exp_iF = Exp.Var id_iF in let exp_iF' = Exp.Var id_iF' in let exp_oB = Exp.Var id_oB in let exp_oF = Exp.Var id_oF in let exp_iB = Exp.Var id_iB in - let exps_shared = IList.map (fun id -> Exp.Var id) ids_shared in + let exps_shared = List.map ~f:(fun id -> Exp.Var id) ids_shared in let (ids_exist, para_inst) = Sil.hpara_dll_instantiate para exp_iF exp_oB exp_iF' exps_shared in let (para_inst_start, para_inst_rest) = match para_inst with | [] -> assert false | hpred :: hpreds -> let allow_impl hpred = { Match.hpred = hpred; Match.flag = impl_ok1 } in - (allow_impl hpred, IList.map allow_impl hpreds) in + (allow_impl hpred, List.map ~f:allow_impl hpreds) in let dllseg_pat = { Match.hpred = Prop.mk_dllseg tenv k2 para exp_iF' exp_iF exp_oF exp_iB exps_shared; Match.flag = impl_ok2 } in let dllseg_res = Prop.mk_dllseg tenv Sil.Lseg_NE para exp_iF exp_oB exp_oF exp_iB exps_shared in let gen_pi_res _ _ (_: Sil.subst) = [] in @@ -326,17 +326,17 @@ let mk_rule_dllpts_dll tenv k1 impl_ok1 impl_ok2 para = let ids_shared = let svars = para.Sil.svars_dll in let f _ = Ident.create_fresh Ident.kprimed in - IList.map f svars in + List.map ~f:f svars in let exp_iF = Exp.Var id_iF in let exp_iF' = Exp.Var id_iF' in let exp_oB = Exp.Var id_oB in let exp_oB' = Exp.Var id_oB' in let exp_oF = Exp.Var id_oF in - let exps_shared = IList.map (fun id -> Exp.Var id) ids_shared in + let exps_shared = List.map ~f:(fun id -> Exp.Var id) ids_shared in let (ids_exist, para_inst) = Sil.hpara_dll_instantiate para exp_iF' exp_oB' exp_oF exps_shared in let para_inst_pat = let allow_impl hpred = { Match.hpred = hpred; Match.flag = impl_ok2 } in - IList.map allow_impl para_inst in + List.map ~f:allow_impl para_inst in let dllseg_pat = { Match.hpred = Prop.mk_dllseg tenv k1 para exp_iF exp_oB exp_iF' exp_oB' exps_shared; Match.flag = impl_ok1 } in let dllseg_res = Prop.mk_dllseg tenv Sil.Lseg_NE para exp_iF exp_oB exp_oF exp_iF' exps_shared in let gen_pi_res _ _ (_: Sil.subst) = [] in @@ -360,14 +360,14 @@ let mk_rule_dlldll_dll tenv k1 k2 impl_ok1 impl_ok2 para = let ids_shared = let svars = para.Sil.svars_dll in let f _ = Ident.create_fresh Ident.kprimed in - IList.map f svars in + List.map ~f:f svars in let exp_iF = Exp.Var id_iF in let exp_iF' = Exp.Var id_iF' in let exp_oB = Exp.Var id_oB in let exp_oB' = Exp.Var id_oB' in let exp_oF = Exp.Var id_oF in let exp_iB = Exp.Var id_iB in - let exps_shared = IList.map (fun id -> Exp.Var id) ids_shared in + let exps_shared = List.map ~f:(fun id -> Exp.Var id) ids_shared in let lseg_fst_pat = { Match.hpred = Prop.mk_dllseg tenv k1 para exp_iF exp_oB exp_iF' exp_oB' exps_shared; Match.flag = impl_ok1 } in let lseg_snd_pat = { Match.hpred = Prop.mk_dllseg tenv k2 para exp_iF' exp_oB' exp_oF exp_iB exps_shared; Match.flag = impl_ok2 } in let k_res = lseg_kind_add k1 k2 in @@ -420,7 +420,7 @@ let typ_get_recursive_flds tenv typ_exp = match typ with | Tstruct name -> ( match Tenv.lookup tenv name with - | Some { fields } -> IList.map fst3 (List.filter ~f:(filter typ) fields) + | Some { fields } -> List.map ~f:fst3 (List.filter ~f:(filter typ) fields) | None -> L.err "@.typ_get_recursive: unexpected type expr: %a@." Exp.pp typ_exp; [] (* ToDo: assert false *) @@ -594,7 +594,7 @@ let reset_current_rules () = Global.current_rules := [] let eqs_sub subst eqs = - IList.map (fun (e1, e2) -> (Sil.exp_sub subst e1, Sil.exp_sub subst e2)) eqs + List.map ~f:(fun (e1, e2) -> (Sil.exp_sub subst e1, Sil.exp_sub subst e2)) eqs let eqs_solve ids_in eqs_in = let rec solve (sub: Sil.subst) (eqs: (Exp.t * Exp.t) list) : Sil.subst option = @@ -624,7 +624,7 @@ let eqs_solve ids_in eqs_in = | _ :: _ -> None in let compute_ids sub = let sub_list = Sil.sub_to_list sub in - let sub_dom = IList.map fst sub_list in + let sub_dom = List.map ~f:fst sub_list in let filter id = not (List.exists ~f:(fun id' -> Ident.equal id id') sub_dom) in List.filter ~f:filter ids_in in @@ -666,19 +666,19 @@ let sigma_special_cases ids sigma : (Ident.t list * Sil.hpred list) list = match (eqs_solve ids_all eqs_cur) with | None -> acc | Some (ids_res, sub) -> - (ids_res, IList.map (Sil.hpred_sub sub) sigma_cur) :: acc in + (ids_res, List.map ~f:(Sil.hpred_sub sub) sigma_cur) :: acc in List.fold ~f ~init:[] special_cases_eqs in IList.rev special_cases_rev let hpara_special_cases hpara : Sil.hpara list = let update_para (evars', body') = { hpara with Sil.evars = evars'; Sil.body = body'} in let special_cases = sigma_special_cases hpara.Sil.evars hpara.Sil.body in - IList.map update_para special_cases + List.map ~f:update_para special_cases let hpara_special_cases_dll hpara : Sil.hpara_dll list = let update_para (evars', body') = { hpara with Sil.evars_dll = evars'; Sil.body_dll = body'} in let special_cases = sigma_special_cases hpara.Sil.evars_dll hpara.Sil.body_dll in - IList.map update_para special_cases + List.map ~f:update_para special_cases let abs_rules_apply_rsets tenv (rsets: rule_set list) (p_in: Prop.normal Prop.t) : Prop.normal Prop.t = let apply_rule (changed, p) r = @@ -703,21 +703,9 @@ let abs_rules_apply_lists tenv (p_in: Prop.normal Prop.t) : Prop.normal Prop.t = let (closed_paras_sll, closed_paras_dll) = let paras_sll = discover_para tenv p in let paras_dll = discover_para_dll tenv p in - let closed_paras_sll = List.concat (IList.map hpara_special_cases paras_sll) in - let closed_paras_dll = List.concat (IList.map hpara_special_cases_dll paras_dll) in + let closed_paras_sll = List.concat_map ~f:hpara_special_cases paras_sll in + let closed_paras_dll = List.concat_map ~f:hpara_special_cases_dll paras_dll in begin - (* - if IList.length closed_paras_sll >= 1 then - begin - L.out "@.... discovered predicates ....@."; - L.out "@[<4> pred : %a@\n@." pp_hpara_list closed_paras_sll; - end - if IList.length closed_paras_dll >= 1 then - begin - L.out "@.... discovered predicates ....@."; - L.out "@[<4> pred : %a@\n@." pp_hpara_dll_list closed_paras_dll; - end - *) (closed_paras_sll, closed_paras_dll) end in let (todo_paras_sll, todo_paras_dll) = @@ -738,9 +726,9 @@ let abs_rules_apply_lists tenv (p_in: Prop.normal Prop.t) : Prop.normal Prop.t = (todo_paras_sll, todo_paras_dll) in let f_recurse () = let todo_rsets_sll = - IList.map (fun para -> (SLL para, mk_rules_for_sll tenv para)) todo_paras_sll in + List.map ~f:(fun para -> (SLL para, mk_rules_for_sll tenv para)) todo_paras_sll in let todo_rsets_dll = - IList.map (fun para -> (DLL para, mk_rules_for_dll tenv para)) todo_paras_dll in + List.map ~f:(fun para -> (DLL para, mk_rules_for_dll tenv para)) todo_paras_dll in new_rsets := !new_rsets @ todo_rsets_sll @ todo_rsets_dll; let p' = abs_rules_apply_rsets tenv todo_rsets_sll p in let p'' = abs_rules_apply_rsets tenv todo_rsets_dll p' in @@ -985,7 +973,7 @@ let get_var_retain_cycle prop_ = | hp:: sigma' -> let cycle = get_cycle hp prop_ in L.d_strln "Filtering pvar in cycle "; - let cycle' = List.concat (IList.map find_or_block cycle) in + let cycle' = List.concat_map ~f:find_or_block cycle in if List.is_empty cycle' then do_sigma sigma' else cycle' in do_sigma sigma @@ -1144,7 +1132,7 @@ let check_junk ?original_prop pname tenv prop = Otherwise we report a retain cycle. *) let cycle = get_var_retain_cycle (remove_opt original_prop) in let ignore_cycle = - (Int.equal (IList.length cycle) 0) || + (Int.equal (List.length cycle) 0) || (cycle_has_weak_or_unretained_or_assign_field tenv cycle) in ignore_cycle, exn_retain_cycle cycle | Some _, Rmemory Mobjc @@ -1160,7 +1148,7 @@ let check_junk ?original_prop pname tenv prop = we have a retain cycle. Objc object may not have the Mobjc qualifier when added in footprint doing abduction *) let cycle = get_var_retain_cycle (remove_opt original_prop) in - Int.equal (IList.length cycle) 0, exn_retain_cycle cycle + Int.equal (List.length cycle) 0, exn_retain_cycle cycle | _ -> Config.curr_language_is Config.Java, exn_leak) in let already_reported () = let attr_opt_equal ao1 ao2 = match ao1, ao2 with @@ -1190,7 +1178,7 @@ let check_junk ?original_prop pname tenv prop = remove_junk_recursive [] sigma in let rec remove_junk fp_part fav_root sigma = (* call remove_junk_once until sigma stops shrinking *) let sigma' = remove_junk_once fp_part fav_root sigma in - if Int.equal (IList.length sigma') (IList.length sigma) then sigma' + if Int.equal (List.length sigma') (List.length sigma) then sigma' else remove_junk fp_part fav_root sigma' in let sigma_new = remove_junk false fav_sub_sigmafp prop.Prop.sigma in let sigma_fp_new = remove_junk true (Sil.fav_new ()) prop.Prop.sigma_fp in @@ -1240,9 +1228,9 @@ let get_local_stack cur_sigma init_sigma = | Sil.Hpointsto (Exp.Lvar pvar, _, _) -> not (List.exists ~f:(Pvar.equal pvar) olds) | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> false in let init_stack = List.filter ~f:filter_stack init_sigma in - let init_stack_pvars = IList.map get_stack_var init_stack in + let init_stack_pvars = List.map ~f:get_stack_var init_stack in let cur_local_stack = List.filter ~f:(filter_local_stack init_stack_pvars) cur_sigma in - let cur_local_stack_pvars = IList.map get_stack_var cur_local_stack in + let cur_local_stack_pvars = List.map ~f:get_stack_var cur_local_stack in (cur_local_stack, cur_local_stack_pvars) (** Extract the footprint, add a local stack and return it as a prop *) diff --git a/infer/src/backend/absarray.ml b/infer/src/backend/absarray.ml index 9d09d28c6..74298c022 100644 --- a/infer/src/backend/absarray.ml +++ b/infer/src/backend/absarray.ml @@ -104,7 +104,7 @@ end = struct Ident.equal_fieldname f' fld) fields) in let se_mod = replace_strexp_at_syn_offsets tenv se' t' syn_offs' update in let fsel' = - IList.map (fun (f'', se'') -> + List.map ~f:(fun (f'', se'') -> if Ident.equal_fieldname f'' fld then (fld, se_mod) else (f'', se'') ) fsel in Sil.Estruct (fsel', inst) @@ -115,7 +115,7 @@ end = struct let se' = snd (List.find_exn ~f:(fun (i', _) -> Exp.equal i' idx) esel) in let se_mod = replace_strexp_at_syn_offsets tenv se' t' syn_offs' update in let esel' = - IList.map (fun ese -> if Exp.equal (fst ese) idx then (idx, se_mod) else ese) esel in + List.map ~f:(fun ese -> if Exp.equal (fst ese) idx then (idx, se_mod) else ese) esel in Sil.Earray (len, esel', inst) | _ -> assert false @@ -124,10 +124,10 @@ end = struct let rec convert acc = function | [] -> acc | Field (f, t) :: syn_offs' -> - let acc' = IList.map (fun e -> Exp.Lfield (e, f, t)) acc in + let acc' = List.map ~f:(fun e -> Exp.Lfield (e, f, t)) acc in convert acc' syn_offs' | Index idx :: syn_offs' -> - let acc' = IList.map (fun e -> Exp.Lindex (e, idx)) acc in + let acc' = List.map ~f:(fun e -> Exp.Lindex (e, idx)) acc in convert acc' syn_offs' in begin convert [root] syn_offs_in @@ -138,7 +138,7 @@ end = struct let offset_to_syn_offset = function | Sil.Off_fld (fld, typ) -> Field (fld, typ) | Sil.Off_index idx -> Index idx in - let syn_offs = IList.map offset_to_syn_offset offs in + let syn_offs = List.map ~f:offset_to_syn_offset offs in (root, syn_offs) (** path to the root, len, elements and type of a new_array *) @@ -221,7 +221,7 @@ end = struct (** Replace the current hpred *) let replace_hpred ((sigma, hpred, _) : t) hpred' = - IList.map (fun hpred'' -> if phys_equal hpred'' hpred then hpred' else hpred'') sigma + List.map ~f:(fun hpred'' -> if phys_equal hpred'' hpred then hpred' else hpred'') sigma (** Replace the strexp at the given offset in the given hpred *) let hpred_replace_strexp tenv footprint_part hpred syn_offs update = @@ -229,11 +229,11 @@ end = struct let se_in = update se' in match se', se_in with | Sil.Earray (len, esel, _), Sil.Earray (_, esel_in, inst2) -> - let orig_indices = IList.map fst esel in + let orig_indices = List.map ~f:fst esel in let index_is_not_new idx = List.exists ~f:(Exp.equal idx) orig_indices in let process_index idx = if index_is_not_new idx then idx else (Sil.array_clean_new_index footprint_part idx) in - let esel_in' = IList.map (fun (idx, se) -> process_index idx, se) esel_in in + let esel_in' = List.map ~f:(fun (idx, se) -> process_index idx, se) esel_in in Sil.Earray (len, esel_in', inst2) | _, _ -> se_in in begin @@ -257,7 +257,7 @@ end = struct match se' with | Sil.Earray (len, esel, inst) -> let esel' = - IList.map (fun (e', se') -> + List.map ~f:(fun (e', se') -> if Exp.equal e' index then (index', se') else (e', se') ) esel in Sil.Earray (len, esel', inst) @@ -333,7 +333,7 @@ let generic_strexp_abstract tenv let rec match_abstract p0 matchings_cur_fp = try let matched, footprint_part, matchings_cur_fp' = match_select_next matchings_cur_fp in - let n = IList.length (snd matchings_cur_fp') + 1 in + let n = List.length (snd matchings_cur_fp') + 1 in if Config.trace_absarray then (L.d_strln ("Num of fp candidates " ^ (string_of_int n))); let strexp_data = StrexpMatch.get_data tenv matched in let p1, changed = do_abstract footprint_part p0 strexp_data in @@ -351,7 +351,7 @@ let generic_strexp_abstract tenv if changed then find_then_abstract (bound - 1) p1 else p0 end in let matchings_cur, matchings_fp = find_strexp_to_abstract p_in in - let num_matches = (IList.length matchings_cur) + (IList.length matchings_fp) in + let num_matches = (List.length matchings_cur) + (List.length matchings_fp) in begin find_then_abstract num_matches p_in end @@ -365,8 +365,8 @@ let index_is_pointed_to tenv (p: Prop.normal Prop.t) (path: StrexpMatch.path) (i let add_index_to_paths = let elist_path = StrexpMatch.path_to_exps path in let add_index i e = Prop.exp_normalize_prop tenv p (Exp.Lindex(e, i)) in - fun i -> IList.map (add_index i) elist_path in - let pointers = List.concat (IList.map add_index_to_paths indices) in + fun i -> List.map ~f:(add_index i) elist_path in + let pointers = List.concat_map ~f:add_index_to_paths indices in let filter = function | Sil.Hpointsto (_, Sil.Eexp (e, _), _) -> List.exists ~f:(Exp.equal e) pointers | _ -> false in @@ -413,7 +413,7 @@ let blur_array_indices tenv (root: StrexpMatch.path) (indices: Exp.t list) : Prop.normal Prop.t * bool = let f prop index = blur_array_index tenv prop root index in - (List.fold ~f ~init:p indices, IList.length indices > 0) + (List.fold ~f ~init:p indices, List.length indices > 0) (** Given [p] containing an array at [root], only keep [indices] in it *) @@ -450,7 +450,7 @@ let array_typ_can_abstract = function let strexp_can_abstract ((_, se, typ) : StrexpMatch.strexp_data) : bool = let can_abstract_se = match se with | Sil.Earray (_, esel, _) -> - let len = IList.length esel in + let len = List.length esel in len > 1 | _ -> false in can_abstract_se && array_typ_can_abstract typ @@ -481,7 +481,7 @@ let strexp_do_abstract tenv let partition_abstract should_keep abstract ksel default_keys = let keep_ksel, remove_ksel = IList.partition should_keep ksel in let keep_keys, _, _ = - IList.map fst keep_ksel, IList.map fst remove_ksel, IList.map fst ksel in + List.map ~f:fst keep_ksel, List.map ~f:fst remove_ksel, List.map ~f:fst ksel in let keep_keys' = if List.is_empty keep_keys then default_keys else keep_keys in abstract keep_keys' keep_keys' in let do_array_footprint esel = @@ -489,7 +489,7 @@ let strexp_do_abstract tenv let should_keep (i0, _) = index_is_pointed_to tenv p path i0 in let abstract = prune_and_blur_indices path in let default_indices = - match IList.map fst esel with + match List.map ~f:fst esel with | [] -> [] | indices -> [List.hd_exn (IList.rev indices)] (* keep last key at least *) in partition_abstract should_keep abstract esel default_indices in @@ -500,7 +500,7 @@ let strexp_do_abstract tenv let filter_abstract d_keys should_keep abstract ksel default_keys = let keep_ksel = List.filter ~f:should_keep ksel in - let keep_keys = IList.map fst keep_ksel in + let keep_keys = List.map ~f:fst keep_ksel in let keep_keys' = if List.is_empty keep_keys then default_keys else keep_keys in if Config.trace_absarray then (L.d_str "keep "; d_keys keep_keys'; L.d_ln ()); abstract keep_keys' [] in @@ -541,7 +541,7 @@ let check_after_array_abstraction tenv prop = | Sil.Eexp _ -> () | Sil.Earray (_, esel, _) -> (* check that no more than 2 elements are in the array *) let typ_elem = Typ.array_elem (Some Typ.Tvoid) typ in - if IList.length esel > 2 && array_typ_can_abstract typ then + if List.length esel > 2 && array_typ_can_abstract typ then if List.for_all ~f:(check_index root offs) esel then () else report_error prop else List.iter @@ -582,7 +582,7 @@ let remove_redundant_elements tenv prop = let favl_curr = Sil.fav_to_list fav_curr in let favl_foot = Sil.fav_to_list fav_foot in Sil.fav_duplicates := false; - let num_occur l id = IList.length (List.filter ~f:(fun id' -> Ident.equal id id') l) in + let num_occur l id = List.length (List.filter ~f:(fun id' -> Ident.equal id id') l) in let at_most_once v = num_occur favl_curr v <= 1 && num_occur favl_foot v <= 1 in at_most_once in @@ -610,7 +610,7 @@ let remove_redundant_elements tenv prop = let se' = remove_redundant_se fp_part se in Sil.Hpointsto (e, se', te) | hpred -> hpred in - let remove_redundant_sigma fp_part sigma = IList.map (remove_redundant_hpred fp_part) sigma in + let remove_redundant_sigma fp_part sigma = List.map ~f:(remove_redundant_hpred fp_part) sigma in let sigma' = remove_redundant_sigma false prop.Prop.sigma in let sigma_fp' = remove_redundant_sigma true prop.Prop.sigma_fp in if !modified then diff --git a/infer/src/backend/buckets.ml b/infer/src/backend/buckets.ml index ebb5dd1f5..2f716f714 100644 --- a/infer/src/backend/buckets.ml +++ b/infer/src/backend/buckets.ml @@ -59,7 +59,7 @@ let check_access access_opt de_opt = | None -> [] | Some (_, _, pdesc) -> Procdesc.get_formals pdesc in - let formal_names = IList.map fst formals in + let formal_names = List.map ~f:fst formals in let is_formal pvar = let name = Pvar.get_name pvar in List.exists ~f:(Mangled.equal name) formal_names in diff --git a/infer/src/backend/callbacks.ml b/infer/src/backend/callbacks.ml index 7348514a9..0de1dbe40 100644 --- a/infer/src/backend/callbacks.ml +++ b/infer/src/backend/callbacks.ml @@ -68,7 +68,7 @@ let iterate_procedure_callbacks exe_env caller_pname = let get_procs_in_file proc_name = match Exe_env.get_cfg exe_env proc_name with | Some cfg-> - IList.map Procdesc.get_proc_name (Cfg.get_defined_procs cfg) + List.map ~f:Procdesc.get_proc_name (Cfg.get_defined_procs cfg) | None -> [] in @@ -111,12 +111,11 @@ let iterate_cluster_callbacks all_procs exe_env proc_names = let get_procdesc = Exe_env.get_proc_desc exe_env in let procedure_definitions = - IList.map (get_procedure_definition exe_env) proc_names - |> IList.flatten_options in + List.filter_map ~f:(get_procedure_definition exe_env) proc_names in let environment = - IList.map - (fun (idenv, tenv, proc_name, proc_desc, _) -> (idenv, tenv, proc_name, proc_desc)) + List.map + ~f:(fun (idenv, tenv, proc_name, proc_desc, _) -> (idenv, tenv, proc_name, proc_desc)) procedure_definitions in (* Procedures matching the given language or all if no language is specified. *) @@ -129,7 +128,7 @@ let iterate_cluster_callbacks all_procs exe_env proc_names = List.iter ~f:(fun (language_opt, cluster_callback) -> let proc_names = relevant_procedures language_opt in - if IList.length proc_names > 0 then + if List.length proc_names > 0 then cluster_callback exe_env all_procs get_procdesc environment) !cluster_callbacks diff --git a/infer/src/backend/crashcontext.ml b/infer/src/backend/crashcontext.ml index 49fe838bf..d270c5ff0 100644 --- a/infer/src/backend/crashcontext.ml +++ b/infer/src/backend/crashcontext.ml @@ -49,8 +49,8 @@ let stracktree_of_frame frame = (** k = 1 implementation, where k is the number of levels of calls inlined *) let stitch_summaries stacktrace_file summary_files out_file = let stacktrace = Stacktrace.of_json_file stacktrace_file in - let summaries = IList.map - (Ag_util.Json.from_file Stacktree_j.read_stacktree) + let summaries = List.map + ~f:(Ag_util.Json.from_file Stacktree_j.read_stacktree) summary_files in let summary_map = List.fold ~f:(fun acc stacktree -> @@ -64,7 +64,7 @@ let stitch_summaries stacktrace_file summary_files out_file = String.Map.find_exn summary_map frame_id else stracktree_of_frame frame in - let expanded_frames = IList.map expand_stack_frame stacktrace.frames in + let expanded_frames = List.map ~f:expand_stack_frame stacktrace.frames in let crashcontext = { Stacktree_j.stack = expanded_frames} in Ag_util.Json.to_file Stacktree_j.write_crashcontext_t out_file crashcontext diff --git a/infer/src/backend/dom.ml b/infer/src/backend/dom.ml index 3bf514942..3a10bf457 100644 --- a/infer/src/backend/dom.ml +++ b/infer/src/backend/dom.ml @@ -31,10 +31,10 @@ let equal_sigma sigma1 sigma2 = match (sigma1_rest, sigma2_rest) with | [], [] -> () | [], _:: _ | _:: _, [] -> - (L.d_strln "failure reason 1"; raise IList.Fail) + (L.d_strln "failure reason 1"; raise Sil.JoinFail) | hpred1:: sigma1_rest', hpred2:: sigma2_rest' -> if Sil.equal_hpred hpred1 hpred2 then f sigma1_rest' sigma2_rest' - else (L.d_strln "failure reason 2"; raise IList.Fail) in + else (L.d_strln "failure reason 2"; raise Sil.JoinFail) in let sigma1_sorted = IList.sort Sil.compare_hpred sigma1 in let sigma2_sorted = IList.sort Sil.compare_hpred sigma2 in f sigma1_sorted sigma2_sorted @@ -136,14 +136,14 @@ end = struct let new_c = lookup_const' const_tbl new_r in let old_c = lookup_const' const_tbl old_r in let res_c = Exp.Set.union new_c old_c in - if Exp.Set.cardinal res_c > 1 then (L.d_strln "failure reason 3"; raise IList.Fail); + if Exp.Set.cardinal res_c > 1 then (L.d_strln "failure reason 3"; raise Sil.JoinFail); Hashtbl.replace tbl old_r new_r; Hashtbl.replace const_tbl new_r res_c let replace_const' tbl const_tbl e c = let r = find' tbl e in let set = Exp.Set.add c (lookup_const' const_tbl r) in - if Exp.Set.cardinal set > 1 then (L.d_strln "failure reason 4"; raise IList.Fail); + if Exp.Set.cardinal set > 1 then (L.d_strln "failure reason 4"; raise Sil.JoinFail); Hashtbl.replace const_tbl r set let add side e e' = @@ -159,16 +159,16 @@ end = struct | true, true -> union' tbl const_tbl e e' | true, false -> replace_const' tbl const_tbl e e' | false, true -> replace_const' tbl const_tbl e' e - | _ -> L.d_strln "failure reason 5"; raise IList.Fail + | _ -> L.d_strln "failure reason 5"; raise Sil.JoinFail end | Exp.Var id, Exp.Const _ | Exp.Var id, Exp.Lvar _ -> if (can_rename id) then replace_const' tbl const_tbl e e' - else (L.d_strln "failure reason 6"; raise IList.Fail) + else (L.d_strln "failure reason 6"; raise Sil.JoinFail) | Exp.Const _, Exp.Var id' | Exp.Lvar _, Exp.Var id' -> if (can_rename id') then replace_const' tbl const_tbl e' e - else (L.d_strln "failure reason 7"; raise IList.Fail) + else (L.d_strln "failure reason 7"; raise Sil.JoinFail) | _ -> - if not (Exp.equal e e') then (L.d_strln "failure reason 8"; raise IList.Fail) else () + if not (Exp.equal e e') then (L.d_strln "failure reason 8"; raise Sil.JoinFail) else () let check side es = let f = function Exp.Var id -> can_rename id | _ -> false in @@ -178,7 +178,7 @@ end = struct | Lhs -> equiv_tbl1, const_tbl1 | Rhs -> equiv_tbl2, const_tbl2 in - if (IList.length nonvars > 1) then false + if (List.length nonvars > 1) then false else match vars, nonvars with | [], _ | [_], [] -> true @@ -249,7 +249,7 @@ module CheckJoinPre : InfoLossCheckerSig = struct let side_op = opposite side in match e with | Exp.Lvar _ -> false - | Exp.Var id when Ident.is_normal id -> IList.length es >= 1 + | Exp.Var id when Ident.is_normal id -> List.length es >= 1 | Exp.Var _ -> if Int.equal Config.join_cond 0 then List.exists ~f:(Exp.equal Exp.zero) es @@ -298,7 +298,7 @@ module CheckJoinPost : InfoLossCheckerSig = struct let fail_case _ e es = match e with | Exp.Lvar _ -> false - | Exp.Var id when Ident.is_normal id -> IList.length es >= 1 + | Exp.Var id when Ident.is_normal id -> List.length es >= 1 | Exp.Var _ -> false | _ -> false @@ -466,7 +466,7 @@ end = struct let ineq_upper = Prop.mk_inequality tenv (Exp.BinOp(Binop.Le, e, upper)) in ineq_lower:: ineq_upper:: acc - let minus2_to_2 = IList.map IntLit.of_int [-2; -1; 0; 1; 2] + let minus2_to_2 = List.map ~f:IntLit.of_int [-2; -1; 0; 1; 2] let get_induced_pi tenv () = let t_sorted = IList.sort entry_compare !t in @@ -571,13 +571,13 @@ end = struct | Exp.BinOp (Binop.PlusA, Exp.Var _, _) -> let is_same_e (e1, e2, _) = Exp.equal e (select side e1 e2) in let assoc = List.filter ~f:is_same_e !tbl in - IList.map (fun (e1, e2, _) -> select side_op e1 e2) assoc + List.map ~f:(fun (e1, e2, _) -> select side_op e1 e2) assoc | _ -> L.d_str "no pattern match in check lost_little e: "; Sil.d_exp e; L.d_ln (); - raise IList.Fail in + raise Sil.JoinFail in lost_little side e assoc_es in - let lhs_es = IList.map (fun (e1, _, _) -> e1) !tbl in - let rhs_es = IList.map (fun (_, e2, _) -> e2) !tbl in + let lhs_es = List.map ~f:(fun (e1, _, _) -> e1) !tbl in + let rhs_es = List.map ~f:(fun (_, e2, _) -> e2) !tbl in (List.for_all ~f:(f Rhs) rhs_es) && (List.for_all ~f:(f Lhs) lhs_es) let lookup_side' side e = @@ -611,22 +611,22 @@ end = struct let r = lookup_side' side e in match r with | [(_, _, id) as t] -> if todo then Todo.push t; id - | _ -> L.d_strln "failure reason 9"; raise IList.Fail + | _ -> L.d_strln "failure reason 9"; raise Sil.JoinFail end | Exp.Var _ | Exp.Const _ | Exp.Lvar _ -> if todo then Todo.push (e, e, e); e - | _ -> L.d_strln "failure reason 10"; raise IList.Fail + | _ -> L.d_strln "failure reason 10"; raise Sil.JoinFail let lookup side e = lookup' false side e let lookup_todo side e = lookup' true side e - let lookup_list side l = IList.map (lookup side) l - let lookup_list_todo side l = IList.map (lookup_todo side) l + let lookup_list side l = List.map ~f:(lookup side) l + let lookup_list_todo side l = List.map ~f:(lookup_todo side) l let to_subst_proj (side: side) vars = let renaming_restricted = List.filter ~f:(function (_, _, Exp.Var i) -> Sil.fav_mem vars i | _ -> assert false) !tbl in let sub_list_side = - IList.map - (function (e1, e2, Exp.Var i) -> (i, select side e1 e2) | _ -> assert false) + List.map + ~f:(function (e1, e2, Exp.Var i) -> (i, select side e1 e2) | _ -> assert false) renaming_restricted in let sub_list_side_sorted = IList.sort (fun (_, e) (_, e') -> Exp.compare e e') sub_list_side in @@ -634,7 +634,7 @@ end = struct function | (_, e):: ((_, e'):: _ as t) -> Exp.equal e e' || find_duplicates t | _ -> false in - if find_duplicates sub_list_side_sorted then (L.d_strln "failure reason 11"; raise IList.Fail) + if find_duplicates sub_list_side_sorted then (L.d_strln "failure reason 11"; raise Sil.JoinFail) else Sil.sub_of_list sub_list_side let to_subst_emb (side : side) = @@ -649,14 +649,14 @@ end = struct match select side e1 e2 with | Exp.Var i -> (i, e) | _ -> assert false in - IList.map project renaming_restricted in + List.map ~f:project renaming_restricted in let sub_list_sorted = let compare (i, _) (i', _) = Ident.compare i i' in IList.sort compare sub_list in let rec find_duplicates = function | (i, _):: ((i', _):: _ as t) -> Ident.equal i i' || find_duplicates t | _ -> false in - if find_duplicates sub_list_sorted then (L.d_strln "failure reason 12"; raise IList.Fail) + if find_duplicates sub_list_sorted then (L.d_strln "failure reason 12"; raise Sil.JoinFail) else Sil.sub_of_list sub_list_sorted let get_others' f_lookup side e = @@ -761,7 +761,7 @@ end = struct Sil.fav_exists fav1 Ident.is_primed || Sil.fav_exists fav2 Ident.is_primed in let e = if (no_ren1 && no_ren2) then - if (Exp.equal e1 e2) then e1 else (L.d_strln "failure reason 13"; raise IList.Fail) + if (Exp.equal e1 e2) then e1 else (L.d_strln "failure reason 13"; raise Sil.JoinFail) else match default_op with | ExtDefault e -> e @@ -844,13 +844,15 @@ let ident_same_kind_primed_footprint id1 id2 = let ident_partial_join (id1: Ident.t) (id2: Ident.t) = match Ident.is_normal id1, Ident.is_normal id2 with | true, true -> - if Ident.equal id1 id2 then Exp.Var id1 else (L.d_strln "failure reason 14"; raise IList.Fail) + if Ident.equal id1 id2 + then Exp.Var id1 + else (L.d_strln "failure reason 14"; raise Sil.JoinFail) | true, _ | _, true -> Rename.extend (Exp.Var id1) (Exp.Var id2) Rename.ExtFresh | _ -> begin if not (ident_same_kind_primed_footprint id1 id2) then - (L.d_strln "failure reason 15"; raise IList.Fail) + (L.d_strln "failure reason 15"; raise Sil.JoinFail) else let e1 = Exp.Var id1 in let e2 = Exp.Var id2 in @@ -861,7 +863,7 @@ let ident_partial_meet (id1: Ident.t) (id2: Ident.t) = match Ident.is_normal id1, Ident.is_normal id2 with | true, true -> if Ident.equal id1 id2 then Exp.Var id1 - else (L.d_strln "failure reason 16"; raise IList.Fail) + else (L.d_strln "failure reason 16"; raise Sil.JoinFail) | true, _ -> let e1, e2 = Exp.Var id1, Exp.Var id2 in Rename.extend e1 e2 (Rename.ExtDefault(e1)) @@ -874,7 +876,7 @@ let ident_partial_meet (id1: Ident.t) (id2: Ident.t) = else if Ident.is_footprint id1 && Ident.equal id1 id2 then let e = Exp.Var id1 in Rename.extend e e (Rename.ExtDefault(e)) else - (L.d_strln "failure reason 17"; raise IList.Fail) + (L.d_strln "failure reason 17"; raise Sil.JoinFail) (** {2 Join and Meet for Exps} *) @@ -888,10 +890,10 @@ let const_partial_join c1 c2 = let is_int = function Const.Cint _ -> true | _ -> false in if Const.equal c1 c2 then Exp.Const c1 else if Const.kind_equal c1 c2 && not (is_int c1) then - (L.d_strln "failure reason 18"; raise IList.Fail) + (L.d_strln "failure reason 18"; raise Sil.JoinFail) else if !Config.abs_val >= 2 then FreshVarExp.get_fresh_exp (Exp.Const c1) (Exp.Const c2) - else (L.d_strln "failure reason 19"; raise IList.Fail) + else (L.d_strln "failure reason 19"; raise Sil.JoinFail) let rec exp_partial_join (e1: Exp.t) (e2: Exp.t) : Exp.t = (* L.d_str "exp_partial_join "; Sil.d_exp e1; L.d_str " "; Sil.d_exp e2; L.d_ln (); *) @@ -902,7 +904,7 @@ let rec exp_partial_join (e1: Exp.t) (e2: Exp.t) : Exp.t = | Exp.Var id, Exp.Const _ | Exp.Const _, Exp.Var id -> if Ident.is_normal id then - (L.d_strln "failure reason 20"; raise IList.Fail) + (L.d_strln "failure reason 20"; raise Sil.JoinFail) else Rename.extend e1 e2 Rename.ExtFresh | Exp.Const c1, Exp.Const c2 -> @@ -910,7 +912,7 @@ let rec exp_partial_join (e1: Exp.t) (e2: Exp.t) : Exp.t = | Exp.Var id, Exp.Lvar _ | Exp.Lvar _, Exp.Var id -> - if Ident.is_normal id then (L.d_strln "failure reason 21"; raise IList.Fail) + if Ident.is_normal id then (L.d_strln "failure reason 21"; raise Sil.JoinFail) else Rename.extend e1 e2 Rename.ExtFresh | Exp.BinOp(Binop.PlusA, Exp.Var id1, Exp.Const _), Exp.Var id2 @@ -928,12 +930,12 @@ let rec exp_partial_join (e1: Exp.t) (e2: Exp.t) : Exp.t = let e_res = Rename.extend (Exp.int c1') (Exp.Var id2) Rename.ExtFresh in Exp.BinOp(Binop.PlusA, e_res, Exp.int c2) | Exp.Cast(t1, e1), Exp.Cast(t2, e2) -> - if not (Typ.equal t1 t2) then (L.d_strln "failure reason 22"; raise IList.Fail) + if not (Typ.equal t1 t2) then (L.d_strln "failure reason 22"; raise Sil.JoinFail) else let e1'' = exp_partial_join e1 e2 in Exp.Cast (t1, e1'') | Exp.UnOp(unop1, e1, topt1), Exp.UnOp(unop2, e2, _) -> - if not (Unop.equal unop1 unop2) then (L.d_strln "failure reason 23"; raise IList.Fail) + if not (Unop.equal unop1 unop2) then (L.d_strln "failure reason 23"; raise Sil.JoinFail) else Exp.UnOp (unop1, exp_partial_join e1 e2, topt1) (* should be topt1 = topt2 *) | Exp.BinOp(Binop.PlusPI, e1, e1'), Exp.BinOp(Binop.PlusPI, e2, e2') -> let e1'' = exp_partial_join e1 e2 in @@ -942,16 +944,16 @@ let rec exp_partial_join (e1: Exp.t) (e2: Exp.t) : Exp.t = | _ -> FreshVarExp.get_fresh_exp e1 e2 in Exp.BinOp(Binop.PlusPI, e1'', e2'') | Exp.BinOp(binop1, e1, e1'), Exp.BinOp(binop2, e2, e2') -> - if not (Binop.equal binop1 binop2) then (L.d_strln "failure reason 24"; raise IList.Fail) + if not (Binop.equal binop1 binop2) then (L.d_strln "failure reason 24"; raise Sil.JoinFail) else let e1'' = exp_partial_join e1 e2 in let e2'' = exp_partial_join e1' e2' in Exp.BinOp(binop1, e1'', e2'') | Exp.Lvar(pvar1), Exp.Lvar(pvar2) -> - if not (Pvar.equal pvar1 pvar2) then (L.d_strln "failure reason 25"; raise IList.Fail) + if not (Pvar.equal pvar1 pvar2) then (L.d_strln "failure reason 25"; raise Sil.JoinFail) else e1 | Exp.Lfield(e1, f1, t1), Exp.Lfield(e2, f2, _) -> - if not (Ident.equal_fieldname f1 f2) then (L.d_strln "failure reason 26"; raise IList.Fail) + if not (Ident.equal_fieldname f1 f2) then (L.d_strln "failure reason 26"; raise Sil.JoinFail) else Exp.Lfield(exp_partial_join e1 e2, f1, t1) (* should be t1 = t2 *) | Exp.Lindex(e1, e1'), Exp.Lindex(e2, e2') -> let e1'' = exp_partial_join e1 e2 in @@ -962,7 +964,7 @@ let rec exp_partial_join (e1: Exp.t) (e2: Exp.t) : Exp.t = (typ_partial_join t1 t2, dynamic_length_partial_join len1 len2, Subtype.join st1 st2) | _ -> L.d_str "exp_partial_join no match "; Sil.d_exp e1; L.d_str " "; Sil.d_exp e2; L.d_ln (); - raise IList.Fail + raise Sil.JoinFail and length_partial_join len1 len2 = match len1, len2 with | Exp.BinOp(Binop.PlusA, e1, Exp.Const c1), Exp.BinOp(Binop.PlusA, e2, Exp.Const c2) -> @@ -992,7 +994,7 @@ and typ_partial_join t1 t2 = match t1, t2 with | _ -> L.d_str "typ_partial_join no match "; Typ.d_full t1; L.d_str " "; Typ.d_full t2; L.d_ln (); - raise IList.Fail + raise Sil.JoinFail let rec exp_partial_meet (e1: Exp.t) (e2: Exp.t) : Exp.t = match e1, e2 with @@ -1001,23 +1003,23 @@ let rec exp_partial_meet (e1: Exp.t) (e2: Exp.t) : Exp.t = | Exp.Var id, Exp.Const _ -> if not (Ident.is_normal id) then Rename.extend e1 e2 (Rename.ExtDefault(e2)) - else (L.d_strln "failure reason 27"; raise IList.Fail) + else (L.d_strln "failure reason 27"; raise Sil.JoinFail) | Exp.Const _, Exp.Var id -> if not (Ident.is_normal id) then Rename.extend e1 e2 (Rename.ExtDefault(e1)) - else (L.d_strln "failure reason 28"; raise IList.Fail) + else (L.d_strln "failure reason 28"; raise Sil.JoinFail) | Exp.Const c1, Exp.Const c2 -> - if (Const.equal c1 c2) then e1 else (L.d_strln "failure reason 29"; raise IList.Fail) + if (Const.equal c1 c2) then e1 else (L.d_strln "failure reason 29"; raise Sil.JoinFail) | Exp.Cast(t1, e1), Exp.Cast(t2, e2) -> - if not (Typ.equal t1 t2) then (L.d_strln "failure reason 30"; raise IList.Fail) + if not (Typ.equal t1 t2) then (L.d_strln "failure reason 30"; raise Sil.JoinFail) else let e1'' = exp_partial_meet e1 e2 in Exp.Cast (t1, e1'') | Exp.UnOp(unop1, e1, topt1), Exp.UnOp(unop2, e2, _) -> - if not (Unop.equal unop1 unop2) then (L.d_strln "failure reason 31"; raise IList.Fail) + if not (Unop.equal unop1 unop2) then (L.d_strln "failure reason 31"; raise Sil.JoinFail) else Exp.UnOp (unop1, exp_partial_meet e1 e2, topt1) (* should be topt1 = topt2 *) | Exp.BinOp(binop1, e1, e1'), Exp.BinOp(binop2, e2, e2') -> - if not (Binop.equal binop1 binop2) then (L.d_strln "failure reason 32"; raise IList.Fail) + if not (Binop.equal binop1 binop2) then (L.d_strln "failure reason 32"; raise Sil.JoinFail) else let e1'' = exp_partial_meet e1 e2 in let e2'' = exp_partial_meet e1' e2' in @@ -1025,26 +1027,26 @@ let rec exp_partial_meet (e1: Exp.t) (e2: Exp.t) : Exp.t = | Exp.Var id, Exp.Lvar _ -> if not (Ident.is_normal id) then Rename.extend e1 e2 (Rename.ExtDefault(e2)) - else (L.d_strln "failure reason 33"; raise IList.Fail) + else (L.d_strln "failure reason 33"; raise Sil.JoinFail) | Exp.Lvar _, Exp.Var id -> if not (Ident.is_normal id) then Rename.extend e1 e2 (Rename.ExtDefault(e1)) - else (L.d_strln "failure reason 34"; raise IList.Fail) + else (L.d_strln "failure reason 34"; raise Sil.JoinFail) | Exp.Lvar(pvar1), Exp.Lvar(pvar2) -> - if not (Pvar.equal pvar1 pvar2) then (L.d_strln "failure reason 35"; raise IList.Fail) + if not (Pvar.equal pvar1 pvar2) then (L.d_strln "failure reason 35"; raise Sil.JoinFail) else e1 | Exp.Lfield(e1, f1, t1), Exp.Lfield(e2, f2, _) -> - if not (Ident.equal_fieldname f1 f2) then (L.d_strln "failure reason 36"; raise IList.Fail) + if not (Ident.equal_fieldname f1 f2) then (L.d_strln "failure reason 36"; raise Sil.JoinFail) else Exp.Lfield(exp_partial_meet e1 e2, f1, t1) (* should be t1 = t2 *) | Exp.Lindex(e1, e1'), Exp.Lindex(e2, e2') -> let e1'' = exp_partial_meet e1 e2 in let e2'' = exp_partial_meet e1' e2' in Exp.Lindex(e1'', e2'') - | _ -> (L.d_strln "failure reason 37"; raise IList.Fail) + | _ -> (L.d_strln "failure reason 37"; raise Sil.JoinFail) -let exp_list_partial_join = IList.map2 exp_partial_join +let exp_list_partial_join = List.map2_exn ~f:exp_partial_join -let exp_list_partial_meet = IList.map2 exp_partial_meet +let exp_list_partial_meet = List.map2_exn ~f:exp_partial_meet (** {2 Join and Meet for Strexp} *) @@ -1057,7 +1059,7 @@ let rec strexp_partial_join mode (strexp1: Sil.strexp) (strexp2: Sil.strexp) : S | [], _ | _, [] -> begin match mode with - | JoinState.Pre -> (L.d_strln "failure reason 42"; raise IList.Fail) + | JoinState.Pre -> (L.d_strln "failure reason 42"; raise Sil.JoinFail) | JoinState.Post -> Sil.Estruct (IList.rev acc, inst) end | (fld1, se1):: fld_se_list1', (fld2, se2):: fld_se_list2' -> @@ -1069,7 +1071,7 @@ let rec strexp_partial_join mode (strexp1: Sil.strexp) (strexp2: Sil.strexp) : S else begin match mode with | JoinState.Pre -> - (L.d_strln "failure reason 43"; raise IList.Fail) + (L.d_strln "failure reason 43"; raise Sil.JoinFail) | JoinState.Post -> if comparison < 0 then begin f_fld_se_list inst mode acc fld_se_list1' fld_se_list2 @@ -1087,7 +1089,7 @@ let rec strexp_partial_join mode (strexp1: Sil.strexp) (strexp2: Sil.strexp) : S | [], _ | _, [] -> begin match mode with - | JoinState.Pre -> (L.d_strln "failure reason 44"; raise IList.Fail) + | JoinState.Pre -> (L.d_strln "failure reason 44"; raise Sil.JoinFail) | JoinState.Post -> Sil.Earray (len, IList.rev idx_se_list_acc, inst) end @@ -1107,13 +1109,13 @@ let rec strexp_partial_join mode (strexp1: Sil.strexp) (strexp2: Sil.strexp) : S let len = length_partial_join len1 len2 in let inst = Sil.inst_partial_join inst1 inst2 in f_idx_se_list inst len [] idx_se_list1 idx_se_list2 - | _ -> L.d_strln "no match in strexp_partial_join"; raise IList.Fail + | _ -> L.d_strln "no match in strexp_partial_join"; raise Sil.JoinFail let rec strexp_partial_meet (strexp1: Sil.strexp) (strexp2: Sil.strexp) : Sil.strexp = let construct side rev_list ref_list = let construct_offset_se (off, se) = (off, strexp_construct_fresh side se) in - let acc = IList.map construct_offset_se ref_list in + let acc = List.map ~f:construct_offset_se ref_list in IList.rev_append rev_list acc in let rec f_fld_se_list inst acc fld_se_list1 fld_se_list2 = @@ -1163,7 +1165,7 @@ let rec strexp_partial_meet (strexp1: Sil.strexp) (strexp2: Sil.strexp) : Sil.st when Exp.equal len1 len2 -> let inst = Sil.inst_partial_meet inst1 inst2 in f_idx_se_list inst len1 [] idx_se_list1 idx_se_list2 - | _ -> (L.d_strln "failure reason 52"; raise IList.Fail) + | _ -> (L.d_strln "failure reason 52"; raise Sil.JoinFail) (** {2 Join and Meet for kind, hpara, hpara_dll} *) @@ -1183,7 +1185,7 @@ let hpara_partial_join tenv (hpara1: Sil.hpara) (hpara2: Sil.hpara) : Sil.hpara else if Match.hpara_match_with_impl tenv true hpara1 hpara2 then hpara2 else - (L.d_strln "failure reason 53"; raise IList.Fail) + (L.d_strln "failure reason 53"; raise Sil.JoinFail) let hpara_partial_meet tenv (hpara1: Sil.hpara) (hpara2: Sil.hpara) : Sil.hpara = if Match.hpara_match_with_impl tenv true hpara2 hpara1 then @@ -1191,7 +1193,7 @@ let hpara_partial_meet tenv (hpara1: Sil.hpara) (hpara2: Sil.hpara) : Sil.hpara else if Match.hpara_match_with_impl tenv true hpara1 hpara2 then hpara1 else - (L.d_strln "failure reason 54"; raise IList.Fail) + (L.d_strln "failure reason 54"; raise Sil.JoinFail) let hpara_dll_partial_join tenv (hpara1: Sil.hpara_dll) (hpara2: Sil.hpara_dll) : Sil.hpara_dll = if Match.hpara_dll_match_with_impl tenv true hpara2 hpara1 then @@ -1199,7 +1201,7 @@ let hpara_dll_partial_join tenv (hpara1: Sil.hpara_dll) (hpara2: Sil.hpara_dll) else if Match.hpara_dll_match_with_impl tenv true hpara1 hpara2 then hpara2 else - (L.d_strln "failure reason 55"; raise IList.Fail) + (L.d_strln "failure reason 55"; raise Sil.JoinFail) let hpara_dll_partial_meet tenv (hpara1: Sil.hpara_dll) (hpara2: Sil.hpara_dll) : Sil.hpara_dll = if Match.hpara_dll_match_with_impl tenv true hpara2 hpara1 then @@ -1207,7 +1209,7 @@ let hpara_dll_partial_meet tenv (hpara1: Sil.hpara_dll) (hpara2: Sil.hpara_dll) else if Match.hpara_dll_match_with_impl tenv true hpara1 hpara2 then hpara1 else - (L.d_strln "failure reason 56"; raise IList.Fail) + (L.d_strln "failure reason 56"; raise Sil.JoinFail) (** {2 Join and Meet for hpred} *) @@ -1231,7 +1233,7 @@ let hpred_partial_join tenv mode (todo: Exp.t * Exp.t * Exp.t) (hpred1: Sil.hpre let iF', iB' = if (fwd1 && fwd2) then (e, exp_partial_join iB1 iB2) else if (not fwd1 && not fwd2) then (exp_partial_join iF1 iF2, e) - else (L.d_strln "failure reason 57"; raise IList.Fail) in + else (L.d_strln "failure reason 57"; raise Sil.JoinFail) in let oF' = exp_partial_join oF1 oF2 in let oB' = exp_partial_join oB1 oB2 in let shared' = exp_list_partial_join shared1 shared2 in @@ -1246,7 +1248,7 @@ let hpred_partial_meet tenv (todo: Exp.t * Exp.t * Exp.t) (hpred1: Sil.hpred) (h | Sil.Hpointsto (_, se1, te1), Sil.Hpointsto (_, se2, te2) when Exp.equal te1 te2 -> Prop.mk_ptsto tenv e (strexp_partial_meet se1 se2) te1 | Sil.Hpointsto _, _ | _, Sil.Hpointsto _ -> - (L.d_strln "failure reason 58"; raise IList.Fail) + (L.d_strln "failure reason 58"; raise Sil.JoinFail) | Sil.Hlseg (k1, hpara1, _, next1, shared1), Sil.Hlseg (k2, hpara2, _, next2, shared2) -> let hpara' = hpara_partial_meet tenv hpara1 hpara2 in let next' = exp_partial_meet next1 next2 in @@ -1260,7 +1262,7 @@ let hpred_partial_meet tenv (todo: Exp.t * Exp.t * Exp.t) (hpred1: Sil.hpred) (h let iF', iB' = if (fwd1 && fwd2) then (e, exp_partial_meet iB1 iB2) else if (not fwd1 && not fwd2) then (exp_partial_meet iF1 iF2, e) - else (L.d_strln "failure reason 59"; raise IList.Fail) in + else (L.d_strln "failure reason 59"; raise Sil.JoinFail) in let oF' = exp_partial_meet oF1 oF2 in let oB' = exp_partial_meet oB1 oB2 in let shared' = exp_list_partial_meet shared1 shared2 in @@ -1314,7 +1316,7 @@ let rec sigma_partial_join' tenv mode (sigma_acc: Prop.sigma) let lookup_and_expand side e e' = match (Rename.get_others side e, side) with - | None, _ -> (L.d_strln "failure reason 60"; raise IList.Fail) + | None, _ -> (L.d_strln "failure reason 60"; raise Sil.JoinFail) | Some(e_res, e_op), Lhs -> (e_res, exp_partial_join e' e_op) | Some(e_res, e_op), Rhs -> (e_res, exp_partial_join e_op e') in @@ -1376,7 +1378,7 @@ let rec sigma_partial_join' tenv mode (sigma_acc: Prop.sigma) 'todo' describes the start point. *) let cut_sigma side todo (target: Prop.sigma) (other: Prop.sigma) = - let list_is_empty l = if l <> [] then (L.d_strln "failure reason 61"; raise IList.Fail) in + let list_is_empty l = if l <> [] then (L.d_strln "failure reason 61"; raise Sil.JoinFail) in let x = Todo.take () in Todo.push todo; let res = @@ -1430,7 +1432,7 @@ let rec sigma_partial_join' tenv mode (sigma_acc: Prop.sigma) let sigma_acc' = join_list_and_non Lhs e lseg e1 e2 :: sigma_acc in sigma_partial_join' tenv mode sigma_acc' sigma1 sigma2 else - (L.d_strln "failure reason 62"; raise IList.Fail) + (L.d_strln "failure reason 62"; raise Sil.JoinFail) | None, Some (Sil.Hlseg (k, _, _, _, _) as lseg) | None, Some (Sil.Hdllseg (k, _, _, _, _, _, _) as lseg) -> @@ -1438,9 +1440,9 @@ let rec sigma_partial_join' tenv mode (sigma_acc: Prop.sigma) let sigma_acc' = join_list_and_non Rhs e lseg e2 e1 :: sigma_acc in sigma_partial_join' tenv mode sigma_acc' sigma1 sigma2 else - (L.d_strln "failure reason 63"; raise IList.Fail) + (L.d_strln "failure reason 63"; raise Sil.JoinFail) - | None, _ | _, None -> (L.d_strln "failure reason 64"; raise IList.Fail) + | None, _ | _, None -> (L.d_strln "failure reason 64"; raise Sil.JoinFail) | Some (hpred1), Some (hpred2) when same_pred hpred1 hpred2 -> let hpred_res1 = hpred_partial_join tenv mode todo_curr hpred1 hpred2 in @@ -1492,7 +1494,7 @@ let rec sigma_partial_join' tenv mode (sigma_acc: Prop.sigma) with Todo.Empty -> match sigma1_in, sigma2_in with - | _:: _, _:: _ -> L.d_strln "todo is empty, but the sigmas are not"; raise IList.Fail + | _:: _, _:: _ -> L.d_strln "todo is empty, but the sigmas are not"; raise Sil.JoinFail | _ -> sigma_acc, sigma1_in, sigma2_in let sigma_partial_join tenv mode (sigma1: Prop.sigma) (sigma2: Prop.sigma) @@ -1506,7 +1508,7 @@ let sigma_partial_join tenv mode (sigma1: Prop.sigma) (sigma2: Prop.sigma) else begin L.d_strln "failed Rename.check"; CheckJoin.final (); - raise IList.Fail + raise Sil.JoinFail end with | exn -> (CheckJoin.final (); raise exn) @@ -1542,12 +1544,12 @@ let rec sigma_partial_meet' tenv (sigma_acc: Prop.sigma) (sigma1_in: Prop.sigma) sigma_partial_meet' tenv (hpred':: sigma_acc) sigma1 sigma2 | Some _, Some _ -> - (L.d_strln "failure reason 65"; raise IList.Fail) + (L.d_strln "failure reason 65"; raise Sil.JoinFail) with Todo.Empty -> match sigma1_in, sigma2_in with | [], [] -> sigma_acc - | _, _ -> L.d_strln "todo is empty, but the sigmas are not"; raise IList.Fail + | _, _ -> L.d_strln "todo is empty, but the sigmas are not"; raise Sil.JoinFail let sigma_partial_meet tenv (sigma1: Prop.sigma) (sigma2: Prop.sigma) : Prop.sigma = sigma_partial_meet' tenv [] sigma1 sigma2 @@ -1616,11 +1618,13 @@ let pi_partial_join tenv mode (* check for atoms in pre mode: fail if the negation is implied by the other side *) let not_a = Prover.atom_negate tenv a in if (Prover.check_atom tenv p not_a) then - (L.d_str "join_atom_check failed on "; Sil.d_atom a; L.d_ln (); raise IList.Fail) in + (L.d_str "join_atom_check failed on "; Sil.d_atom a; L.d_ln (); raise Sil.JoinFail) in let join_atom_check_attribute p a = (* check for attribute: fail if the attribute is not in the other side *) if not (Prover.check_atom tenv p a) then - (L.d_str "join_atom_check_attribute failed on "; Sil.d_atom a; L.d_ln (); raise IList.Fail) in + (L.d_str "join_atom_check_attribute failed on "; + Sil.d_atom a; L.d_ln (); + raise Sil.JoinFail) in let join_atom side p_op pi_op a = (* try to find the atom corresponding to a on the other side, and check if it is implied *) match Rename.get_other_atoms tenv side a with @@ -1688,7 +1692,7 @@ let pi_partial_meet tenv (p: Prop.normal Prop.t) (ep1: 'a Prop.t) (ep2: 'b Prop. let fav_list = Sil.fav_to_list (Sil.atom_fav atom) in if List.for_all ~f:(fun id -> Ident.IdentSet.mem id dom) fav_list then Sil.atom_sub sub atom - else (L.d_str "handle_atom failed on "; Sil.d_atom atom; L.d_ln (); raise IList.Fail) in + else (L.d_str "handle_atom failed on "; Sil.d_atom atom; L.d_ln (); raise Sil.JoinFail) in let f1 p' atom = Prop.prop_atom_and tenv p' (handle_atom sub1 dom1 atom) in let f2 p' atom = @@ -1700,7 +1704,7 @@ let pi_partial_meet tenv (p: Prop.normal Prop.t) (ep1: 'a Prop.t) (ep2: 'b Prop. 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) + then (L.d_strln "check_inconsistency_base failed"; raise Sil.JoinFail) else p_pi2 (** {2 Join and Meet for Prop} *) @@ -1722,9 +1726,9 @@ let eprop_partial_meet tenv (ep1: 'a Prop.t) (ep2: 'b Prop.t) : 'c Prop.t = Sil.equal_subst sub1 sub2 && List.for_all ~f:f range1 in if not (sub_check ()) then - (L.d_strln "sub_check() failed"; raise IList.Fail) + (L.d_strln "sub_check() failed"; raise Sil.JoinFail) else begin - let todos = IList.map (fun x -> (x, x, x)) es in + let todos = List.map ~f:(fun x -> (x, x, x)) es in List.iter ~f:Todo.push todos; let sigma_new = sigma_partial_meet tenv sigma1 sigma2 in let ep = Prop.set ep1 ~sigma:sigma_new in @@ -1745,7 +1749,7 @@ let prop_partial_meet tenv p1 p2 = begin Rename.final (); FreshVarExp.final (); Todo.final (); match exn with - | IList.Fail -> None + | Sil.JoinFail -> None | _ -> raise exn end @@ -1756,7 +1760,7 @@ let eprop_partial_join' tenv mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed let es1 = sigma_get_start_lexps_sort sigma1 in let es2 = sigma_get_start_lexps_sort sigma2 in - let simple_check = Int.equal (IList.length es1) (IList.length es2) in + let simple_check = Int.equal (List.length es1) (List.length es2) in let rec expensive_check es1' es2' = match (es1', es2') with | [], [] -> true @@ -1772,7 +1776,7 @@ let eprop_partial_join' tenv mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed Sil.sub_range_partition f sub_common in let eqs1, eqs2 = let sub_to_eqs sub = - IList.map (fun (id, e) -> Sil.Aeq (Exp.Var id, e)) (Sil.sub_to_list sub) in + List.map ~f:(fun (id, e) -> Sil.Aeq (Exp.Var id, e)) (Sil.sub_to_list sub) in let eqs1 = sub_to_eqs sub1_only @ sub_to_eqs sub_common_other in let eqs2 = sub_to_eqs sub2_only in (eqs1, eqs2) in @@ -1782,9 +1786,9 @@ let eprop_partial_join' tenv mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed begin if not simple_check then L.d_strln "simple_check failed" else L.d_strln "expensive_check failed"; - raise IList.Fail + raise Sil.JoinFail end; - let todos = IList.map (fun x -> (x, x, x)) es1 in + let todos = List.map ~f:(fun x -> (x, x, x)) es1 in List.iter ~f:Todo.push todos; match sigma_partial_join tenv mode sigma1 sigma2 with | sigma_new, [], [] -> @@ -1804,7 +1808,7 @@ let eprop_partial_join' tenv mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed 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 + L.d_strln "leftovers not empty"; raise Sil.JoinFail let footprint_partial_join' tenv (p1: Prop.normal Prop.t) (p2: Prop.normal Prop.t) : Prop.normal Prop.t * Prop.normal Prop.t = if not !Config.footprint then p1, p2 @@ -1819,7 +1823,7 @@ let footprint_partial_join' tenv (p1: Prop.normal Prop.t) (p2: Prop.normal Prop. let sigma_fp = let sigma_fp0 = efp.Prop.sigma in let f a = Sil.fav_exists (Sil.hpred_fav a) (fun a -> not (Ident.is_footprint a)) in - if List.exists ~f sigma_fp0 then (L.d_strln "failure reason 66"; raise IList.Fail); + if List.exists ~f sigma_fp0 then (L.d_strln "failure reason 66"; raise Sil.JoinFail); sigma_fp0 in let ep1' = Prop.set p1 ~pi_fp ~sigma_fp in let ep2' = Prop.set p2 ~pi_fp ~sigma_fp in @@ -1849,7 +1853,7 @@ let prop_partial_join pname tenv mode p1 p2 = begin Rename.final (); FreshVarExp.final (); Todo.final (); (if !Config.footprint then JoinState.set_footprint false); - (match exn with IList.Fail -> None | _ -> raise exn) + (match exn with Sil.JoinFail -> None | _ -> raise exn) end end | Some _ -> res_by_implication_only @@ -1903,7 +1907,7 @@ let jprop_partial_join tenv mode jp1 jp2 = let p = eprop_partial_join tenv mode p1 p2 in let p_renamed = Prop.prop_rename_primed_footprint_vars tenv p in Some (Specs.Jprop.Joined (0, p_renamed, jp1, jp2)) - with IList.Fail -> None + with Sil.JoinFail -> None let jplist_collapse tenv mode jplist = let f = jprop_partial_join tenv mode in @@ -1920,21 +1924,22 @@ let jprop_list_add_ids jplist = let jp2' = do_jprop jp2 in incr seq_number; Specs.Jprop.Joined (!seq_number, p, jp1', jp2') in - IList.map (fun (p, path) -> (do_jprop p, path)) jplist + List.map ~f:(fun (p, path) -> (do_jprop p, path)) jplist let proplist_collapse tenv mode plist = - let jplist = IList.map (fun (p, path) -> (Specs.Jprop.Prop (0, p), path)) plist in + let jplist = List.map ~f:(fun (p, path) -> (Specs.Jprop.Prop (0, p), path)) plist in let jplist_joined = jplist_collapse tenv mode (jplist_collapse tenv mode jplist) in jprop_list_add_ids jplist_joined let proplist_collapse_pre tenv plist = - let plist' = IList.map (fun p -> (p, ())) plist in - IList.map fst (proplist_collapse tenv JoinState.Pre plist') + let plist' = List.map ~f:(fun p -> (p, ())) plist in + List.map ~f:fst (proplist_collapse tenv JoinState.Pre plist') let pathset_collapse tenv pset = let plist = Paths.PathSet.elements pset in let plist' = proplist_collapse tenv JoinState.Post plist in - Paths.PathSet.from_renamed_list (IList.map (fun (p, path) -> (Specs.Jprop.to_prop p, path)) plist') + Paths.PathSet.from_renamed_list + (List.map ~f:(fun (p, path) -> (Specs.Jprop.to_prop p, path)) plist') let join_time = ref 0.0 @@ -1971,7 +1976,7 @@ let pathset_join let (ppa2_new, ppalist1_cur') = join_proppath_plist [] ppa2'' ppalist1_cur in join ppalist1_cur' (ppa2_new:: ppalist2_acc') ppalist2_rest' in let _ppalist1_res, _ppalist2_res = join ppalist1 [] ppalist2 in - let ren l = IList.map (fun (p, x) -> (Prop.prop_rename_primed_footprint_vars tenv p, x)) l in + let ren l = List.map ~f:(fun (p, x) -> (Prop.prop_rename_primed_footprint_vars tenv p, x)) l in let ppalist1_res, ppalist2_res = ren _ppalist1_res, ren _ppalist2_res in let res = (Paths.PathSet.from_renamed_list ppalist1_res, Paths.PathSet.from_renamed_list ppalist2_res) in join_time := !join_time +. (Unix.gettimeofday () -. initial_time); @@ -2008,10 +2013,10 @@ let proplist_meet_generate tenv plist = (* use porig instead of pcombined because it might be combinable with more othe props *) (* e.g. porig might contain a global var to add to the ture branch of a conditional *) (* but pcombined might have been combined with the false branch already *) - let pplist' = IList.map (combine porig) pplist in + let pplist' = List.map ~f:(combine porig) pplist in props_done := Propset.add tenv pcombined !props_done; proplist_meet pplist' in - proplist_meet (IList.map (fun p -> (p, p)) plist); + proplist_meet (List.map ~f:(fun p -> (p, p)) plist); !props_done diff --git a/infer/src/backend/dotty.ml b/infer/src/backend/dotty.ml index 21ee8f79f..d0c898163 100644 --- a/infer/src/backend/dotty.ml +++ b/infer/src/backend/dotty.ml @@ -223,7 +223,7 @@ let rec select_nodes_exp_lambda dotnodes e lambda = (* this is written in this strange way for legacy reason. It should be changed a bit*) let look_up dotnodes e lambda = let r = select_nodes_exp_lambda dotnodes e lambda in - let r'= IList.map get_coordinate_id r in + let r'= List.map ~f:get_coordinate_id r in r' @ look_up_for_back_pointer e dotnodes lambda let reset_proposition_counter () = proposition_counter:= 0 @@ -289,7 +289,7 @@ let make_dangling_boxes pe allocated_nodes (sigma_lambda: (Sil.hpred * int) list | d:: candidates -> if (is_allocated d) then subtract_allocated candidates else d:: subtract_allocated candidates in - let candidate_dangling = List.concat (IList.map get_rhs_predicate sigma_lambda) in + let candidate_dangling = List.concat_map ~f:get_rhs_predicate sigma_lambda in let candidate_dangling = filter_duplicate candidate_dangling [] in let dangling = subtract_allocated candidate_dangling in dangling_dotboxes:= dangling @@ -478,14 +478,14 @@ let compute_target_from_eexp dotnodes e p lambda = else let nodes_e = select_nodes_exp_lambda dotnodes e lambda in let nodes_e_no_struct = List.filter ~f:is_not_struct nodes_e in - let trg = IList.map get_coordinate_id nodes_e_no_struct in + let trg = List.map ~f:get_coordinate_id nodes_e_no_struct in (match trg with | [] -> (match box_dangling e with | None -> [] | Some n -> [(LinkExpToExp, n, "")] ) - | _ -> IList.map (fun n -> (LinkExpToExp, n, "")) trg + | _ -> List.map ~f:(fun n -> (LinkExpToExp, n, "")) trg ) (* build the set of edges between nodes *) @@ -497,8 +497,17 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = | n:: nl -> let target_list = compute_target_array_elements dotnodes lie p f lambda in (* below it's n+1 because n is the address, n+1 is the actual array node*) - let ff n = IList.map (fun (k, lab_src, m, lab_trg) -> mk_link k (mk_coordinate (n + 1) lambda) (strip_special_chars lab_src) (mk_coordinate m lambda) (strip_special_chars lab_trg)) target_list in - let links_from_elements = List.concat (IList.map ff (n:: nl)) in + let ff n = + List.map + ~f:(fun (k, lab_src, m, lab_trg) -> + mk_link + k + (mk_coordinate (n + 1) lambda) + (strip_special_chars lab_src) + (mk_coordinate m lambda) + (strip_special_chars lab_trg)) + target_list in + let links_from_elements = List.concat_map ~f:ff (n:: nl) in let trg_label = strip_special_chars (Exp.to_string e) in let lnk = mk_link (LinkToArray) (mk_coordinate n lambda) "" (mk_coordinate (n + 1) lambda) trg_label in @@ -514,7 +523,7 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = | nl -> (* L.out "@\n@\n List of nl= "; List.iter ~f:(L.out " %i ") nl; L.out "@.@.@."; *) let target_list = compute_target_struct_fields dotnodes lfld p f lambda cycle in - let ff n = IList.map (fun (k, lab_src, m, lab_trg) -> + let ff n = List.map ~f:(fun (k, lab_src, m, lab_trg) -> mk_link k (mk_coordinate n lambda) lab_src (mk_coordinate m lambda) lab_trg ) target_list in let nodes_e = select_nodes_exp_lambda dotnodes e lambda in @@ -523,7 +532,7 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = with exn when SymOp.exn_not_failure exn -> assert false in (* we need to exclude the address node from the sorce of fields. no fields should start from there*) let nl'= List.filter ~f:(fun id -> address_struct_id <> id) nl in - let links_from_fields = List.concat (IList.map ff nl') in + let links_from_fields = List.concat_map ~f:ff nl' in let lnk_from_address_struct = if !print_full_prop then let trg_label = strip_special_chars (Exp.to_string e) in [mk_link (LinkExpToStruct) (mk_coordinate address_struct_id lambda) "" @@ -537,11 +546,11 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = | [] -> assert false | nl -> if !print_full_prop then let target_list = compute_target_from_eexp dotnodes e' p lambda in - let ff n = IList.map (fun (k, m, lab_target) -> + let ff n = List.map ~f:(fun (k, m, lab_target) -> mk_link k (mk_coordinate n lambda) "" (mk_coordinate m lambda) (strip_special_chars lab_target) ) target_list in - let ll = List.concat (IList.map ff nl) in + let ll = List.concat_map ~f:ff nl in ll @ dotty_mk_set_links dotnodes sigma' p f cycle else dotty_mk_set_links dotnodes sigma' p f cycle) @@ -669,10 +678,8 @@ let filter_useless_spec_dollar_box (nodes: dotty_node list) (links: link list) = | Dotpointsto _ -> let e = get_node_exp node in if is_spec_variable e then begin - (*L.out "@\n Found a spec expression = %s @.@." (Exp.to_string e); *) let links_from_node = boxes_pointed_by node links in let links_to_node = boxes_pointing_at node links in - (* L.out "@\n Size of links_from=%i links_to=%i @.@." (IList.length links_from_node) (IList.length links_to_node); *) if List.is_empty links_to_node then begin tmp_links:= remove_links_from links_from_node ; tmp_nodes:= remove_node node !tmp_nodes; @@ -798,7 +805,7 @@ and build_visual_graph f pe p cycle = L.out "@\n@\n Computed exp structs nodes: "; List.iter ~f:(fun e -> L.out " %a " (Sil.pp_exp_printenv pe) e) !struct_exp_nodes; L.out "@\n@."; *) - let sigma_lambda = IList.map (fun hp -> (hp,!lambda_counter)) sigma in + let sigma_lambda = List.map ~f:(fun hp -> (hp,!lambda_counter)) sigma in let nodes = (dotty_mk_node pe) sigma_lambda in if !print_full_prop then make_dangling_boxes pe nodes sigma_lambda; let links = dotty_mk_set_links nodes sigma_lambda p f cycle in @@ -930,7 +937,7 @@ let pp_proplist_parsed2dotty_file filename plist = F.fprintf f "\n\n\ndigraph main { \nnode [shape=box];\n"; F.fprintf f "\n compound = true; \n"; F.fprintf f "\n /* size=\"12,7\"; ratio=fill;*/ \n"; - ignore (IList.map (pp_dotty f Generic_proposition) plist); + ignore (List.map ~f:(pp_dotty f Generic_proposition) plist); F.fprintf f "\n}" in let outc = open_out filename in let fmt = F.formatter_of_out_channel outc in @@ -963,7 +970,7 @@ let pp_cfgnodelabel pdesc fmt (n : Procdesc.Node.t) = pname_string pp_etlist (Procdesc.get_formals pdesc) pp_local_list (Procdesc.get_locals pdesc); - if IList.length (Procdesc.get_captured pdesc) <> 0 then + if List.length (Procdesc.get_captured pdesc) <> 0 then Format.fprintf fmt "\\nCaptured: %a" pp_local_list (Procdesc.get_captured pdesc); let attributes = Procdesc.get_attributes pdesc in @@ -1176,7 +1183,7 @@ let rec select_node_at_address nodes e = (* look-up the ids in the list of nodes corresponding to expression e*) (* let look_up_nodes_ids nodes e = - IList.map get_node_id (select_nodes_exp nodes e) *) + List.map ~f:get_node_id (select_nodes_exp nodes e) *) (* create a list of dangling nodes *) let make_set_dangling_nodes allocated_nodes (sigma: Sil.hpred list) = @@ -1209,11 +1216,11 @@ let make_set_dangling_nodes allocated_nodes (sigma: Sil.hpred list) = | e:: l' -> if (List.exists ~f:(Exp.equal e) seen_exp) then filter_duplicate l' seen_exp else e:: filter_duplicate l' (e:: seen_exp) in - let rhs_exp_list = List.concat (IList.map get_rhs_predicate sigma) in + let rhs_exp_list = List.concat_map ~f:get_rhs_predicate sigma in let candidate_dangling_exps = filter_duplicate rhs_exp_list [] in (* get rid of allocated ones*) let dangling_exps = List.filter ~f:is_not_allocated candidate_dangling_exps in - IList.map make_new_dangling dangling_exps + List.map ~f:make_new_dangling dangling_exps (* return a list of pairs (n,field_lab) where n is a target node*) (* corresponding to se and is going to be used a target for and edge*) @@ -1262,7 +1269,7 @@ let rec make_visual_heap_edges nodes sigma prop = | None -> assert false | Some n -> let target_nodes = compute_target_nodes_from_sexp nodes se prop "" in - let ll = IList.map (combine_source_target_label n) target_nodes in + let ll = List.map ~f:(combine_source_target_label n) target_nodes in ll @ make_visual_heap_edges nodes sigma' prop ) | Sil.Hlseg (_, _, e1, e2, _):: sigma' -> @@ -1271,7 +1278,7 @@ let rec make_visual_heap_edges nodes sigma prop = | None -> assert false | Some n -> let target_nodes = compute_target_nodes_from_sexp nodes (Sil.Eexp (e2, Sil.inst_none)) prop "" in - let ll = IList.map (combine_source_target_label n) target_nodes in + let ll = List.map ~f:(combine_source_target_label n) target_nodes in ll @ make_visual_heap_edges nodes sigma' prop ) @@ -1282,8 +1289,8 @@ let rec make_visual_heap_edges nodes sigma prop = | Some n -> let target_nodesF = compute_target_nodes_from_sexp nodes (Sil.Eexp (e3, Sil.inst_none)) prop "" in let target_nodesB = compute_target_nodes_from_sexp nodes (Sil.Eexp (e2, Sil.inst_none)) prop "" in - let llF = IList.map (combine_source_target_label n) target_nodesF in - let llB = IList.map (combine_source_target_label n) target_nodesB in + let llF = List.map ~f:(combine_source_target_label n) target_nodesF in + let llB = List.map ~f:(combine_source_target_label n) target_nodesB in llF @ llB @ make_visual_heap_edges nodes sigma' prop ) @@ -1309,10 +1316,10 @@ let rec pointsto_contents_to_xml (co: Sil.strexp) : Io_infer.Xml.node = Io_infer.Xml.create_tree "cell" [("content-value", exp_to_xml_string e)] [] | Sil.Estruct (fel, _) -> let f (fld, exp) = Io_infer.Xml.create_tree "struct-field" [("id", Ident.fieldname_to_string fld)] [(pointsto_contents_to_xml exp)] in - Io_infer.Xml.create_tree "struct" [] (IList.map f fel) + Io_infer.Xml.create_tree "struct" [] (List.map ~f:f fel) | Sil.Earray (len, nel, _) -> let f (e, se) = Io_infer.Xml.create_tree "array-element" [("index", exp_to_xml_string e)] [pointsto_contents_to_xml se] in - Io_infer.Xml.create_tree "array" [("size", exp_to_xml_string len)] (IList.map f nel) + Io_infer.Xml.create_tree "array" [("size", exp_to_xml_string len)] (List.map ~f:f nel) (* Convert an atom to xml in a light version. Namely, the expressions are not fully blown-up into *) (* xml tree but visualized as strings *) @@ -1332,7 +1339,7 @@ let atom_to_xml_light (a: Sil.atom) : Io_infer.Xml.node = let xml_pure_info prop = let pure = Prop.get_pure prop in - let xml_atom_list = IList.map atom_to_xml_light pure in + let xml_atom_list = List.map ~f:atom_to_xml_light pure in Io_infer.Xml.create_tree "stack" [] xml_atom_list (** Return a string describing the kind of a pointsto address *) @@ -1374,14 +1381,14 @@ let heap_edge_to_xml edge = let visual_heap_to_xml heap = let (n, nodes, edges) = heap in - let xml_heap_nodes = IList.map heap_node_to_xml nodes in - let xml_heap_edges = IList.map heap_edge_to_xml edges in + let xml_heap_nodes = List.map ~f:heap_node_to_xml nodes in + let xml_heap_edges = List.map ~f:heap_edge_to_xml edges in Io_infer.Xml.create_tree "heap" [("id", string_of_int n)] (xml_heap_nodes @ xml_heap_edges) (** convert a proposition to xml with the given tag and id *) let prop_to_xml prop tag_name id = let visual_heaps = prop_to_set_of_visual_heaps prop in - let xml_visual_heaps = IList.map visual_heap_to_xml visual_heaps in + let xml_visual_heaps = List.map ~f:visual_heap_to_xml visual_heaps in let xml_pure_part = xml_pure_info prop in let xml_graph = Io_infer.Xml.create_tree tag_name [("id", string_of_int id)] (xml_visual_heaps @ [xml_pure_part]) in xml_graph @@ -1402,14 +1409,14 @@ let print_specs_xml signature specs loc fmt = let xml_pre = prop_to_xml pre "precondition" !jj in let xml_spec = xml_pre :: - (IList.map (fun (po, _) -> + (List.map ~f:(fun (po, _) -> jj := !jj + 1; prop_to_xml (add_stack_to_prop po) "postcondition" !jj ) posts) in Io_infer.Xml.create_tree "specification" [("id", string_of_int n)] xml_spec in let j = ref 0 in let list_of_specs_xml = - IList.map - (fun s -> + List.map + ~f:(fun s -> j:=!j + 1; do_one_spec (Specs.Jprop.to_prop s.Specs.pre) s.Specs.posts !j) specs in diff --git a/infer/src/backend/errdesc.ml b/infer/src/backend/errdesc.ml index 88d7b0822..e3e9d87b1 100644 --- a/infer/src/backend/errdesc.ml +++ b/infer/src/backend/errdesc.ml @@ -139,7 +139,7 @@ let find_normal_variable_funcall (id: Ident.t): (Exp.t * (Exp.t list) * Location.t * CallFlags.t) option = let find_declaration _ = function | Sil.Call (Some (id0, _), fun_exp, args, loc, call_flags) when Ident.equal id id0 -> - Some (fun_exp, IList.map fst args, loc, call_flags) + Some (fun_exp, List.map ~f:fst args, loc, call_flags) | _ -> None in let res = find_in_node_or_preds node find_declaration in if verbose && is_none res @@ -234,12 +234,12 @@ let rec _find_normal_variable_load tenv (seen : Exp.Set.t) node id : DExp.t opti let fun_dexp = DExp.Dconst (Const.Cfun pname) in let args_dexp = - let args_dexpo = IList.map (fun (e, _) -> _exp_rv_dexp tenv seen node e) args in + let args_dexpo = List.map ~f:(fun (e, _) -> _exp_rv_dexp tenv seen node e) args in if List.exists ~f:is_none args_dexpo then [] else let unNone = function Some x -> x | None -> assert false in - IList.map unNone args_dexpo in + List.map ~f:unNone args_dexpo in Some (DExp.Dretcall (fun_dexp, args_dexp, loc, call_flags)) | Sil.Store (Exp.Lvar pvar, _, Exp.Var id0, _) when is_infer && Ident.equal id id0 && not (Pvar.is_frontend_tmp pvar) -> @@ -299,11 +299,11 @@ and _exp_lv_dexp tenv (_seen : Exp.Set.t) node e : DExp.t option = match find_normal_variable_funcall node' id with | Some (fun_exp, eargs, loc, call_flags) -> let fun_dexpo = _exp_rv_dexp tenv seen node' fun_exp in - let blame_args = IList.map (_exp_rv_dexp tenv seen node') eargs in + let blame_args = List.map ~f:(_exp_rv_dexp tenv seen node') eargs in if List.exists ~f:is_none (fun_dexpo:: blame_args) then None else let unNone = function Some x -> x | None -> assert false in - let args = IList.map unNone blame_args in + let args = List.map ~f:unNone blame_args in Some (DExp.Dfcall (unNone fun_dexpo, args, loc, call_flags)) | None -> _exp_rv_dexp tenv seen node' (Exp.Var id) @@ -537,7 +537,7 @@ let explain_leak tenv hpred prop alloc_att_opt bucket = Pvar.d pvar; L.d_ln ()); [pvar] | _ -> [] in - let nullify_pvars = List.concat (IList.map get_nullify node_instrs) in + let nullify_pvars = List.concat_map ~f:get_nullify node_instrs in let nullify_pvars_notmp = List.filter ~f:(fun pvar -> not (Pvar.is_frontend_tmp pvar)) nullify_pvars in value_str_from_pvars_vpath nullify_pvars_notmp vpath @@ -964,7 +964,7 @@ let explain_nth_function_parameter tenv use_buckets deref_str prop n pvar_off = match State.get_instr () with | Some Sil.Call (_, _, args, _, _) -> (try - let arg = fst (IList.nth args (n - 1)) in + let arg = fst (List.nth_exn args (n - 1)) in let dexp_opt = exp_rv_dexp tenv node arg in let dexp_opt' = match dexp_opt with | Some de -> diff --git a/infer/src/backend/infer.ml b/infer/src/backend/infer.ml index 93c956389..7869f5219 100644 --- a/infer/src/backend/infer.ml +++ b/infer/src/backend/infer.ml @@ -222,7 +222,7 @@ let capture = function List.rev_append Config.anon_args ( ["--analyzer"; IList.assoc Config.equal_analyzer Config.analyzer - (IList.map (fun (n,a) -> (a,n)) Config.string_to_analyzer)] @ + (List.map ~f:(fun (n,a) -> (a,n)) Config.string_to_analyzer)] @ (match Config.blacklist with | Some s when in_buck_mode -> ["--blacklist-regex"; s] | _ -> []) @ @@ -234,7 +234,7 @@ let capture = function ["--java-jar-compiler"; p]) @ (match IList.rev Config.buck_build_args with | args when in_buck_mode -> - IList.map (fun arg -> ["--Xbuck"; "'" ^ arg ^ "'"]) args |> List.concat + List.map ~f:(fun arg -> ["--Xbuck"; "'" ^ arg ^ "'"]) args |> List.concat | _ -> []) @ (if not Config.debug_mode then [] else ["--debug"]) @ diff --git a/infer/src/backend/inferconfig.ml b/infer/src/backend/inferconfig.ml index 70bb293f5..51fb01e03 100644 --- a/infer/src/backend/inferconfig.ml +++ b/infer/src/backend/inferconfig.ml @@ -322,9 +322,9 @@ let filters_from_inferconfig inferconfig : filters = let path_filter = let whitelist_filter : path_filter = if List.is_empty inferconfig.whitelist then default_path_filter - else is_matching (IList.map Str.regexp inferconfig.whitelist) in + else is_matching (List.map ~f:Str.regexp inferconfig.whitelist) in let blacklist_filter : path_filter = - is_matching (IList.map Str.regexp inferconfig.blacklist) in + is_matching (List.map ~f:Str.regexp inferconfig.blacklist) in let blacklist_files_containing_filter : path_filter = FileContainsStringMatcher.create_matcher inferconfig.blacklist_files_containing in function source_file -> @@ -365,8 +365,8 @@ let is_checker_enabled checker_name = (* be reported on path/to/file.java both for infer and for eradicate *) let test () = let filters = - IList.map - (fun (name, analyzer) -> (name, analyzer, create_filters analyzer)) + List.map + ~f:(fun (name, analyzer) -> (name, analyzer, create_filters analyzer)) Config.string_to_analyzer in let matching_analyzers path = List.fold @@ -379,7 +379,7 @@ let test () = let source_file = SourceFile.from_abs_path path in let matching = matching_analyzers source_file in if matching <> [] then - let matching_s = String.concat ~sep:", " (IList.map fst matching) in + let matching_s = String.concat ~sep:", " (List.map ~f:fst matching) in L.stderr "%s -> {%s}@." (SourceFile.to_rel_path source_file) matching_s) diff --git a/infer/src/backend/interproc.ml b/infer/src/backend/interproc.ml index 9ae2b9949..183fb513f 100644 --- a/infer/src/backend/interproc.ml +++ b/infer/src/backend/interproc.ml @@ -215,8 +215,8 @@ let collect_preconditions tenv proc_name : Prop.normal Specs.Jprop.t list = else Abs.abstract_no_symop tenv prop in let pres = - IList.map - (fun spec -> Specs.Jprop.to_prop spec.Specs.pre) + List.map + ~f:(fun spec -> Specs.Jprop.to_prop spec.Specs.pre) (Specs.get_specs proc_name) in let pset = Propset.from_proplist tenv pres in let pset' = @@ -237,14 +237,15 @@ let collect_preconditions tenv proc_name : Prop.normal Specs.Jprop.t list = L.d_decrease_indent 2; L.d_ln (); L.d_strln ("#### Footprint of " ^ Procname.to_string proc_name ^ " after Join ####"); L.d_increase_indent 1; Specs.Jprop.d_list false jplist; L.d_decrease_indent 1; L.d_ln (); - let jplist' = IList.map (Specs.Jprop.map (Prop.prop_rename_primed_footprint_vars tenv)) jplist in + let jplist' = + List.map ~f:(Specs.Jprop.map (Prop.prop_rename_primed_footprint_vars tenv)) jplist in L.d_strln ("#### Renamed footprint of " ^ Procname.to_string proc_name ^ ": ####"); L.d_increase_indent 1; Specs.Jprop.d_list false jplist'; L.d_decrease_indent 1; L.d_ln (); let jplist'' = let f p = Prop.prop_primed_vars_to_normal_vars tenv (collect_do_abstract_one proc_name tenv p) in - IList.map (Specs.Jprop.map f) jplist' in + List.map ~f:(Specs.Jprop.map f) jplist' in L.d_strln ("#### Abstracted footprint of " ^ Procname.to_string proc_name ^ ": ####"); L.d_increase_indent 1; Specs.Jprop.d_list false jplist''; L.d_decrease_indent 1; L.d_ln(); jplist'' @@ -406,9 +407,9 @@ let check_assignement_guard pdesc node = L.d_strln ("Found " ^ (Exp.to_string e') ^ " as prune var"); [e'] | _ -> [] in - let prune_vars = List.concat(IList.map (fun n -> prune_var n) succs) in + let prune_vars = List.concat_map ~f:(fun n -> prune_var n) succs in List.for_all ~f:(fun e' -> Exp.equal e' e) prune_vars in - let succs_loc = IList.map (fun n -> Procdesc.Node.get_loc n) succs in + let succs_loc = List.map ~f:(fun n -> Procdesc.Node.get_loc n) succs in let succs_are_all_prune_nodes () = List.for_all ~f:(fun n -> match Procdesc.Node.get_kind n with | Procdesc.Node.Prune_node(_) -> true @@ -494,7 +495,7 @@ let add_taint_attrs tenv proc_name proc_desc prop = | tainted_param_nums -> let formal_params = Procdesc.get_formals proc_desc in let formal_params' = - IList.map (fun (p, _) -> Pvar.mk p proc_name) formal_params in + List.map ~f:(fun (p, _) -> Pvar.mk p proc_name) formal_params in Taint.get_params_to_taint tainted_param_nums formal_params' |> List.fold ~f:(fun prop_acc (param, taint_kind) -> @@ -728,8 +729,8 @@ let compute_visited vset = let res = ref Specs.Visitedset.empty in let node_get_all_lines n = let node_loc = Procdesc.Node.get_loc n in - let instrs_loc = IList.map Sil.instr_get_loc (Procdesc.Node.get_instrs n) in - let lines = IList.map (fun loc -> loc.Location.line) (node_loc :: instrs_loc) in + let instrs_loc = List.map ~f:Sil.instr_get_loc (Procdesc.Node.get_instrs n) in + let lines = List.map ~f:(fun loc -> loc.Location.line) (node_loc :: instrs_loc) in IList.remove_duplicates Int.compare (IList.sort Int.compare lines) in let do_node n = res := @@ -746,8 +747,8 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list = (fun prop _ -> Prop.prop_fav_add fav prop) pathset; let sub_list = - IList.map - (fun id -> (id, Exp.Var (Ident.create_fresh (Ident.knormal)))) + List.map + ~f:(fun id -> (id, Exp.Var (Ident.create_fresh (Ident.knormal)))) (Sil.fav_to_list fav) in Sil.sub_of_list sub_list in let pre_post_visited_list = @@ -768,7 +769,7 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list = vset_ref_add_path vset_ref path; compute_visited !vset_ref in (pre', post', visited) in - IList.map f pplist in + List.map ~f:f pplist in let pre_post_map = let add map (pre, post, visited) = let current_posts, current_visited = @@ -784,8 +785,8 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list = let specs = ref [] in let add_spec pre ((posts : Paths.PathSet.t), visited) = let posts' = - IList.map - (fun (p, path) -> (PropUtil.remove_seed_vars tenv p, path)) + List.map + ~f:(fun (p, path) -> (PropUtil.remove_seed_vars tenv p, path)) (Paths.PathSet.elements (do_join_post pname tenv posts)) in let spec = { Specs.pre = Specs.Jprop.Prop (1, pre); @@ -854,7 +855,7 @@ let prop_init_formals_seed tenv new_formals (prop : 'a Prop.t) : Prop.exposed Pr | Config.Clang -> Exp.Sizeof (typ, None, Subtype.exact) | Config.Java -> Exp.Sizeof (typ, None, Subtype.subtypes) in Prop.mk_ptsto_lvar tenv Prop.Fld_init Sil.inst_formal (pv, texp, None) in - IList.map do_formal new_formals in + List.map ~f:do_formal new_formals in let sigma_seed = create_seed_vars (* formals already there plus new ones *) @@ -875,7 +876,7 @@ let initial_prop (Pvar.mk x (Procdesc.get_proc_name curr_f), typ) in let new_formals = if add_formals - then IList.map construct_decl (Procdesc.get_formals curr_f) + then List.map ~f:construct_decl (Procdesc.get_formals curr_f) else [] (* no new formals added *) in let prop1 = Prop.prop_reset_inst @@ -894,8 +895,8 @@ let initial_prop_from_pre tenv curr_f pre = if !Config.footprint then let vars = Sil.fav_to_list (Prop.prop_fav pre) in let sub_list = - IList.map - (fun id -> (id, Exp.Var (Ident.create_fresh (Ident.kfootprint)))) + List.map + ~f:(fun id -> (id, Exp.Var (Ident.create_fresh (Ident.kfootprint)))) vars in let sub = Sil.sub_of_list sub_list in let pre2 = Prop.prop_sub sub pre in @@ -935,8 +936,8 @@ let execute_filter_prop wl tenv pdesc init_node (precondition : Prop.normal Spec let posts, visited = let pset, visited = collect_postconditions wl tenv pdesc in let plist = - IList.map - (fun (p, path) -> (PropUtil.remove_seed_vars tenv p, path)) + List.map + ~f:(fun (p, path) -> (PropUtil.remove_seed_vars tenv p, path)) (Paths.PathSet.elements pset) in plist, visited in let pre = @@ -962,9 +963,9 @@ let execute_filter_prop wl tenv pdesc init_node (precondition : Prop.normal Spec (** get all the nodes in the current call graph with their defined children *) let get_procs_and_defined_children call_graph = - IList.map - (fun (n, ns) -> - (n, Procname.Set.elements ns)) + List.map + ~f:(fun (n, ns) -> + (n, Procname.Set.elements ns)) (Cg.get_nodes_and_defined_children call_graph) let pp_intra_stats wl proc_desc fmt _ = @@ -977,7 +978,7 @@ let pp_intra_stats wl proc_desc fmt _ = Paths.PathSet.size (htable_retrieve wl.Worklist.path_set_visited (Procdesc.Node.get_id node))) nodes; - F.fprintf fmt "(%d nodes containing %d states)" (IList.length nodes) !nstates + F.fprintf fmt "(%d nodes containing %d states)" (List.length nodes) !nstates type exe_phase = (unit -> unit) * (unit -> Prop.normal Specs.spec list * Specs.phase) @@ -1008,7 +1009,7 @@ let perform_analysis_phase tenv (pname : Procname.t) (pdesc : Procdesc.t) source (* rename spec vars to footrpint vars, and copy current to footprint *) let mk_init precondition = initial_prop_from_pre tenv pdesc (Specs.Jprop.to_prop precondition) in - IList.map (fun spec -> mk_init spec.Specs.pre) specs in + List.map ~f:(fun spec -> mk_init spec.Specs.pre) specs in let init_props = Propset.from_proplist tenv (init_prop :: init_props_from_pres) in let init_edgeset = let add pset prop = @@ -1050,8 +1051,8 @@ let perform_analysis_phase tenv (pname : Procname.t) (pdesc : Procdesc.t) source let re_execution () : exe_phase = let candidate_preconditions = - IList.map - (fun spec -> spec.Specs.pre) + List.map + ~f:(fun spec -> spec.Specs.pre) (Specs.get_specs pname) in let valid_specs = ref [] in let go () = @@ -1074,13 +1075,13 @@ let perform_analysis_phase tenv (pname : Procname.t) (pdesc : Procdesc.t) source if Config.undo_join then ignore (Specs.Jprop.filter filter candidate_preconditions) else - ignore (IList.map filter candidate_preconditions) in + ignore (List.map ~f:filter candidate_preconditions) in let get_results () = let specs = !valid_specs in L.out "#### [FUNCTION %a] ... OK #####@\n" Procname.pp pname; L.out "#### Finished: Re-Execution for %a ####@." Procname.pp pname; let valid_preconditions = - IList.map (fun spec -> spec.Specs.pre) specs in + List.map ~f:(fun spec -> spec.Specs.pre) specs in let filename = DB.Results_dir.path_to_filename (DB.Results_dir.Abs_source_dir source) @@ -1284,7 +1285,7 @@ let update_specs tenv proc_name phase (new_specs : Specs.NormSpec.t list) (** update a summary after analysing a procedure *) let update_summary tenv prev_summary specs phase proc_name elapsed res = - let normal_specs = IList.map (Specs.spec_normalize tenv) specs in + let normal_specs = List.map ~f:(Specs.spec_normalize tenv) specs in let new_specs, changed = update_specs tenv proc_name phase normal_specs in let timestamp = max 1 (prev_summary.Specs.timestamp + if changed then 1 else 0) in let stats_time = prev_summary.Specs.stats.Specs.stats_time +. elapsed in @@ -1300,8 +1301,10 @@ let update_summary tenv prev_summary specs phase proc_name elapsed res = } in let preposts = match phase with - | Specs.FOOTPRINT -> Some new_specs - | Specs.RE_EXECUTION -> Some (IList.map (Specs.NormSpec.erase_join_info_pre tenv) new_specs) in + | Specs.FOOTPRINT -> + Some new_specs + | Specs.RE_EXECUTION -> + Some (List.map ~f:(Specs.NormSpec.erase_join_info_pre tenv) new_specs) in let payload = { prev_summary.Specs.payload with Specs.preposts; } in { prev_summary with Specs.phase; @@ -1341,12 +1344,12 @@ let transition_footprint_re_exe tenv proc_name joined_pres = } else let specs = - IList.map - (fun jp -> - Specs.spec_normalize tenv - { Specs.pre = jp; - posts = []; - visited = Specs.Visitedset.empty }) + List.map + ~f:(fun jp -> + Specs.spec_normalize tenv + { Specs.pre = jp; + posts = []; + visited = Specs.Visitedset.empty }) joined_pres in let payload = { summary.Specs.payload with @@ -1431,7 +1434,7 @@ let do_analysis exe_env = pdesc | None -> assert false in - let nodes = IList.map (fun n -> Procdesc.Node.get_id n) (Procdesc.get_nodes pdesc) in + let nodes = List.map ~f:(fun n -> Procdesc.Node.get_id n) (Procdesc.get_nodes pdesc) in let proc_flags = Procdesc.get_flags pdesc in let static_err_log = Procdesc.get_err_log pdesc in (* err log from translation *) let calls = get_calls pdesc in @@ -1543,7 +1546,7 @@ let print_stats_cfg proc_shadowed source cfg = let err_log = summary.Specs.attributes.ProcAttributes.err_log in incr num_proc; let specs = Specs.get_specs_from_payload summary in - tot_specs := (IList.length specs) + !tot_specs; + tot_specs := (List.length specs) + !tot_specs; let () = match specs, Errlog.size @@ -1567,8 +1570,8 @@ let print_stats_cfg proc_shadowed source cfg = F.fprintf fmt "@\n++++++++++++++++++++++++++++++++++++++++++++++++++@\n"; F.fprintf fmt "+ FILE: %a VISITED: %d/%d SYMOPS: %d@\n" SourceFile.pp source - (IList.length nodes_visited) - (IList.length nodes_total) + (List.length nodes_visited) + (List.length nodes_total) !tot_symops; F.fprintf fmt "+ num_procs: %d (%d ok, %d timeouts, %d errors, %d warnings, %d infos)@\n" !num_proc num_ok_proc !num_timeout num_errors num_warnings num_infos; diff --git a/infer/src/backend/match.ml b/infer/src/backend/match.ml index 1a9a38122..d6cd2660e 100644 --- a/infer/src/backend/match.ml +++ b/infer/src/backend/match.ml @@ -159,7 +159,7 @@ and isel_match isel1 sub vars isel2 = (* extends substitution sub by creating a new substitution for vars *) let sub_extend_with_ren (sub: Sil.subst) vars = let f id = (id, Exp.Var (Ident.create_fresh Ident.kprimed)) in - let renaming_for_vars = Sil.sub_of_list (IList.map f vars) in + let renaming_for_vars = Sil.sub_of_list (List.map ~f:f vars) in Sil.sub_join sub renaming_for_vars type sidecondition = Prop.normal Prop.t -> Sil.subst -> bool @@ -312,7 +312,7 @@ let rec iter_match_with_impl tenv iter condition sub vars hpat hpats = let (para2_exist_vars, para2_inst) = Sil.hpara_instantiate para2 e_start2 e_end2 es_shared2 in (* let allow_impl hpred = {hpred=hpred; flag=hpat.flag} in *) let allow_impl hpred = { hpred = hpred; flag = true } in - let (para2_hpat, para2_hpats) = match IList.map allow_impl para2_inst with + let (para2_hpat, para2_hpats) = match List.map ~f:allow_impl para2_inst with | [] -> assert false (* the body of a parameter should contain at least one * conjunct *) | para2_pat :: para2_pats -> (para2_pat, para2_pats) in let new_vars = para2_exist_vars @ vars in @@ -369,7 +369,7 @@ let rec iter_match_with_impl tenv iter condition sub vars hpat hpats = let (para2_exist_vars, para2_inst) = Sil.hpara_dll_instantiate para2 iF2 oB2 oF2 es_shared2 in (* let allow_impl hpred = {hpred=hpred; flag=hpat.flag} in *) let allow_impl hpred = { hpred = hpred; flag = true } in - let (para2_hpat, para2_hpats) = match IList.map allow_impl para2_inst with + let (para2_hpat, para2_hpats) = match List.map ~f:allow_impl para2_inst with | [] -> assert false (* the body of a parameter should contain at least one * conjunct *) | para2_pat :: para2_pats -> (para2_pat, para2_pats) in let new_vars = para2_exist_vars @ vars_leftover in @@ -409,12 +409,12 @@ and hpara_common_match_with_impl tenv impl_ok ids1 sigma1 eids2 ids2 sigma2 = let sub_ids = let ren_ids = List.zip_exn ids2 ids1 in let f (id2, id1) = (id2, Exp.Var id1) in - IList.map f ren_ids in + List.map ~f:f ren_ids in let (sub_eids, eids_fresh) = let f id = (id, Ident.create_fresh Ident.kprimed) in - let ren_eids = IList.map f eids2 in - let eids_fresh = IList.map snd ren_eids in - let sub_eids = IList.map (fun (id2, id1) -> (id2, Exp.Var id1)) ren_eids in + let ren_eids = List.map ~f:f eids2 in + let eids_fresh = List.map ~f:snd ren_eids in + let sub_eids = List.map ~f:(fun (id2, id1) -> (id2, Exp.Var id1)) ren_eids in (sub_eids, eids_fresh) in let sub = Sil.sub_of_list (sub_ids @ sub_eids) in match sigma2 with @@ -423,7 +423,7 @@ and hpara_common_match_with_impl tenv impl_ok ids1 sigma1 eids2 ids2 sigma2 = let (hpat2, hpats2) = let (hpred2_ren, sigma2_ren) = (Sil.hpred_sub sub hpred2, Prop.sigma_sub sub sigma2) in let allow_impl hpred = { hpred = hpred; flag = impl_ok } in - (allow_impl hpred2_ren, IList.map allow_impl sigma2_ren) in + (allow_impl hpred2_ren, List.map ~f:allow_impl sigma2_ren) in let condition _ _ = true in let p1 = Prop.normalize tenv (Prop.from_sigma sigma1) in begin @@ -491,13 +491,13 @@ let rec generate_todos_from_strexp mode todos sexp1 sexp2 = | Sil.Eexp _, _ -> None | Sil.Estruct (fel1, _), Sil.Estruct (fel2, _) -> (* assume sorted w.r.t. fields *) - if (IList.length fel1 <> IList.length fel2) && equal_iso_mode mode Exact + if (List.length fel1 <> List.length fel2) && equal_iso_mode mode Exact then None else generate_todos_from_fel mode todos fel1 fel2 | Sil.Estruct _, _ -> None | Sil.Earray (len1, iel1, _), Sil.Earray (len2, iel2, _) -> - if (not (Exp.equal len1 len2) || IList.length iel1 <> IList.length iel2) + if (not (Exp.equal len1 len2) || List.length iel1 <> List.length iel2) then None else generate_todos_from_iel mode todos iel1 iel2 | Sil.Earray _, _ -> @@ -700,7 +700,7 @@ let hpred_lift_to_pe hpred = (** Lift the kind of list segment predicates to PE in a given sigma *) let sigma_lift_to_pe sigma = - IList.map hpred_lift_to_pe sigma + List.map ~f:hpred_lift_to_pe sigma (** [generic_para_create] takes a correspondence, and a sigma and a list of expressions for the first part of this @@ -716,18 +716,18 @@ let generic_para_create tenv corres sigma1 elist1 = | _ -> true in let new_corres' = List.filter ~f:not_same_consts corres in let add_fresh_id pair = (pair, Ident.create_fresh Ident.kprimed) in - IList.map add_fresh_id new_corres' in + List.map ~f:add_fresh_id new_corres' in let (es_shared, ids_shared, ids_exists) = let not_in_elist1 ((e1, _), _) = not (List.exists ~f:(Exp.equal e1) elist1) in let corres_ids_no_elist1 = List.filter ~f:not_in_elist1 corres_ids in let should_be_shared ((e1, e2), _) = Exp.equal e1 e2 in let shared, exists = IList.partition should_be_shared corres_ids_no_elist1 in - let es_shared = IList.map (fun ((e1, _), _) -> e1) shared in - (es_shared, IList.map snd shared, IList.map snd exists) in - let renaming = IList.map (fun ((e1, _), id) -> (e1, id)) corres_ids in + let es_shared = List.map ~f:(fun ((e1, _), _) -> e1) shared in + (es_shared, List.map ~f:snd shared, List.map ~f:snd exists) in + let renaming = List.map ~f:(fun ((e1, _), id) -> (e1, id)) corres_ids in let body = let sigma1' = sigma_lift_to_pe sigma1 in - let renaming_exp = IList.map (fun (e1, id) -> (e1, Exp.Var id)) renaming in + let renaming_exp = List.map ~f:(fun (e1, id) -> (e1, Exp.Var id)) renaming in Prop.sigma_replace_exp tenv renaming_exp sigma1' in (renaming, body, ids_exists, ids_shared, es_shared) diff --git a/infer/src/backend/mergeCapture.ml b/infer/src/backend/mergeCapture.ml index a2b22dfa1..7bff1fe7a 100644 --- a/infer/src/backend/mergeCapture.ml +++ b/infer/src/backend/mergeCapture.ml @@ -160,7 +160,7 @@ let should_link ~target ~target_results_dir ~stats infer_out_src infer_out_dst = then begin let captured_files = Array.to_list (Sys.readdir captured_src) in - num_captured_files := IList.length captured_files; + num_captured_files := List.length captured_files; List.for_all ~f:(fun file -> check_file (Filename.concat captured_dst file)) diff --git a/infer/src/backend/paths.ml b/infer/src/backend/paths.ml index 55ad32b16..176fac925 100644 --- a/infer/src/backend/paths.ml +++ b/infer/src/backend/paths.ml @@ -585,7 +585,7 @@ end = struct !plist let to_proplist ps = - IList.map fst (elements ps) + List.map ~f:fst (elements ps) let to_propset tenv ps = Propset.from_proplist tenv (to_proplist ps) diff --git a/infer/src/backend/preanal.ml b/infer/src/backend/preanal.ml index f530d0015..b7e5458a4 100644 --- a/infer/src/backend/preanal.ml +++ b/infer/src/backend/preanal.ml @@ -42,7 +42,7 @@ let add_dispatch_calls pdesc cg tenv = | ((_, target_pname) :: _) as all_targets -> let targets_to_add = if sound_dynamic_dispatch then - IList.map snd all_targets + List.map ~f:snd all_targets else (* if sound dispatch is turned off, consider only the first target. we do this because choosing all targets is too expensive for everyday use *) @@ -57,7 +57,7 @@ let add_dispatch_calls pdesc cg tenv = | instr -> instr in let instrs = Procdesc.Node.get_instrs node in if has_dispatch_call instrs then - IList.map replace_dispatch_calls instrs + List.map ~f:replace_dispatch_calls instrs |> Procdesc.Node.replace_instrs node in let pname = Procdesc.get_proc_name pdesc in Procdesc.iter_nodes (node_add_dispatch_calls pname) pdesc @@ -74,7 +74,7 @@ let add_abstraction_instructions pdesc = if List.exists ~f:is_exit succ_nodes then true else match succ_nodes with | [] -> false - | [h] -> IList.length (Node.get_preds h) > 1 + | [h] -> List.length (Node.get_preds h) > 1 | _ -> false in let node_requires_abstraction node = match Node.get_kind node with @@ -187,7 +187,7 @@ let remove_dead_frontend_stores pdesc liveness_inv_map = let instr_nodes' = IList.filter_changed is_used_store instr_nodes in if not (phys_equal instr_nodes' instr_nodes) then - Procdesc.Node.replace_instrs node (IList.rev_map fst instr_nodes') in + Procdesc.Node.replace_instrs node (List.rev_map ~f:fst instr_nodes') in Procdesc.iter_nodes node_remove_dead_stores pdesc let add_nullify_instrs pdesc tenv liveness_inv_map = @@ -213,7 +213,7 @@ let add_nullify_instrs pdesc tenv liveness_inv_map = let loc = Procdesc.Node.get_last_loc node in let nullify_instrs = List.filter ~f:is_local pvars - |> IList.map (fun pvar -> Sil.Nullify (pvar, loc)) in + |> List.map ~f:(fun pvar -> Sil.Nullify (pvar, loc)) in if nullify_instrs <> [] then Procdesc.Node.append_instrs node (IList.rev nullify_instrs) in diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index bf2437e6a..31fa3bbb4 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -131,9 +131,9 @@ end = struct [".."] (Procdesc.Node.get_proc_name node) ~description:"" - ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list) - ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list) - ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list) + ~preds:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list) + ~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list) + ~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list) ~isvisited:(is_visited node) ~isproof:false fmt (Procdesc.Node.get_id node :> int)) preds; @@ -143,9 +143,9 @@ end = struct [".."] (Procdesc.Node.get_proc_name node) ~description:"" - ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list) - ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list) - ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list) + ~preds:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list) + ~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list) + ~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list) ~isvisited:(is_visited node) ~isproof:false fmt (Procdesc.Node.get_id node :> int)) succs; @@ -155,9 +155,9 @@ end = struct [".."] (Procdesc.Node.get_proc_name node) ~description:"" - ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list) - ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list) - ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list) + ~preds:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list) + ~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list) + ~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list) ~isvisited:(is_visited node) ~isproof:false fmt (Procdesc.Node.get_id node :> int)) exns; @@ -435,9 +435,9 @@ let write_proc_html source whole_seconds pdesc = [] (Procdesc.Node.get_proc_name n) ~description:(Procdesc.Node.get_description (Pp.html Black) n) - ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list) - ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list) - ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list) + ~preds:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list) + ~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list) + ~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list) ~isvisited:(is_visited n) ~isproof:false fmt (Procdesc.Node.get_id n :> int)) @@ -543,9 +543,9 @@ let write_html_file linereader filename procs = [fname_encoding] (Procdesc.Node.get_proc_name n) ~description:(Procdesc.Node.get_description (Pp.html Black) n) - ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list) - ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list) - ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list) + ~preds:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list) + ~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list) + ~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list) ~isvisited:(is_visited n) ~isproof fmt (Procdesc.Node.get_id n :> int)) @@ -554,7 +554,7 @@ let write_html_file linereader filename procs = ~f:(fun n -> match Procdesc.Node.get_kind n with | Procdesc.Node.Start_node proc_name -> - let num_specs = IList.length (Specs.get_specs proc_name) in + let num_specs = List.length (Specs.get_specs proc_name) in let label = (Escape.escape_xml (Procname.to_string proc_name)) ^ ": " ^ diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index 58a45b7c0..0cb7a399d 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -153,7 +153,7 @@ let pp_hpred_stackvar pe0 f (hpred : Sil.hpred) = (** Pretty print a substitution. *) let pp_sub pe f sub = - let pi_sub = IList.map (fun (id, e) -> Sil.Aeq (Var id, e)) (Sil.sub_to_list sub) in + let pi_sub = List.map ~f:(fun (id, e) -> Sil.Aeq (Var id, e)) (Sil.sub_to_list sub) in (Pp.semicolon_seq_oneline pe (Sil.pp_atom pe)) f pi_sub (** Dump a substitution. *) @@ -221,7 +221,7 @@ let d_pi_sigma pi sigma = d_pi pi; d_separator (); d_sigma sigma let pi_of_subst sub = - IList.map (fun (id1, e2) -> Sil.Aeq (Var id1, e2)) (Sil.sub_to_list sub) + List.map ~f:(fun (id1, e2) -> Sil.Aeq (Var id1, e2)) (Sil.sub_to_list sub) (** Return the pure part of [prop]. *) let get_pure (p: 'a t) : pi = @@ -412,10 +412,10 @@ let sigma_fav_in_pvars_add fav sigma = List.iter ~f:(hpred_fav_in_pvars_add fav) sigma let sigma_fpv sigma = - List.concat (IList.map Sil.hpred_fpv sigma) + List.concat_map ~f:Sil.hpred_fpv sigma let pi_fpv pi = - List.concat (IList.map Sil.atom_fpv pi) + List.concat_map ~f:Sil.atom_fpv pi let prop_fpv prop = (Sil.sub_fpv prop.sub) @ @@ -428,11 +428,11 @@ let prop_fpv prop = let pi_sub (subst: Sil.subst) pi = let f = Sil.atom_sub subst in - IList.map f pi + List.map ~f:f pi let sigma_sub subst sigma = let f = Sil.hpred_sub subst in - IList.map f sigma + List.map ~f:f sigma (** Return [true] if the atom is an inequality *) let atom_is_inequality (atom : Sil.atom) = match atom with @@ -566,7 +566,7 @@ let exp_collapse_consecutive_indices_prop (typ : Typ.t) exp = (** Return a compact representation of the prop *) let prop_compact sh (prop : normal t) : normal t = - let sigma' = IList.map (Sil.hpred_compact sh) prop.sigma in + let sigma' = List.map ~f:(Sil.hpred_compact sh) prop.sigma in unsafe_cast_to_normal (set prop ~sigma:sigma') (** {2 Query about Proposition} *) @@ -708,7 +708,7 @@ module Normalize = struct e | Closure c -> let captured_vars = - IList.map (fun (exp, pvar, typ) -> (eval exp, pvar, typ)) c.captured_vars in + List.map ~f:(fun (exp, pvar, typ) -> (eval exp, pvar, typ)) c.captured_vars in Closure { c with captured_vars; } | Const _ -> e @@ -1282,9 +1282,9 @@ module Normalize = struct | Aneq (e1, e2) -> handle_boolean_operation false e1 e2 | Apred (a, es) -> - Apred (a, IList.map (fun e -> exp_normalize tenv sub e) es) + Apred (a, List.map ~f:(fun e -> exp_normalize tenv sub e) es) | Anpred (a, es) -> - Anpred (a, IList.map (fun e -> exp_normalize tenv sub e) es) in + Anpred (a, List.map ~f:(fun e -> exp_normalize tenv sub e) es) in if atom_is_inequality a' then inequality_normalize tenv a' else a' let normalize_and_strengthen_atom tenv (p : normal t) (a : Sil.atom) : Sil.atom = @@ -1316,7 +1316,7 @@ module Normalize = struct | [] -> se | _ -> let fld_cnts' = - IList.map (fun (fld, cnt) -> + List.map ~f:(fun (fld, cnt) -> fld, strexp_normalize tenv sub cnt) fld_cnts in let fld_cnts'' = IList.sort [%compare: Ident.fieldname * Sil.strexp] fld_cnts' in Estruct (fld_cnts'', inst) @@ -1329,7 +1329,7 @@ module Normalize = struct if Exp.equal len len' then se else Earray (len', idx_cnts, inst) | _ -> let idx_cnts' = - IList.map (fun (idx, cnt) -> + List.map ~f:(fun (idx, cnt) -> let idx' = exp_normalize tenv sub idx in idx', strexp_normalize tenv sub cnt) idx_cnts in let idx_cnts'' = @@ -1399,7 +1399,7 @@ module Normalize = struct | Hlseg (k, para, e1, e2, elist) -> let normalized_e1 = exp_normalize tenv sub e1 in let normalized_e2 = exp_normalize tenv sub e2 in - let normalized_elist = IList.map (exp_normalize tenv sub) elist in + let normalized_elist = List.map ~f:(exp_normalize tenv sub) elist in let normalized_para = hpara_normalize tenv para in Hlseg (k, normalized_para, normalized_e1, normalized_e2, normalized_elist) | Hdllseg (k, para, e1, e2, e3, e4, elist) -> @@ -1407,24 +1407,24 @@ module Normalize = struct let norm_e2 = exp_normalize tenv sub e2 in let norm_e3 = exp_normalize tenv sub e3 in let norm_e4 = exp_normalize tenv sub e4 in - let norm_elist = IList.map (exp_normalize tenv sub) elist in + let norm_elist = List.map ~f:(exp_normalize tenv sub) elist in let norm_para = hpara_dll_normalize tenv para in Hdllseg (k, norm_para, norm_e1, norm_e2, norm_e3, norm_e4, norm_elist) and hpara_normalize tenv (para : Sil.hpara) = - let normalized_body = IList.map (hpred_normalize tenv Sil.sub_empty) (para.body) in + let normalized_body = List.map ~f:(hpred_normalize tenv Sil.sub_empty) (para.body) in let sorted_body = IList.sort Sil.compare_hpred normalized_body in { para with body = sorted_body } and hpara_dll_normalize tenv (para : Sil.hpara_dll) = - let normalized_body = IList.map (hpred_normalize tenv Sil.sub_empty) (para.body_dll) in + let normalized_body = List.map ~f:(hpred_normalize tenv Sil.sub_empty) (para.body_dll) in let sorted_body = IList.sort Sil.compare_hpred normalized_body in { para with body_dll = sorted_body } let sigma_normalize tenv sub sigma = let sigma' = - IList.stable_sort Sil.compare_hpred (IList.map (hpred_normalize tenv sub) sigma) in + IList.stable_sort Sil.compare_hpred (List.map ~f:(hpred_normalize tenv sub) sigma) in if equal_sigma sigma sigma' then sigma else sigma' let pi_tighten_ineq tenv pi = @@ -1465,12 +1465,12 @@ module Normalize = struct lt_tighten [] lt_list in let ineq_list' = let le_ineq_list = - IList.map - (fun (e, n) -> mk_inequality tenv (BinOp(Le, e, Exp.int n))) + List.map + ~f:(fun (e, n) -> mk_inequality tenv (BinOp(Le, e, Exp.int n))) le_list_tightened in let lt_ineq_list = - IList.map - (fun (n, e) -> mk_inequality tenv (BinOp(Lt, Exp.int n, e))) + List.map + ~f:(fun (n, e) -> mk_inequality tenv (BinOp(Lt, Exp.int n, e))) lt_list_tightened in le_ineq_list @ lt_ineq_list in let nonineq_list' = @@ -1491,7 +1491,7 @@ module Normalize = struct (** Normalization of pi. The normalization filters out obviously - true disequalities, such as e <> e + 1. *) let pi_normalize tenv sub sigma pi0 = - let pi = IList.map (atom_normalize tenv sub) pi0 in + let pi = List.map ~f:(atom_normalize tenv sub) pi0 in let ineq_list, nonineq_list = pi_tighten_ineq tenv pi in let syntactically_different : Exp.t * Exp.t -> bool = function | BinOp(op1, e1, Const c1), BinOp(op2, e2, Const c2) @@ -1548,9 +1548,9 @@ module Normalize = struct else (* replace primed vars by fresh footprint vars *) let ids_primed = Sil.fav_to_list fp_vars in let ids_footprint = - IList.map (fun id -> (id, Ident.create_fresh Ident.kfootprint)) ids_primed in + List.map ~f:(fun id -> (id, Ident.create_fresh Ident.kfootprint)) ids_primed in let ren_sub = - Sil.sub_of_list (IList.map (fun (id1, id2) -> (id1, Exp.Var id2)) ids_footprint) in + Sil.sub_of_list (List.map ~f:(fun (id1, id2) -> (id1, Exp.Var id2)) ids_footprint) in let nsigma' = sigma_normalize tenv Sil.sub_empty (sigma_sub ren_sub nsigma) in let npi' = pi_normalize tenv Sil.sub_empty nsigma' (pi_sub ren_sub npi) in (npi', nsigma') in @@ -1639,7 +1639,7 @@ let lexp_normalize_prop tenv p lexp = let offsets = Sil.exp_get_offsets lexp in let nroot = exp_normalize_prop tenv p root in let noffsets = - IList.map (fun (n : Sil.offset) -> match n with + List.map ~f:(fun (n : Sil.offset) -> match n with | Off_fld _ -> n | Off_index e -> @@ -1663,7 +1663,7 @@ let pi_normalize_prop tenv prop pi = Config.run_with_abs_val_equal_zero (Normalize.pi_normalize tenv prop.sub prop.sigma) pi let sigma_replace_exp tenv epairs sigma = - let sigma' = IList.map (Sil.hpred_replace_exp epairs) sigma in + let sigma' = List.map ~f:(Sil.hpred_replace_exp epairs) sigma in Normalize.sigma_normalize tenv Sil.sub_empty sigma' (** Construct an atom. *) @@ -1728,8 +1728,8 @@ let conjoin_neq tenv ?(footprint = false) exp1 exp2 prop = (** Reset every inst in the prop using the given map *) let prop_reset_inst inst_map prop = - let sigma' = IList.map (Sil.hpred_instmap inst_map) prop.sigma in - let sigma_fp' = IList.map (Sil.hpred_instmap inst_map) prop.sigma_fp in + let sigma' = List.map ~f:(Sil.hpred_instmap inst_map) prop.sigma in + let sigma_fp' = List.map ~f:(Sil.hpred_instmap inst_map) prop.sigma_fp in set prop ~sigma:sigma' ~sigma_fp:sigma_fp' @@ -1752,8 +1752,8 @@ let extract_spec (p : normal t) : normal t * normal t = (** [prop_set_fooprint p p_foot] sets proposition [p_foot] as footprint of [p]. *) let prop_set_footprint p p_foot = let pi = - (IList.map - (fun (i, e) -> Sil.Aeq(Var i, e)) + (List.map + ~f:(fun (i, e) -> Sil.Aeq(Var i, e)) (Sil.sub_to_list p_foot.sub)) @ p_foot.pi in set p ~pi_fp:pi ~sigma_fp:p_foot.sigma @@ -1849,11 +1849,11 @@ let rec strexp_get_array_indices acc (se : Sil.strexp) = match se with | Eexp _ -> acc | Estruct (fsel, _) -> - let se_list = IList.map snd fsel in + let se_list = List.map ~f:snd fsel in List.fold ~f:strexp_get_array_indices ~init:acc se_list | Earray (_, isel, _) -> let acc_new = List.fold ~f:(fun acc' (idx, _) -> idx:: acc') ~init:acc isel in - let se_list = IList.map snd isel in + let se_list = List.map ~f:snd isel in List.fold ~f:strexp_get_array_indices ~init:acc_new se_list let hpred_get_array_indices acc (hpred : Sil.hpred) = match hpred with @@ -1889,7 +1889,7 @@ let compute_reindexing fav_add get_id_offset list = let offset_new = Exp.int (IntLit.neg offset) in let exp_new : Exp.t = BinOp (PlusA, base_new, offset_new) in (id, exp_new) in - let reindexing = IList.map transform list_passed in + let reindexing = List.map ~f:transform list_passed in Sil.sub_of_list reindexing let compute_reindexing_from_indices indices = @@ -1904,15 +1904,15 @@ let apply_reindexing tenv subst prop = let nsigma = Normalize.sigma_normalize tenv subst prop.sigma in let npi = Normalize.pi_normalize tenv subst nsigma prop.pi in let nsub, atoms = - let dom_subst = IList.map fst (Sil.sub_to_list subst) in + let dom_subst = List.map ~f:fst (Sil.sub_to_list subst) in let in_dom_subst id = List.exists ~f:(Ident.equal id) dom_subst in let sub' = Sil.sub_filter (fun id -> not (in_dom_subst id)) prop.sub in let contains_substituted_id e = Sil.fav_exists (Sil.exp_fav e) in_dom_subst in let sub_eqs, sub_keep = Sil.sub_range_partition contains_substituted_id sub' in let eqs = Sil.sub_to_list sub_eqs in let atoms = - IList.map - (fun (id, e) -> Sil.Aeq (Var id, Normalize.exp_normalize tenv subst e)) + List.map + ~f:(fun (id, e) -> Sil.Aeq (Var id, Normalize.exp_normalize tenv subst e)) eqs in (sub_keep, atoms) in let p' = @@ -2007,22 +2007,22 @@ let atom_captured_ren ren (a : Sil.atom) : Sil.atom = match a with | Aneq (e1, e2) -> Aneq (exp_captured_ren ren e1, exp_captured_ren ren e2) | Apred (a, es) -> - Apred (a, IList.map (fun e -> exp_captured_ren ren e) es) + Apred (a, List.map ~f:(fun e -> exp_captured_ren ren e) es) | Anpred (a, es) -> - Anpred (a, IList.map (fun e -> exp_captured_ren ren e) es) + Anpred (a, List.map ~f:(fun e -> exp_captured_ren ren e) es) let rec strexp_captured_ren ren (se : Sil.strexp) : Sil.strexp = match se with | Eexp (e, inst) -> Eexp (exp_captured_ren ren e, inst) | Estruct (fld_se_list, inst) -> let f (fld, se) = (fld, strexp_captured_ren ren se) in - Estruct (IList.map f fld_se_list, inst) + Estruct (List.map ~f:f fld_se_list, inst) | Earray (len, idx_se_list, inst) -> let f (idx, se) = let idx' = exp_captured_ren ren idx in (idx', strexp_captured_ren ren se) in let len' = exp_captured_ren ren len in - Earray (len', IList.map f idx_se_list, inst) + Earray (len', List.map ~f:f idx_se_list, inst) and hpred_captured_ren ren (hpred : Sil.hpred) : Sil.hpred = match hpred with | Hpointsto (base, se, te) -> @@ -2034,7 +2034,7 @@ and hpred_captured_ren ren (hpred : Sil.hpred) : Sil.hpred = match hpred with let para' = hpara_ren para in let e1' = exp_captured_ren ren e1 in let e2' = exp_captured_ren ren e2 in - let elist' = IList.map (exp_captured_ren ren) elist in + let elist' = List.map ~f:(exp_captured_ren ren) elist in Hlseg (k, para', e1', e2', elist') | Hdllseg (k, para, e1, e2, e3, e4, elist) -> let para' = hpara_dll_ren para in @@ -2042,7 +2042,7 @@ and hpred_captured_ren ren (hpred : Sil.hpred) : Sil.hpred = match hpred with let e2' = exp_captured_ren ren e2 in let e3' = exp_captured_ren ren e3 in let e4' = exp_captured_ren ren e4 in - let elist' = IList.map (exp_captured_ren ren) elist in + let elist' = List.map ~f:(exp_captured_ren ren) elist in Hdllseg (k, para', e1', e2', e3', e4', elist') and hpara_ren (para : Sil.hpara) : Sil.hpara = @@ -2050,9 +2050,9 @@ and hpara_ren (para : Sil.hpara) : Sil.hpara = let ren = compute_renaming av in let root = ident_captured_ren ren para.root in let next = ident_captured_ren ren para.next in - let svars = IList.map (ident_captured_ren ren) para.svars in - let evars = IList.map (ident_captured_ren ren) para.evars in - let body = IList.map (hpred_captured_ren ren) para.body in + let svars = List.map ~f:(ident_captured_ren ren) para.svars in + let evars = List.map ~f:(ident_captured_ren ren) para.evars in + let body = List.map ~f:(hpred_captured_ren ren) para.body in { root; next; svars; evars; body} and hpara_dll_ren (para : Sil.hpara_dll) : Sil.hpara_dll = @@ -2061,9 +2061,9 @@ and hpara_dll_ren (para : Sil.hpara_dll) : Sil.hpara_dll = let iF = ident_captured_ren ren para.cell in let oF = ident_captured_ren ren para.flink in let oB = ident_captured_ren ren para.blink in - let svars' = IList.map (ident_captured_ren ren) para.svars_dll in - let evars' = IList.map (ident_captured_ren ren) para.evars_dll in - let body' = IList.map (hpred_captured_ren ren) para.body_dll in + let svars' = List.map ~f:(ident_captured_ren ren) para.svars_dll in + let evars' = List.map ~f:(ident_captured_ren ren) para.evars_dll in + let body' = List.map ~f:(hpred_captured_ren ren) para.body_dll in { cell = iF; flink = oF; blink = oB; @@ -2072,10 +2072,10 @@ and hpara_dll_ren (para : Sil.hpara_dll) : Sil.hpara_dll = body_dll = body'} let pi_captured_ren ren pi = - IList.map (atom_captured_ren ren) pi + List.map ~f:(atom_captured_ren ren) pi let sigma_captured_ren ren sigma = - IList.map (hpred_captured_ren ren) sigma + List.map ~f:(hpred_captured_ren ren) sigma let sub_captured_ren ren sub = Sil.sub_map (ident_captured_ren ren) (exp_captured_ren ren) sub @@ -2127,7 +2127,7 @@ let exist_quantify tenv fav (prop : normal t) : normal t = if List.exists ~f:Ident.is_primed ids then assert false; (* sanity check *) if List.is_empty ids then prop else let gen_fresh_id_sub id = (id, Exp.Var (Ident.create_fresh Ident.kprimed)) in - let ren_sub = Sil.sub_of_list (IList.map gen_fresh_id_sub ids) in + let ren_sub = Sil.sub_of_list (List.map ~f:gen_fresh_id_sub ids) in let prop' = (* throw away x=E if x becomes _x *) let mem_idlist i = List.exists ~f:(fun id -> Ident.equal i id) in @@ -2145,18 +2145,18 @@ let exist_quantify tenv fav (prop : normal t) : normal t = (** Apply the substitution [fe] to all the expressions in the prop. *) let prop_expmap (fe: Exp.t -> Exp.t) prop = let f (e, sil_opt) = (fe e, sil_opt) in - let pi = IList.map (Sil.atom_expmap fe) prop.pi in - let sigma = IList.map (Sil.hpred_expmap f) prop.sigma in - let pi_fp = IList.map (Sil.atom_expmap fe) prop.pi_fp in - let sigma_fp = IList.map (Sil.hpred_expmap f) prop.sigma_fp in + let pi = List.map ~f:(Sil.atom_expmap fe) prop.pi in + let sigma = List.map ~f:(Sil.hpred_expmap f) prop.sigma in + let pi_fp = List.map ~f:(Sil.atom_expmap fe) prop.pi_fp in + let sigma_fp = List.map ~f:(Sil.hpred_expmap f) prop.sigma_fp in set prop ~pi ~sigma ~pi_fp ~sigma_fp (** convert identifiers in fav to kind [k] *) let vars_make_unprimed tenv fav prop = let ids = Sil.fav_to_list fav in let ren_sub = - Sil.sub_of_list (IList.map - (fun i -> (i, Exp.Var (Ident.create_fresh Ident.knormal))) + Sil.sub_of_list (List.map + ~f:(fun i -> (i, Exp.Var (Ident.create_fresh Ident.knormal))) ids) in prop_ren_sub tenv ren_sub prop @@ -2183,8 +2183,8 @@ let prop_rename_fav_with_existentials tenv (p : normal t) : normal t = let fav = Sil.fav_new () in prop_fav_add fav p; let ids = Sil.fav_to_list fav in - let ids' = IList.map (fun i -> (i, Ident.create_fresh Ident.kprimed)) ids in - let ren_sub = Sil.sub_of_list (IList.map (fun (i, i') -> (i, Exp.Var i')) ids') in + let ids' = List.map ~f:(fun i -> (i, Ident.create_fresh Ident.kprimed)) ids in + let ren_sub = Sil.sub_of_list (List.map ~f:(fun (i, i') -> (i, Exp.Var i')) ids') in let p' = prop_sub ren_sub p in (*L.d_strln "Prop after renaming:"; d_prop p'; L.d_strln "";*) Normalize.normalize tenv p' @@ -2367,7 +2367,7 @@ let prop_iter_make_id_primed tenv id iter = get_eqs (Sil.Aeq(e1, e2):: acc) pairs in let sub_new, sub_use, eqs_add = - let eqs = IList.map normalize (Sil.sub_to_list iter.pit_sub) in + let eqs = List.map ~f:normalize (Sil.sub_to_list iter.pit_sub) in let pairs_unpid, pairs_pid = split [] [] eqs in match pairs_pid with | [] -> @@ -2377,7 +2377,7 @@ let prop_iter_make_id_primed tenv id iter = | (id1, e1):: _ -> let sub_id1 = Sil.sub_of_list [(id1, e1)] in let pairs_unpid' = - IList.map (fun (id', e') -> (id', Sil.exp_sub sub_id1 e')) pairs_unpid in + List.map ~f:(fun (id', e') -> (id', Sil.exp_sub sub_id1 e')) pairs_unpid in let sub_unpid = Sil.sub_of_list pairs_unpid' in let pairs = (id, e1) :: pairs_unpid' in sub_unpid, Sil.sub_of_list pairs, get_eqs [] pairs_pid in @@ -2401,7 +2401,7 @@ let prop_iter_footprint_fav iter = let prop_iter_fav_add fav iter = Sil.sub_fav_add fav iter.pit_sub; pi_fav_add fav iter.pit_pi; - pi_fav_add fav (IList.map snd iter.pit_newpi); + pi_fav_add fav (List.map ~f:snd iter.pit_newpi); sigma_fav_add fav iter.pit_old; sigma_fav_add fav iter.pit_new; Sil.hpred_fav_add fav iter.pit_curr; @@ -2434,10 +2434,10 @@ let rec strexp_gc_fields (fav: Sil.fav) (se : Sil.strexp) = | Eexp _ -> Some se | Estruct (fsel, inst) -> - let fselo = IList.map (fun (f, se) -> (f, strexp_gc_fields fav se)) fsel in + let fselo = List.map ~f:(fun (f, se) -> (f, strexp_gc_fields fav se)) fsel in let fsel' = let fselo' = List.filter ~f:(function | (_, Some _) -> true | _ -> false) fselo in - IList.map (function (f, seo) -> (f, unSome seo)) fselo' in + List.map ~f:(function (f, seo) -> (f, unSome seo)) fselo' in if [%compare.equal: (Ident.fieldname * Sil.strexp) list] fsel fsel' then Some se else Some (Sil.Estruct (fsel', inst)) | Earray _ -> @@ -2510,7 +2510,7 @@ end = struct let size = ref 0 in List.iter ~f:(fun hpred -> size := hpred_size hpred + !size) sigma; !size - let pi_size pi = pi_weight * IList.length pi + let pi_size pi = pi_weight * List.length pi (** Compute a size value for the prop, which indicates its complexity *) diff --git a/infer/src/backend/propgraph.ml b/infer/src/backend/propgraph.ml index db6bbc733..4b8b400eb 100644 --- a/infer/src/backend/propgraph.ml +++ b/infer/src/backend/propgraph.ml @@ -73,8 +73,12 @@ let get_subl footprint_part g = let edge_from_source g n footprint_part is_hpred = let edges = if is_hpred - then IList.map (fun hpred -> Ehpred hpred ) (get_sigma footprint_part g) - else IList.map (fun a -> Eatom a) (get_pi footprint_part g) @ IList.map (fun entry -> Esub_entry entry) (get_subl footprint_part g) in + then + List.map ~f:(fun hpred -> Ehpred hpred ) (get_sigma footprint_part g) + else + List.map + ~f:(fun a -> Eatom a) (get_pi footprint_part g) @ + List.map ~f:(fun entry -> Esub_entry entry) (get_subl footprint_part g) in let starts_from hpred = match edge_get_source hpred with | Some e -> Exp.equal n e @@ -95,7 +99,9 @@ let get_edges footprint_part g = let hpreds = get_sigma footprint_part g in let atoms = get_pi footprint_part g in let subst_entries = get_subl footprint_part g in - IList.map (fun hpred -> Ehpred hpred) hpreds @ IList.map (fun a -> Eatom a) atoms @ IList.map (fun entry -> Esub_entry entry) subst_entries + List.map ~f:(fun hpred -> Ehpred hpred) hpreds @ + List.map ~f:(fun a -> Eatom a) atoms @ + List.map ~f:(fun entry -> Esub_entry entry) subst_entries let edge_equal e1 e2 = match e1, e2 with | Ehpred hp1, Ehpred hp2 -> Sil.equal_hpred hp1 hp2 @@ -165,7 +171,7 @@ let compute_edge_diff (oldedge: edge) (newedge: edge) : Obj.t list = match olded compute_exp_diff e1 e2 | Eatom (Sil.Apred (_, es1)), Eatom (Sil.Apred (_, es2)) | Eatom (Sil.Anpred (_, es1)), Eatom (Sil.Anpred (_, es2)) -> - List.concat (try IList.map2 compute_exp_diff es1 es2 with IList.Fail -> []) + List.concat (try List.map2_exn ~f:compute_exp_diff es1 es2 with Invalid_argument _ -> []) | Esub_entry (_, e1), Esub_entry (_, e2) -> compute_exp_diff e1 e2 | _ -> [Obj.repr newedge] @@ -212,7 +218,7 @@ let diff_get_colormap footprint_part diff = If !Config.pring_using_diff is true, print the diff w.r.t. the given prop, extracting its local stack vars if the boolean is true. *) let pp_proplist pe0 s (base_prop, extract_stack) f plist = - let num = IList.length plist in + let num = List.length plist in let base_stack = fst (Prop.sigma_get_stack_nonstack true base_prop.Prop.sigma) in let add_base_stack prop = if extract_stack then Prop.set prop ~sigma:(base_stack @ prop.Prop.sigma) diff --git a/infer/src/backend/propset.ml b/infer/src/backend/propset.ml index 2e04beabf..7fd674ee9 100644 --- a/infer/src/backend/propset.ml +++ b/infer/src/backend/propset.ml @@ -73,14 +73,14 @@ let to_proplist pset = (** Apply function to all the elements of [propset], removing those where it returns [None]. *) let map_option tenv f pset = - let plisto = IList.map f (to_proplist pset) in + let plisto = List.map ~f:f (to_proplist pset) in let plisto = List.filter ~f:(function | Some _ -> true | None -> false) plisto in - let plist = IList.map (function Some p -> p | None -> assert false) plisto in + let plist = List.map ~f:(function Some p -> p | None -> assert false) plisto in from_proplist tenv plist (** Apply function to all the elements of [propset]. *) let map tenv f pset = - from_proplist tenv (IList.map f (to_proplist pset)) + from_proplist tenv (List.map ~f:f (to_proplist pset)) (** [fold f pset a] computes [f (... (f (f a p1) p2) ...) pn] where [p1 ... pN] are the elements of pset, in increasing order. *) diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index 5b5fe9b76..a77bda706 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -343,7 +343,7 @@ end = struct let leqs' = Exp.Map.fold (fun e upper acc_leqs -> (e, Exp.int upper):: acc_leqs) umap' [] in - let leqs'' = (IList.map DiffConstr.to_leq diff_constraints2) @ leqs' in + let leqs'' = (List.map ~f:DiffConstr.to_leq diff_constraints2) @ leqs' in leqs_sort_then_remove_redundancy leqs'' in let lts_res = let lmap = lmap_create_from_lts Exp.Map.empty lts in @@ -351,7 +351,7 @@ end = struct let lts' = Exp.Map.fold (fun e lower acc_lts -> (Exp.int lower, e):: acc_lts) lmap' [] in - let lts'' = (IList.map DiffConstr.to_lt diff_constraints2) @ lts' in + let lts'' = (List.map ~f:DiffConstr.to_lt diff_constraints2) @ lts' in lts_sort_then_remove_redundancy lts'' in { leqs = leqs_res; lts = lts_res; neqs = neqs } end @@ -481,7 +481,7 @@ end = struct | e', Exp.Const (Const.Cint _) -> Exp.equal e1 e' | _, _ -> false) leqs in let upper_list = - IList.map (function + List.map ~f:(function | _, Exp.Const (Const.Cint n) -> n | _ -> assert false) e_upper_list in if List.is_empty upper_list then None @@ -498,7 +498,7 @@ end = struct | Exp.Const (Const.Cint _), e' -> Exp.equal e1 e' | _, _ -> false) lts in let lower_list = - IList.map (function + List.map ~f:(function | Exp.Const (Const.Cint n), _ -> n | _ -> assert false) e_lower_list in if List.is_empty lower_list then None @@ -523,15 +523,15 @@ end = struct Format.fprintf fmt "%a %a %a" (pp_seq pp_leq) leqs (pp_seq pp_lt) lts (pp_seq pp_neq) neqs let d_leqs { leqs = leqs; lts = lts; neqs = neqs } = - let elist = IList.map (fun (e1, e2) -> Exp.BinOp(Binop.Le, e1, e2)) leqs in + let elist = List.map ~f:(fun (e1, e2) -> Exp.BinOp(Binop.Le, e1, e2)) leqs in Sil.d_exp_list elist let d_lts { leqs = leqs; lts = lts; neqs = neqs } = - let elist = IList.map (fun (e1, e2) -> Exp.BinOp(Binop.Lt, e1, e2)) lts in + let elist = List.map ~f:(fun (e1, e2) -> Exp.BinOp(Binop.Lt, e1, e2)) lts in Sil.d_exp_list elist let d_neqs { leqs = leqs; lts = lts; neqs = neqs } = - let elist = IList.map (fun (e1, e2) -> Exp.BinOp(Binop.Ne, e1, e2)) lts in + let elist = List.map ~f:(fun (e1, e2) -> Exp.BinOp(Binop.Ne, e1, e2)) lts in Sil.d_exp_list elist *) end @@ -1306,7 +1306,7 @@ let rec sexp_imply tenv source calc_index_frame calc_missing subs se1 se2 typ2 : raise (Exceptions.Abduction_case_not_implemented __POS__) end | Sil.Earray (len1, esel1, inst1), Sil.Earray (len2, esel2, _) -> - let indices2 = IList.map fst esel2 in + let indices2 = List.map ~f:fst esel2 in let subs' = array_len_imply tenv calc_missing subs len1 len2 indices2 in let subs'', index_frame, index_missing = array_imply tenv source calc_index_frame calc_missing subs' esel1 esel2 typ2 in @@ -1323,7 +1323,7 @@ let rec sexp_imply tenv source calc_index_frame calc_missing subs se1 se2 typ2 : d_impl_err ("WARNING: function call with parameters of struct type, treating as unknown", subs, (EXC_FALSE_SEXPS (se1, se2))); let fsel' = let g (f, _) = (f, Sil.Eexp (Exp.Var (Ident.create_fresh Ident.knormal), inst)) in - IList.map g fsel in + List.map ~f:g fsel in sexp_imply tenv source calc_index_frame calc_missing subs (Sil.Estruct (fsel', inst')) se2 typ2 | Sil.Eexp _, Sil.Earray (len, _, inst) | Sil.Estruct _, Sil.Earray (len, _, inst) -> @@ -1528,7 +1528,7 @@ let expand_hpred_pointer = | Sil.Hpointsto (Exp.BinOp (Binop.PlusPI, e1, e2), Sil.Earray (len, esel, inst), t) -> let shift_exp e = Exp.BinOp (Binop.PlusA, e, e2) in let len' = shift_exp len in - let esel' = IList.map (fun (e, se) -> (shift_exp e, se)) esel in + let esel' = List.map ~f:(fun (e, se) -> (shift_exp e, se)) esel in let hpred' = Sil.Hpointsto (e1, Sil.Earray (len', esel', inst), t) in expand true calc_index_frame hpred' | _ -> changed, calc_index_frame, hpred in @@ -1859,7 +1859,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 | Some iter1 -> (match Prop.prop_iter_find iter1 (filter_hpred (fst subs) (Sil.hpred_sub (snd subs) hpred2)) with | None -> - let elist2 = IList.map (fun e -> Sil.exp_sub (snd subs) e) _elist2 in + let elist2 = List.map ~f:(fun e -> Sil.exp_sub (snd subs) e) _elist2 in let _, para_inst2 = Sil.hpara_instantiate para2 e2 f2 elist2 in L.d_increase_indent 1; let res = @@ -1869,7 +1869,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 L.d_decrease_indent 1; res | Some iter1' -> - let elist2 = IList.map (fun e -> Sil.exp_sub (snd subs) e) _elist2 in + let elist2 = List.map ~f:(fun e -> Sil.exp_sub (snd subs) e) _elist2 in (* force instantiation of existentials *) let subs' = exp_list_imply tenv calc_missing subs (f2:: elist2) (f2:: elist2) in let prop1' = Prop.prop_iter_remove_curr_then_to_prop tenv iter1' in @@ -1925,7 +1925,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 | Some iter1 -> (match Prop.prop_iter_find iter1 (filter_hpred (fst subs) (Sil.hpred_sub (snd subs) hpred2)) with | None -> - let elist2 = IList.map (fun e -> Sil.exp_sub (snd subs) e) elist2 in + let elist2 = List.map ~f:(fun e -> Sil.exp_sub (snd subs) e) elist2 in let _, para_inst2 = if Exp.equal iF2 iB2 then Sil.hpara_dll_instantiate para2 iF2 oB2 oF2 elist2 @@ -1938,7 +1938,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 L.d_decrease_indent 1; res | Some iter1' -> (* Only consider implications between identical listsegs for now *) - let elist2 = IList.map (fun e -> Sil.exp_sub (snd subs) e) elist2 in + let elist2 = List.map ~f:(fun e -> Sil.exp_sub (snd subs) e) elist2 in (* force instantiation of existentials *) let subs' = exp_list_imply tenv calc_missing subs @@ -1976,7 +1976,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 * let se = Sil.Eexp (Exp.Var (Ident.create_fresh Ident.kprimed), Sil.Inone) in (fld, se) in let fields = ["java.lang.String.count"; "java.lang.String.hash"; "java.lang.String.offset"; "java.lang.String.value"] in - Sil.Estruct (IList.map mk_fld_sexp fields, Sil.inst_none) in + Sil.Estruct (List.map ~f:mk_fld_sexp fields, Sil.inst_none) in let const_string_texp = match !Config.curr_language with | Config.Clang -> @@ -2238,7 +2238,7 @@ exception NO_COVER (** Find miminum set of pi's in [cases] whose disjunction covers true *) let find_minimum_pure_cover tenv cases = let cases = - let compare (pi1, _) (pi2, _) = Int.compare (IList.length pi1) (IList.length pi2) + let compare (pi1, _) (pi2, _) = Int.compare (List.length pi1) (List.length pi2) in IList.sort compare cases in let rec grow seen todo = match todo with | [] -> raise NO_COVER @@ -2251,7 +2251,7 @@ let find_minimum_pure_cover tenv cases = if is_cover tenv (seen @ todo') then _shrink seen todo' else _shrink ((pi, x):: seen) todo' in let shrink cases = - if IList.length cases > 2 then _shrink [] cases + if List.length cases > 2 then _shrink [] cases else cases in try Some (shrink (grow [] cases)) with NO_COVER -> None diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index c272c8119..b82d81ae3 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -117,7 +117,7 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp let replace_typ_of_f (f', t', a') = if Ident.equal_fieldname f f' then (f, res_t', a') else (f', t', a') in let fields' = - IList.sort StructTyp.compare_field (IList.map replace_typ_of_f fields) in + IList.sort StructTyp.compare_field (List.map ~f:replace_typ_of_f fields) in ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; (atoms', se, t) | None -> @@ -222,11 +222,11 @@ let rec _strexp_extend_values let res_fsel' = IList.sort [%compare: Ident.fieldname * Sil.strexp] - (IList.map replace_fse fsel) in + (List.map ~f:replace_fse fsel) in let replace_fta ((f1, _, a1) as fta1) = if Ident.equal_fieldname f f1 then (f1, res_typ', a1) else fta1 in let fields' = - IList.sort StructTyp.compare_field (IList.map replace_fta fields) in + IList.sort StructTyp.compare_field (List.map ~f: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 List.fold ~f:replace ~init:[] atoms_se_typ_list' @@ -239,7 +239,7 @@ let rec _strexp_extend_values let replace_fta (f', t', a') = if Ident.equal_fieldname f' f then (f, res_typ', a') else (f', t', a') in let fields' = - IList.sort StructTyp.compare_field (IList.map replace_fta fields) in + IList.sort StructTyp.compare_field (List.map ~f:replace_fta fields) in ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; [(atoms', Sil.Estruct (res_fsel', inst'), typ)] ) @@ -273,8 +273,8 @@ let rec _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se' typ' off' inst in let replace acc (res_atoms', res_se', res_typ') = let replace_ise ise = if Exp.equal e (fst ise) then (e, res_se') else ise in - let res_esel' = IList.map replace_ise esel in - if (Typ.equal res_typ' typ') || Int.equal (IList.length res_esel') 1 then + let res_esel' = List.map ~f:replace_ise esel in + if (Typ.equal res_typ' typ') || Int.equal (List.length res_esel') 1 then ( res_atoms' , Sil.Earray (len, res_esel', inst_arr) , Typ.Tarray (res_typ', len_for_typ') ) @@ -305,7 +305,7 @@ and array_case_analysis_index pname tenv orig_prop List.exists ~f:(fun (i, _) -> Prover.check_equal tenv Prop.prop_emp index i) array_cont in let array_is_full = match array_len with - | Exp.Const (Const.Cint n') -> IntLit.geq (IntLit.of_int (IList.length array_cont)) n' + | Exp.Const (Const.Cint n') -> IntLit.geq (IntLit.of_int (List.length array_cont)) n' | _ -> false in if index_in_array then @@ -393,7 +393,7 @@ let strexp_extend_values let off', eqs = laundry_offset_for_footprint max_stamp off in (* do laundry_offset whether footprint_part is true or not, so max_stamp is modified anyway *) if footprint_part then - off', IList.map (fun (id, e) -> Prop.mk_eq tenv (Exp.Var id) e) eqs + off', List.map ~f:(fun (id, e) -> Prop.mk_eq tenv (Exp.Var id) e) eqs else off, [] in if Config.trace_rearrange then (L.d_str "entering strexp_extend_values se: "; Sil.d_sexp se; L.d_str " typ: "; @@ -410,7 +410,7 @@ let strexp_extend_values let len, st = match te with | Exp.Sizeof(_, len, st) -> (len, st) | _ -> None, Subtype.exact in - IList.map (fun (atoms', se', typ') -> (laundry_atoms @ atoms', se', Exp.Sizeof (typ', len, st))) + List.map ~f:(fun (atoms', se', typ') -> (laundry_atoms @ atoms', se', Exp.Sizeof (typ', len, st))) atoms_se_typ_list_filtered let collect_root_offset exp = @@ -460,7 +460,7 @@ let mk_ptsto_exp_footprint let atoms, ptsto_foot = create_ptsto true off_foot in let sub = Sil.sub_of_list eqs in let ptsto = Sil.hpred_sub sub ptsto_foot in - let atoms' = IList.map (fun (id, e) -> Prop.mk_eq tenv (Exp.Var id) e) eqs in + let atoms' = List.map ~f:(fun (id, e) -> Prop.mk_eq tenv (Exp.Var id) e) eqs in (ptsto, ptsto_foot, atoms @ atoms') (** Check if the path in exp exists already in the current ptsto predicate. @@ -505,7 +505,9 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst = let atoms_se_te_list = strexp_extend_values pname tenv orig_prop true Ident.kfootprint (ref max_stamp_val) se te offset inst in - IList.map (fun (atoms', se', te') -> (atoms', Sil.Hpointsto (e, se', te'))) atoms_se_te_list + List.map + ~f:(fun (atoms', se', te') -> (atoms', Sil.Hpointsto (e, se', te'))) + atoms_se_te_list | Sil.Hlseg (k, hpara, e1, e2, el) -> begin match hpara.Sil.body with @@ -515,10 +517,16 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst = pname tenv orig_prop true Ident.kfootprint (ref max_stamp_val) se' te' offset inst in let atoms_body_list = - IList.map (fun (atoms0, se0, te0) -> (atoms0, Sil.Hpointsto(e', se0, te0):: body_rest)) atoms_se_te_list in + List.map + ~f:(fun (atoms0, se0, te0) -> (atoms0, Sil.Hpointsto(e', se0, te0):: body_rest)) + atoms_se_te_list in let atoms_hpara_list = - IList.map (fun (atoms, body') -> (atoms, { hpara with Sil.body = body'})) atoms_body_list in - IList.map (fun (atoms, hpara') -> (atoms, Sil.Hlseg(k, hpara', e1, e2, el))) atoms_hpara_list + List.map + ~f:(fun (atoms, body') -> (atoms, { hpara with Sil.body = body'})) + atoms_body_list in + List.map + ~f:(fun (atoms, hpara') -> (atoms, Sil.Hlseg(k, hpara', e1, e2, el))) + atoms_hpara_list | _ -> assert false end | _ -> assert false in @@ -539,7 +547,7 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst = let atoms_se_te_list = strexp_extend_values pname tenv orig_prop false extend_kind max_stamp se te offset inst in - IList.map (atoms_se_te_to_iter e) atoms_se_te_list in + List.map ~f:(atoms_se_te_to_iter e) atoms_se_te_list in let res_iter_list = if Ident.equal_kind extend_kind Ident.kprimed then iter_list (* normal part already extended: nothing to do *) @@ -557,20 +565,22 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst = match sigma_pto with | [hpred] -> let atoms_hpred_list = extend_footprint_pred hpred in - IList.map (fun (atoms, hpred') -> (atoms, hpred' :: sigma_rest)) atoms_hpred_list + List.map ~f:(fun (atoms, hpred') -> (atoms, hpred' :: sigma_rest)) atoms_hpred_list | _ -> L.d_warning "Cannot extend "; Sil.d_exp lexp; L.d_strln " in"; Prop.d_prop (Prop.prop_iter_to_prop tenv iter); L.d_ln(); [([], footprint_sigma)] in - IList.map (fun (atoms, sigma') -> (atoms, IList.stable_sort Sil.compare_hpred sigma')) atoms_sigma_list in + List.map + ~f:(fun (atoms, sigma') -> (atoms, IList.stable_sort Sil.compare_hpred sigma')) + atoms_sigma_list in let iter_atoms_fp_sigma_list = list_product iter_list atoms_fp_sigma_list in - IList.map (fun (iter, (atoms, fp_sigma)) -> + List.map ~f:(fun (iter, (atoms, fp_sigma)) -> 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 = - IList.map (Prop.prop_iter_to_prop tenv) res_iter_list in + List.map ~f:(Prop.prop_iter_to_prop tenv) res_iter_list in begin L.d_str "in prop_iter_extend_ptsto lexp: "; Sil.d_exp lexp; L.d_ln (); L.d_strln "prop before:"; @@ -994,13 +1004,13 @@ let iter_rearrange_ptsto pname tenv orig_prop iter lexp inst = let filter it = let p = Prop.prop_iter_to_prop tenv it in not (Prover.check_inconsistency tenv p) in - List.filter ~f:filter (IList.map handle_case atoms_se_te_list) + List.filter ~f:filter (List.map ~f:handle_case atoms_se_te_list) | _ -> [iter] end in begin if Config.trace_rearrange then begin L.d_strln "exiting iter_rearrange_ptsto, returning results"; - Prop.d_proplist_with_typ (IList.map (Prop.prop_iter_to_prop tenv) res); + Prop.d_proplist_with_typ (List.map ~f:(Prop.prop_iter_to_prop tenv) res); L.d_decrease_indent 1; L.d_ln (); L.d_ln () end; @@ -1264,7 +1274,7 @@ let rec iter_rearrange end in if Config.trace_rearrange then begin L.d_strln "exiting iter_rearrange, returning results"; - Prop.d_proplist_with_typ (IList.map (Prop.prop_iter_to_prop tenv) res); + Prop.d_proplist_with_typ (List.map ~f:(Prop.prop_iter_to_prop tenv) res); L.d_decrease_indent 1; L.d_ln (); L.d_ln () end; diff --git a/infer/src/backend/specs.ml b/infer/src/backend/specs.ml index 2885d8884..fd89b7371 100644 --- a/infer/src/backend/specs.ml +++ b/infer/src/backend/specs.ml @@ -148,7 +148,7 @@ let visited_str vis = let s = ref "" in let lines = ref Int.Set.empty in let do_one (_, ns) = - (* if IList.length ns > 1 then + (* if List.length ns > 1 then begin let ss = ref "" in List.iter ~f:(fun n -> ss := !ss ^ " " ^ string_of_int n) ns; @@ -189,7 +189,8 @@ end = struct let spec_sub tenv sub spec = { pre = Jprop.normalize tenv (Jprop.jprop_sub sub spec.pre); - posts = IList.map (fun (p, path) -> (Prop.normalize tenv (Prop.prop_sub sub p), path)) spec.posts; + posts = + List.map ~f:(fun (p, path) -> (Prop.normalize tenv (Prop.prop_sub sub p), path)) spec.posts; visited = spec.visited } (** Convert spec into normal form w.r.t. variable renaming *) @@ -198,14 +199,14 @@ end = struct let idlist = Sil.fav_to_list fav in let count = ref 0 in let sub = - Sil.sub_of_list (IList.map (fun id -> + Sil.sub_of_list (List.map ~f:(fun id -> incr count; (id, Exp.Var (Ident.create_normal Ident.name_spec !count))) idlist) in spec_sub tenv sub spec (** Return a compact representation of the spec *) let compact sh spec = let pre = Jprop.compact sh spec.pre in - let posts = IList.map (fun (p, path) -> (Prop.prop_compact sh p, path)) spec.posts in + let posts = List.map ~f:(fun (p, path) -> (Prop.prop_compact sh p, path)) spec.posts in { pre = pre; posts = posts; visited = spec.visited } (** Erase join info from pre of spec *) @@ -372,7 +373,7 @@ let pp_spec pe num_opt fmt spec = | Some (n, tot) -> Format.sprintf "%d of %d [nvisited:%s]" n tot (visited_str spec.visited) in let pre = Jprop.to_prop spec.pre in let pe_post = Prop.prop_update_obj_sub pe pre in - let post_list = IList.map fst spec.posts in + let post_list = List.map ~f:fst spec.posts in match pe.Pp.kind with | TEXT -> F.fprintf fmt "--------------------------- %s ---------------------------@\n" num_str; @@ -392,7 +393,7 @@ let pp_spec pe num_opt fmt spec = let d_spec (spec: 'a spec) = L.add_print_action (L.PTspec, Obj.repr spec) let pp_specs pe fmt specs = - let total = IList.length specs in + let total = List.length specs in let cnt = ref 0 in match pe.Pp.kind with | TEXT -> @@ -420,9 +421,9 @@ let get_signature summary = let s = ref "" in List.iter ~f:(fun (p, typ) -> - let pp f = F.fprintf f "%a %a" (Typ.pp_full Pp.text) typ Mangled.pp p in - let decl = F.asprintf "%t" pp in - s := if String.equal !s "" then decl else !s ^ ", " ^ decl) + let pp f = F.fprintf f "%a %a" (Typ.pp_full Pp.text) typ Mangled.pp p in + let decl = F.asprintf "%t" pp in + s := if String.equal !s "" then decl else !s ^ ", " ^ decl) summary.attributes.ProcAttributes.formals; let pp f = F.fprintf @@ -510,7 +511,7 @@ let payload_compact sh payload = match payload.preposts with | Some specs -> { payload with - preposts = Some (IList.map (NormSpec.compact sh) specs); + preposts = Some (List.map ~f:(NormSpec.compact sh) specs); } | None -> payload @@ -536,8 +537,8 @@ let res_dir_specs_filename pname = (** paths to the .specs file for the given procedure in the current spec libraries *) let specs_library_filenames pname = - IList.map - (fun specs_dir -> DB.filename_from_string (Filename.concat specs_dir (specs_filename pname))) + List.map + ~f:(fun specs_dir -> DB.filename_from_string (Filename.concat specs_dir (specs_filename pname))) Config.specs_library (** paths to the .specs file for the given procedure in the models folder *) diff --git a/infer/src/backend/state.ml b/infer/src/backend/state.ml index 62b7d1045..78b0255a3 100644 --- a/infer/src/backend/state.ml +++ b/infer/src/backend/state.ml @@ -140,7 +140,9 @@ let node_simple_key node = let node_key node = let succs = Procdesc.Node.get_succs node in let preds = Procdesc.Node.get_preds node in - let v = (node_simple_key node, IList.map node_simple_key succs, IList.map node_simple_key preds) in + let v = (node_simple_key node, + List.map ~f:node_simple_key succs, + List.map ~f:node_simple_key preds) in Hashtbl.hash v (** normalize the list of instructions by renaming let-bound ids *) @@ -155,8 +157,8 @@ let instrs_normalize instrs = let gensym id = incr count; Ident.set_stamp id !count in - Sil.sub_of_list (IList.map (fun id -> (id, Exp.Var (gensym id))) bound_ids) in - IList.map (Sil.instr_sub subst) instrs + Sil.sub_of_list (List.map ~f:(fun id -> (id, Exp.Var (gensym id))) bound_ids) in + List.map ~f:(Sil.instr_sub subst) instrs (** Create a function to find duplicate nodes. A node is a duplicate of another one if they have the same kind and location @@ -251,7 +253,7 @@ let extract_pre p tenv pdesc abstract_fun = let fav = Prop.prop_fav p in let idlist = Sil.fav_to_list fav in let count = ref 0 in - Sil.sub_of_list (IList.map (fun id -> + Sil.sub_of_list (List.map ~f:(fun id -> incr count; (id, Exp.Var (Ident.create_normal Ident.name_spec !count))) idlist) in let _, p' = PropUtil.remove_locals_formals tenv pdesc p in let pre, _ = Prop.extract_spec p' in diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index 404fc32a3..922ace592 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -46,9 +46,9 @@ let unroll_type tenv (typ: Typ.t) (off: Sil.offset) = (** Given a node, returns a list of pvar of blocks that have been nullified in the block. *) let get_blocks_nullified node = - let null_blocks = List.concat (IList.map (fun i -> match i with + let null_blocks = List.concat_map ~f:(fun i -> match i with | Sil.Nullify(pvar, _) when Sil.is_block_pvar pvar -> [pvar] - | _ -> []) (Procdesc.Node.get_instrs node)) in + | _ -> []) (Procdesc.Node.get_instrs node) in null_blocks (** Given a proposition and an objc block checks whether by existentially quantifying @@ -150,10 +150,10 @@ let rec apply_offlist (root_lexp, se', t') offlist' f inst lookup_inst in let replace_fse fse = if Ident.equal_fieldname fld (fst fse) then (fld, res_se') else fse in - let res_se = Sil.Estruct (IList.map replace_fse fsel, inst') in + let res_se = Sil.Estruct (List.map ~f:replace_fse fsel, inst') in let replace_fta (f, t, a) = if Ident.equal_fieldname fld f then (fld, res_t', a) else (f, t, a) in - let fields' = IList.map replace_fta fields in + let fields' = List.map ~f:replace_fta fields in ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; (res_e', res_se, typ, res_pred_insts_op') | None -> @@ -182,7 +182,7 @@ let rec apply_offlist if Exp.equal idx_ese' (fst ese) then (idx_ese', res_se') else ese in - let res_se = Sil.Earray (len, IList.map replace_ese esel, inst1) in + let res_se = Sil.Earray (len, List.map ~f:replace_ese esel, inst1) in let res_t = Typ.Tarray (res_t', len') in (res_e', res_se, res_t, res_pred_insts_op') | None -> @@ -258,10 +258,10 @@ let rec execute_nullify_se = function | Sil.Eexp _ -> Sil.Eexp (Exp.zero, Sil.inst_nullify) | Sil.Estruct (fsel, _) -> - let fsel' = IList.map (fun (fld, se) -> (fld, execute_nullify_se se)) fsel in + let fsel' = List.map ~f:(fun (fld, se) -> (fld, execute_nullify_se se)) fsel in Sil.Estruct (fsel', Sil.inst_nullify) | Sil.Earray (len, esel, _) -> - let esel' = IList.map (fun (idx, se) -> (idx, execute_nullify_se se)) esel in + let esel' = List.map ~f:(fun (idx, se) -> (idx, execute_nullify_se se)) esel in Sil.Earray (len, esel', Sil.inst_nullify) (** Do pruning for conditional [if (e1 != e2) ] if [positive] is true @@ -366,7 +366,7 @@ and prune_union tenv ~positive condition1 condition2 prop = let dangerous_functions = let dangerous_list = ["gets"] in - ref ((IList.map Procname.from_string_c_fun) dangerous_list) + ref ((List.map ~f:Procname.from_string_c_fun) dangerous_list) let check_inherently_dangerous_function caller_pname callee_pname = if List.exists ~f:(Procname.equal callee_pname) !dangerous_functions then @@ -593,7 +593,7 @@ let resolve_virtual_pname tenv prop actuals callee_pname call_flags : Procname.t let resolve_java_pname tenv prop args pname_java call_flags : Procname.java = let resolve_from_args resolved_pname_java args = let parameters = Procname.java_get_parameters resolved_pname_java in - if IList.length args <> IList.length parameters then + if List.length args <> List.length parameters then resolved_pname_java else let resolved_params = @@ -1008,7 +1008,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path State.set_prop_tenv_pdesc prop_ tenv current_pdesc; (* mark prop,tenv,pdesc last seen *) SymOp.pay(); (* pay one symop *) let ret_old_path pl = (* return the old path unchanged *) - IList.map (fun p -> (p, path)) pl in + List.map ~f:(fun p -> (p, path)) pl in let instr = match _instr with | Sil.Call (ret, exp, par, loc, call_flags) -> let exp' = Prop.exp_normalize_prop tenv prop_ exp in @@ -1016,7 +1016,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path | Exp.Closure c -> let proc_exp = Exp.Const (Const.Cfun c.name) in let proc_exp' = Prop.exp_normalize_prop tenv prop_ proc_exp in - let par' = IList.map (fun (id_exp, _, typ) -> (id_exp, typ)) c.captured_vars in + let par' = List.map ~f:(fun (id_exp, _, typ) -> (id_exp, typ)) c.captured_vars in Sil.Call (ret, proc_exp', par' @ par, loc, call_flags) | _ -> Sil.Call (ret, exp', par, loc, call_flags) in @@ -1188,7 +1188,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path else proc_call (Option.value_exn resolved_summary_opt) (call_args prop resolved_pname n_actual_params ret_id loc) in - List.concat (IList.map do_call sentinel_result) + List.concat_map ~f:do_call sentinel_result ) ) | Sil.Call (ret_id, fun_exp, actual_params, loc, call_flags) -> (* Call via function pointer *) @@ -1244,9 +1244,9 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path let sigma_locals = let add_None (x, y) = (x, Exp.Sizeof (y, None, Subtype.exact), None) in let sigma_locals () = - IList.map - (Prop.mk_ptsto_lvar tenv Prop.Fld_init Sil.inst_initial) - (IList.map add_None ptl) in + List.map + ~f:(Prop.mk_ptsto_lvar tenv Prop.Fld_init Sil.inst_initial) + (List.map ~f:add_None ptl) in Config.run_in_re_execution_mode (* no footprint vars for locals *) sigma_locals () in let sigma' = prop_.Prop.sigma @ sigma_locals in @@ -1271,17 +1271,17 @@ and instrs ?(mask_errors=false) tenv pdesc instrs ppl = ("Generated Instruction Failed with: " ^ (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 + let f plist instr = List.concat_map ~f:(exe_instr instr) plist in 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 *) let replace_actual_hpred actual_var new_hpred prop = let sigma' = - IList.map - (function - | Sil.Hpointsto (lhs, _, _) when Exp.equal lhs actual_var -> new_hpred - | hpred -> hpred) + List.map + ~f:(function + | Sil.Hpointsto (lhs, _, _) when Exp.equal lhs actual_var -> new_hpred + | hpred -> hpred) prop.Prop.sigma in Prop.normalize tenv (Prop.set prop ~sigma:sigma') in let add_actual_by_ref_to_footprint prop (actual, actual_typ, _) = @@ -1317,11 +1317,11 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call (Typ.to_string typ)) in (* replace [actual] |-> _ with [actual] |-> [fresh_fp_var] *) let filtered_sigma = - IList.map - (function - | Sil.Hpointsto (lhs, _, typ_exp) when Exp.equal lhs actual -> - Sil.Hpointsto (lhs, abduced_strexp, typ_exp) - | hpred -> hpred) + List.map + ~f:(function + | Sil.Hpointsto (lhs, _, typ_exp) when Exp.equal lhs actual -> + Sil.Hpointsto (lhs, abduced_strexp, typ_exp) + | hpred -> hpred) prop'.Prop.sigma in Prop.normalize tenv (Prop.set prop' ~sigma:filtered_sigma) else @@ -1430,11 +1430,11 @@ and unknown_or_scan_call ~is_scan ret_type_option ret_annots |> fst else prop in let actuals_by_ref = - IList.flatten_options (IList.mapi - (fun i actual -> match actual with - | (Exp.Lvar _ as e, (Typ.Tptr _ as t)) -> Some (e, t, i) - | _ -> None) - args) in + List.filter_mapi + ~f:(fun i actual -> match actual with + | (Exp.Lvar _ as e, (Typ.Tptr _ as t)) -> Some (e, t, i) + | _ -> None) + args in let has_nullable_annot = Annotations.ia_is_nullable ret_annots in let pre_final = (* in Java, assume that skip functions close resources passed as params *) @@ -1478,7 +1478,7 @@ and check_variadic_sentinel (* useful if you would prefer to not have *any* formal parameters, *) (* but the language forces you to have at least one. *) let first_var_arg_pos = if null_pos > n_formals then 0 else n_formals - null_pos in - let nargs = IList.length args in + let nargs = List.length args in (* sentinels start counting from the last argument to the function *) let sentinel_pos = nargs - sentinel - 1 in let mk_non_terminal_argsi (acc, i) a = @@ -1516,7 +1516,7 @@ and check_variadic_sentinel_if_present | None -> [(prop_, path)] | Some sentinel_arg -> let formals = callee_attributes.ProcAttributes.formals in - check_variadic_sentinel (IList.length formals) sentinel_arg builtin_args + check_variadic_sentinel (List.length formals) sentinel_arg builtin_args and sym_exec_objc_getter field_name ret_typ tenv ret_id pdesc pname loc args prop = L.d_strln ("No custom getter found. Executing the ObjC builtin getter with ivar "^ @@ -1551,7 +1551,7 @@ and sym_exec_objc_accessor property_accesor ret_typ tenv ret_id pdesc _ loc args since this is the procname of the setter/getter method *) let cur_pname = Procdesc.get_proc_name pdesc in f_accessor ret_typ tenv ret_id pdesc cur_pname loc args prop - |> IList.map (fun p -> (p, path)) + |> List.map ~f:(fun p -> (p, path)) (** Perform symbolic execution for a function call *) and proc_call summary {Builtin.pdesc; tenv; prop_= pre; path; ret_id; args= actual_pars; loc; } = @@ -1571,7 +1571,7 @@ and proc_call summary {Builtin.pdesc; tenv; prop_= pre; path; ret_id; args= actu Reporting.log_warning caller_pname exn in check_inherently_dangerous_function caller_pname callee_pname; begin - let formal_types = IList.map (fun (_, typ) -> typ) (Specs.get_formals summary) in + let formal_types = List.map ~f:(fun (_, typ) -> typ) (Specs.get_formals summary) in let rec comb actual_pars formal_types = match actual_pars, formal_types with | [], [] -> actual_pars @@ -1584,13 +1584,13 @@ and proc_call summary {Builtin.pdesc; tenv; prop_= pre; path; ret_id; args= actu L.d_warning "likely use of variable-arguments function, or function prototype missing"; L.d_ln(); - L.d_str "actual parameters: "; Sil.d_exp_list (IList.map fst actual_pars); L.d_ln (); + L.d_str "actual parameters: "; Sil.d_exp_list (List.map ~f:fst actual_pars); L.d_ln (); L.d_str "formal parameters: "; Typ.d_list formal_types; L.d_ln (); actual_pars | [], _ -> L.d_str ("**** ERROR: Procedure " ^ Procname.to_string callee_pname); L.d_strln (" mismatch in the number of parameters ****"); - L.d_str "actual parameters: "; Sil.d_exp_list (IList.map fst actual_pars); L.d_ln (); + L.d_str "actual parameters: "; Sil.d_exp_list (List.map ~f:fst actual_pars); L.d_ln (); L.d_str "formal parameters: "; Typ.d_list formal_types; L.d_ln (); raise (Exceptions.Wrong_argument_number __POS__) in let actual_params = comb actual_pars formal_types in @@ -1620,12 +1620,12 @@ and sym_exec_wrapper handle_exn tenv pdesc instr ((prop: Prop.normal Prop.t), pa Sil.fav_filter_ident fav Ident.is_primed; let ids_primed = Sil.fav_to_list fav in let ids_primed_normal = - IList.map (fun id -> (id, Ident.create_fresh Ident.knormal)) ids_primed in + List.map ~f:(fun id -> (id, Ident.create_fresh Ident.knormal)) ids_primed in let ren_sub = - Sil.sub_of_list (IList.map - (fun (id1, id2) -> (id1, Exp.Var id2)) ids_primed_normal) in + Sil.sub_of_list (List.map + ~f:(fun (id1, id2) -> (id1, Exp.Var id2)) ids_primed_normal) in let p' = Prop.normalize tenv (Prop.prop_sub ren_sub p) in - let fav_normal = Sil.fav_from_list (IList.map snd ids_primed_normal) in + let fav_normal = Sil.fav_from_list (List.map ~f:snd ids_primed_normal) in p', fav_normal in let prop_normal_to_primed fav_normal p = (* rename given normal vars to fresh primed *) if List.is_empty (Sil.fav_to_list fav_normal) then p @@ -1665,15 +1665,15 @@ and sym_exec_wrapper handle_exn tenv pdesc instr ((prop: Prop.normal Prop.t), pa (fun () -> sym_exec tenv pdesc instr prop' path) () in let res_list_nojunk = - IList.map - (fun (p, path) -> (post_process_result fav_normal p path, path)) + List.map + ~f:(fun (p, path) -> (post_process_result fav_normal p path, path)) res_list in let results = - IList.map - (fun (p, path) -> (Prop.prop_rename_primed_footprint_vars tenv p, path)) + List.map + ~f:(fun (p, path) -> (Prop.prop_rename_primed_footprint_vars tenv p, path)) res_list_nojunk in L.d_strln "Instruction Returns"; - Propgraph.d_proplist prop (IList.map fst results); L.d_ln (); + Propgraph.d_proplist prop (List.map ~f:fst results); L.d_ln (); State.mark_instr_ok (); Paths.PathSet.from_renamed_list results with exn when Exceptions.handle_exception exn && !Config.footprint -> diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index 908f9e4cd..8b0a899bc 100644 --- a/infer/src/backend/tabulation.ml +++ b/infer/src/backend/tabulation.ml @@ -106,12 +106,12 @@ let spec_rename_vars pname spec = Specs.Jprop.fav_add fav spec.Specs.pre; List.iter ~f:(fun (p, _) -> Prop.prop_fav_add fav p) spec.Specs.posts; let ids = Sil.fav_to_list fav in - let ids' = IList.map (fun i -> (i, Ident.create_fresh Ident.kprimed)) ids in - let ren_sub = Sil.sub_of_list (IList.map (fun (i, i') -> (i, Exp.Var i')) ids') in + let ids' = List.map ~f:(fun i -> (i, Ident.create_fresh Ident.kprimed)) ids in + let ren_sub = Sil.sub_of_list (List.map ~f:(fun (i, i') -> (i, Exp.Var i')) ids') in let pre' = Specs.Jprop.jprop_sub ren_sub spec.Specs.pre in - let posts' = IList.map (fun (p, path) -> (Prop.prop_sub ren_sub p, path)) spec.Specs.posts in + let posts' = List.map ~f:(fun (p, path) -> (Prop.prop_sub ren_sub p, path)) spec.Specs.posts in let pre'' = jprop_add_callee_suffix pre' in - let posts'' = IList.map (fun (p, path) -> (prop_add_callee_suffix p, path)) posts' in + let posts'' = List.map ~f:(fun (p, path) -> (prop_add_callee_suffix p, path)) posts' in { Specs.pre = pre''; Specs.posts = posts''; Specs.visited = spec.Specs.visited } (** Find and number the specs for [proc_name], @@ -130,8 +130,8 @@ let spec_find_rename trace_call (proc_name : Procname.t) (Localise.verbatim_desc (Procname.to_string proc_name), __POS__)) end; let formal_parameters = - IList.map (fun (x, _) -> Pvar.mk_callee x proc_name) formals in - IList.map f specs, formal_parameters + List.map ~f:(fun (x, _) -> Pvar.mk_callee x proc_name) formals in + List.map ~f:f specs, formal_parameters with Not_found -> begin L.d_strln ("ERROR: found no entry for procedure " ^ @@ -158,8 +158,8 @@ let process_splitting let sub1_list = Sil.sub_to_list sub1 in let sub1_list' = List.filter ~f:(function (_, Exp.Var _) -> true | _ -> false) sub1_list in let sub1_inverse_list = - IList.map - (function (id, Exp.Var id') -> (id', Exp.Var id) | _ -> assert false) + List.map + ~f:(function (id, Exp.Var id') -> (id', Exp.Var id) | _ -> assert false) sub1_list' in Sil.sub_of_list_duplicates sub1_inverse_list in let fav_actual_pre = @@ -205,30 +205,30 @@ let process_splitting let rng1 = Sil.sub_range sub1 in let dom2 = Sil.sub_domain sub2 in let rng2 = Sil.sub_range sub2 in - let vars_actual_pre = IList.map (fun id -> Exp.Var id) (Sil.fav_to_list fav_actual_pre) in + let vars_actual_pre = List.map ~f:(fun id -> Exp.Var id) (Sil.fav_to_list fav_actual_pre) in L.d_str "fav_actual_pre: "; Sil.d_exp_list vars_actual_pre; L.d_ln (); - L.d_str "Dom(Sub1): "; Sil.d_exp_list (IList.map (fun id -> Exp.Var id) dom1); L.d_ln (); + L.d_str "Dom(Sub1): "; Sil.d_exp_list (List.map ~f:(fun id -> Exp.Var id) dom1); L.d_ln (); L.d_str "Ran(Sub1): "; Sil.d_exp_list rng1; L.d_ln (); - L.d_str "Dom(Sub2): "; Sil.d_exp_list (IList.map (fun id -> Exp.Var id) dom2); L.d_ln (); + L.d_str "Dom(Sub2): "; Sil.d_exp_list (List.map ~f:(fun id -> Exp.Var id) dom2); L.d_ln (); L.d_str "Ran(Sub2): "; Sil.d_exp_list rng2; L.d_ln (); L.d_str "Don't know about id: "; Sil.d_exp (Exp.Var id); L.d_ln (); assert false; end - in Sil.sub_of_list (IList.map f fav_sub_list) in + in Sil.sub_of_list (List.map ~f:f fav_sub_list) in let sub2_list = let f id = (id, Exp.Var (Ident.create_fresh Ident.kfootprint)) - in IList.map f (Sil.fav_to_list fav_missing_primed) in + in List.map ~f:f (Sil.fav_to_list fav_missing_primed) in let sub_list' = - IList.map (fun (id, e) -> (id, Sil.exp_sub sub1 e)) sub_list in + List.map ~f:(fun (id, e) -> (id, Sil.exp_sub sub1 e)) sub_list in let sub' = Sil.sub_of_list (sub2_list @ sub_list') in (* normalize everything w.r.t sub' *) let norm_missing_pi = Prop.pi_sub sub' missing_pi in let norm_missing_sigma = Prop.sigma_sub sub' missing_sigma in let norm_frame_fld = Prop.sigma_sub sub' frame_fld in let norm_frame_typ = - IList.map (fun (e, te) -> Sil.exp_sub sub' e, Sil.exp_sub sub' te) frame_typ in + List.map ~f:(fun (e, te) -> Sil.exp_sub sub' e, Sil.exp_sub sub' te) frame_typ in let norm_missing_typ = - IList.map (fun (e, te) -> Sil.exp_sub sub' e, Sil.exp_sub sub' te) missing_typ in + List.map ~f:(fun (e, te) -> Sil.exp_sub sub' e, Sil.exp_sub sub' te) missing_typ in let norm_missing_fld = let sigma = Prop.sigma_sub sub' missing_fld in let filter hpred = @@ -268,12 +268,12 @@ let rec find_dereference_without_null_check_in_sexp = function | Sil.Estruct (fsel, inst) -> let res = find_dereference_without_null_check_in_inst inst in if is_none res then - find_dereference_without_null_check_in_sexp_list (IList.map snd fsel) + find_dereference_without_null_check_in_sexp_list (List.map ~f:snd fsel) else res | Sil.Earray (_, esel, inst) -> let res = find_dereference_without_null_check_in_inst inst in if is_none res then - find_dereference_without_null_check_in_sexp_list (IList.map snd esel) + find_dereference_without_null_check_in_sexp_list (List.map ~f:snd esel) else res and find_dereference_without_null_check_in_sexp_list = function | [] -> None @@ -359,7 +359,7 @@ let post_process_sigma tenv (sigma: Sil.hpred list) loc : Sil.hpred list = let map_inst inst = Sil.inst_new_loc loc inst in let do_hpred (_, _, hpred) = Sil.hpred_instmap map_inst hpred in (* update the location of instrumentations *) - IList.map (fun hpred -> do_hpred (Prover.expand_hpred_pointer tenv false hpred)) sigma + List.map ~f:(fun hpred -> do_hpred (Prover.expand_hpred_pointer tenv false hpred)) sigma (** check for interprocedural path errors in the post *) let check_path_errors_in_post tenv caller_pname post post_path = @@ -397,7 +397,7 @@ let post_process_post tenv Sil.Apred (Aresource ra', [e]) | a -> a in let prop' = Prop.set post ~sigma:(post_process_sigma tenv post.Prop.sigma loc) in - let pi' = IList.map atom_update_alloc_attribute prop'.Prop.pi in + let pi' = List.map ~f:atom_update_alloc_attribute prop'.Prop.pi in (* update alloc attributes to refer to the caller *) let post' = Prop.set prop' ~pi:pi' in check_path_errors_in_post tenv caller_pname post' post_path; @@ -414,9 +414,9 @@ let rec sexp_set_inst inst = function | Sil.Eexp (e, _) -> Sil.Eexp (e, inst) | Sil.Estruct (fsel, _) -> - Sil.Estruct ((IList.map (fun (f, se) -> (f, sexp_set_inst inst se)) fsel), inst) + Sil.Estruct ((List.map ~f:(fun (f, se) -> (f, sexp_set_inst inst se)) fsel), inst) | Sil.Earray (len, esel, _) -> - Sil.Earray (len, IList.map (fun (e, se) -> (e, sexp_set_inst inst se)) esel, inst) + Sil.Earray (len, List.map ~f:(fun (e, se) -> (e, sexp_set_inst inst se)) esel, inst) let rec fsel_star_fld fsel1 fsel2 = match fsel1, fsel2 with | [], fsel2 -> fsel2 @@ -433,7 +433,7 @@ and array_content_star se1 se2 = and esel_star_fld esel1 esel2 = match esel1, esel2 with | [], esel2 -> (* don't know whether element is read or written in fun call with array *) - IList.map (fun (e, se) -> (e, sexp_set_inst Sil.Inone se)) esel2 + List.map ~f:(fun (e, se) -> (e, sexp_set_inst Sil.Inone se)) esel2 | esel1,[] -> esel1 | (e1, se1):: esel1', (e2, se2):: esel2' -> (match Exp.compare e1 e2 with @@ -664,7 +664,7 @@ let prop_set_exn tenv pname prop se_exn = | Sil.Hpointsto (e, _, t) when Exp.equal e ret_pvar -> Sil.Hpointsto(e, se_exn, t) | hpred -> hpred in - let sigma' = IList.map map_hpred prop.Prop.sigma in + let sigma' = List.map ~f:map_hpred prop.Prop.sigma in Prop.normalize tenv (Prop.set prop ~sigma:sigma') (** Include a subtrace for a procedure call if the callee is not a model. *) @@ -688,19 +688,19 @@ let combine tenv (* with updated footprint and inconsistent current *) [(Prop.set Prop.prop_emp ~pi:[Sil.Aneq (Exp.zero, Exp.zero)], path_pre)] else - IList.map - (fun (p, path_post) -> - (p, - Paths.Path.add_call - (include_subtrace callee_pname) - path_pre - callee_pname - path_post)) + List.map + ~f:(fun (p, path_post) -> + (p, + Paths.Path.add_call + (include_subtrace callee_pname) + path_pre + callee_pname + path_post)) posts in - IList.map - (fun (p, path) -> - (post_process_post tenv - caller_pname callee_pname loc actual_pre (Prop.prop_sub split.sub p, path))) + List.map + ~f:(fun (p, path) -> + (post_process_post tenv + caller_pname callee_pname loc actual_pre (Prop.prop_sub split.sub p, path))) posts' in L.d_increase_indent 1; L.d_strln "New footprint:"; Prop.d_pi_sigma split.missing_pi split.missing_sigma; L.d_ln (); @@ -716,7 +716,7 @@ let combine tenv Prover.d_typings split.missing_typ; L.d_ln (); end; L.d_strln "Instantiated frame:"; Prop.d_sigma split.frame; L.d_ln (); L.d_strln "Instantiated post:"; - Propgraph.d_proplist Prop.prop_emp (IList.map fst instantiated_post); + Propgraph.d_proplist Prop.prop_emp (List.map ~f:fst instantiated_post); L.d_decrease_indent 1; L.d_ln (); let compute_result post_p = let post_p' = @@ -767,7 +767,7 @@ let combine tenv let p = Prop.prop_iter_remove_curr_then_to_prop tenv iter' in Prop.conjoin_eq tenv e' (Exp.Var id) p | Sil.Hpointsto (_, Sil.Estruct (ftl, _), _), _ - when Int.equal (IList.length ftl) (if is_none ret_id then 0 else 1) -> + when Int.equal (List.length ftl) (if is_none ret_id then 0 else 1) -> (* TODO(jjb): Is this case dead? *) let rec do_ftl_ids p = function | [], None -> p @@ -792,14 +792,14 @@ let combine tenv split.missing_typ else Some post_p3 in post_p4 in - let _results = IList.map (fun (p, path) -> (compute_result p, path)) instantiated_post in + let _results = List.map ~f:(fun (p, path) -> (compute_result p, path)) instantiated_post in if List.exists ~f:(fun (x, _) -> is_none x) _results then (* at least one combine failed *) None else let results = - IList.map (function (Some x, path) -> (x, path) | (None, _) -> assert false) + List.map ~f:(function (Some x, path) -> (x, path) | (None, _) -> assert false) _results in - print_results tenv actual_pre (IList.map fst results); + print_results tenv actual_pre (List.map ~f:fst results); Some results (* Add Auntaint attribute to a callee_pname precondition *) @@ -869,9 +869,9 @@ let mk_actual_precondition tenv prop actual_params formal_params = begin let str = "more actual pars than formal pars in fun call (" ^ - string_of_int (IList.length actual_params) ^ + string_of_int (List.length actual_params) ^ " vs " ^ - string_of_int (IList.length formal_params) ^ + string_of_int (List.length formal_params) ^ ")" in L.d_warning str; L.d_ln () end; @@ -883,7 +883,7 @@ let mk_actual_precondition tenv prop actual_params formal_params = (Exp.Lvar formal_var) (Sil.Eexp (actual_e, Sil.inst_actual_precondition)) (Exp.Sizeof (actual_t, None, Subtype.exact)) in - let instantiated_formals = IList.map mk_instantiation formals_actuals in + let instantiated_formals = List.map ~f:mk_instantiation formals_actuals in let actual_pre = Prop.prop_sigma_star prop instantiated_formals in Prop.normalize tenv actual_pre @@ -922,7 +922,7 @@ let mk_posts tenv ret_id prop callee_pname callee_attrs posts = (Apred (Ataint { taint_source = callee_pname; taint_kind; }, [Exp.Var ret_id])) |> Prop.expose in (prop', path) in - IList.map taint_retval posts + List.map ~f:taint_retval posts | None -> posts in let posts' = if Config.idempotent_getters && Config.curr_language_is Config.Java @@ -1142,9 +1142,9 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re let valid_res0, invalid_res0 = IList.partition filter_valid_res results in let valid_res = - IList.map (function Valid_res cr -> cr | Invalid_res _ -> assert false) valid_res0 in + List.map ~f:(function Valid_res cr -> cr | Invalid_res _ -> assert false) valid_res0 in let invalid_res = - IList.map (function Valid_res _ -> assert false | Invalid_res ir -> ir) invalid_res0 in + List.map ~f:(function Valid_res _ -> assert false | Invalid_res ir -> ir) invalid_res0 in let valid_res_miss_pi, valid_res_no_miss_pi = IList.partition (fun vr -> vr.vr_pi <> []) valid_res in let _, valid_res_cons_pre_missing = @@ -1226,46 +1226,46 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re if not vr.incons_pre_missing && List.is_empty vr.vr_cons_res then (* no consistent results on one spec: divergence *) let incons_res = - IList.map - (fun (p, path) -> (prop_pure_to_footprint tenv p, path)) + List.map + ~f:(fun (p, path) -> (prop_pure_to_footprint tenv p, path)) vr.vr_incons_res in State.add_diverging_states (Paths.PathSet.from_renamed_list incons_res) in save_diverging_states (); vr.vr_cons_res in - IList.map - (fun (p, path) -> (prop_pure_to_footprint tenv p, path)) - (List.concat (IList.map process_valid_res valid_res)) + List.map + ~f:(fun (p, path) -> (prop_pure_to_footprint tenv p, path)) + (List.concat_map ~f:process_valid_res valid_res) end else if valid_res_no_miss_pi <> [] then - List.concat (IList.map (fun vr -> vr.vr_cons_res) valid_res_no_miss_pi) + List.concat_map ~f:(fun vr -> vr.vr_cons_res) valid_res_no_miss_pi else if List.is_empty valid_res_miss_pi then raise (Exceptions.Precondition_not_met (call_desc None, __POS__)) else begin L.d_strln "Missing pure facts for the function call:"; - List.iter ~f:print_pi (IList.map (fun vr -> vr.vr_pi) valid_res_miss_pi); + List.iter ~f:print_pi (List.map ~f:(fun vr -> vr.vr_pi) valid_res_miss_pi); match Prover.find_minimum_pure_cover tenv - (IList.map (fun vr -> (vr.vr_pi, vr.vr_cons_res)) valid_res_miss_pi) with + (List.map ~f:(fun vr -> (vr.vr_pi, vr.vr_cons_res)) valid_res_miss_pi) with | None -> trace_call Specs.CallStats.CR_not_met; raise (Exceptions.Precondition_not_met (call_desc None, __POS__)) | Some cover -> L.d_strln "Found minimum cover"; - List.iter ~f:print_pi (IList.map fst cover); - List.concat (IList.map snd cover) + List.iter ~f:print_pi (List.map ~f:fst cover); + List.concat_map ~f:snd cover end in trace_call Specs.CallStats.CR_success; let res = - IList.map - (fun (p, path) -> (quantify_path_idents_remove_constant_strings tenv p, path)) + List.map + ~f:(fun (p, path) -> (quantify_path_idents_remove_constant_strings tenv p, path)) res_with_path_idents in let ret_annot, _ = callee_attrs.ProcAttributes.method_annotation in let returns_nullable ret_annot = Annotations.ia_is_nullable ret_annot in let should_add_ret_attr _ = let is_likely_getter = function | Procname.Java pn_java -> - Int.equal (IList.length (Procname.java_get_parameters pn_java)) 0 + Int.equal (List.length (Procname.java_get_parameters pn_java)) 0 | _ -> false in (Config.idempotent_getters && @@ -1279,7 +1279,7 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re let mark_id_as_retval (p, path) = let att_retval = PredSymb.Aretval (callee_pname, ret_annot) in Attribute.add tenv p att_retval [ret_var], path in - IList.map mark_id_as_retval res + List.map ~f:mark_id_as_retval res | _ -> res (** Execute the function call and return the list of results with return value *) @@ -1293,7 +1293,7 @@ let exe_function_call Specs.CallStats.trace summary.Specs.stats.Specs.call_stats callee_pname loc res !Config.footprint in let spec_list, formal_params = spec_find_rename trace_call callee_pname in - let nspecs = IList.length spec_list in + let nspecs = List.length spec_list in L.d_strln ("Found " ^ string_of_int nspecs ^ @@ -1315,5 +1315,5 @@ let exe_function_call spec actual_params formal_params in - let results = IList.map exe_one_spec spec_list in + let results = List.map ~f:exe_one_spec spec_list in exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc results diff --git a/infer/src/backend/taint.ml b/infer/src/backend/taint.ml index c7e508d5b..e42ce65d5 100644 --- a/infer/src/backend/taint.ml +++ b/infer/src/backend/taint.ml @@ -267,7 +267,7 @@ let java_method_to_procname java_method = (Procname.split_classname java_method.classname) (Some (Procname.split_classname java_method.ret_type)) java_method.method_name - (IList.map Procname.split_classname java_method.params) + (List.map ~f:Procname.split_classname java_method.params) (if java_method.is_static then Procname.Static else Procname.Non_Static)) (* turn string specificiation of an objc method into a procname *) @@ -284,11 +284,11 @@ let taint_spec_to_taint_info taint_spec = { PredSymb.taint_source; taint_kind = taint_spec.taint_kind } let sources = - IList.map taint_spec_to_taint_info sources0 + List.map ~f:taint_spec_to_taint_info sources0 let mk_pname_param_num methods = - IList.map - (fun (mname, param_num) -> taint_spec_to_taint_info mname, param_num) + List.map + ~f:(fun (mname, param_num) -> taint_spec_to_taint_info mname, param_num) methods let taint_sinks = @@ -329,7 +329,7 @@ let accepts_sensitive_params callee_pname callee_attrs_opt = let _, param_annots = attrs_opt_get_annots callee_attrs_opt in let offset = if Procname.java_is_static callee_pname then 0 else 1 in let indices_and_annots = - IList.mapi (fun param_num attr -> param_num + offset, attr) param_annots in + List.mapi ~f:(fun param_num attr -> param_num + offset, attr) param_annots in let tag_tainted_indices acc (index, attr) = if Annotations.ia_is_integrity_sink attr then (index, PredSymb.Tk_privacy_annotation) :: acc @@ -338,14 +338,14 @@ let accepts_sensitive_params callee_pname callee_attrs_opt = else acc in 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 + List.map ~f:(fun param_num -> param_num, taint_info.PredSymb.taint_kind) tainted_param_indices (** returns list of zero-indexed parameter numbers of [callee_pname] that should be considered tainted during symbolic execution *) let tainted_params callee_pname = match find_callee func_with_tainted_params callee_pname with | Some (taint_info, tainted_param_indices) -> - IList.map (fun param_num -> param_num, taint_info.PredSymb.taint_kind) tainted_param_indices + List.map ~f:(fun param_num -> param_num, taint_info.PredSymb.taint_kind) tainted_param_indices | None -> [] let has_taint_annotation fieldname (struct_typ: StructTyp.t) = @@ -363,7 +363,7 @@ let get_params_to_taint tainted_param_nums formal_params = match get_taint_kind index with | 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 + let numbered_params = List.mapi ~f:(fun i param -> (i, param)) formal_params in List.fold ~f:collect_params_to_taint ~init:[] numbered_params (* add tainting attribute to a pvar in a prop *) diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index 37137ccc6..25819a3c7 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/infer/src/base/CommandLineOption.ml @@ -184,7 +184,7 @@ let pad_and_xform doc_width left_width desc = if String.length s > doc_width then wrap_line "" doc_width s else [s] in - IList.map wrap_line lines in + List.map ~f:wrap_line lines in let doc = indent_doc (String.concat ~sep:"\n" (List.concat wrapped_lines)) in xdesc {desc with doc} @@ -214,7 +214,7 @@ let align desc_list = let cols_after_min_width = float_of_int (max 0 (cur_term_width - min_term_width)) in min (int_of_float (cols_after_min_width *. multiplier) + min_left_width) opt_left_width in let doc_width = min max_doc_width (doc_width cur_term_width left_width) in - (IList.map (pad_and_xform doc_width left_width) desc_list, (doc_width, left_width)) + (List.map ~f:(pad_and_xform doc_width left_width) desc_list, (doc_width, left_width)) let check_no_duplicates desc_list = @@ -489,8 +489,8 @@ let mk_path_list ?(default=[]) ?(deprecated=[]) ~long ?short ?parse_mode ?(meta= ~default ~deprecated ~long ~short ~parse_mode ~meta let mk_symbol ~default ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = - let strings = IList.map fst symbols in - let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in + let strings = List.map ~f:fst symbols in + let sym_to_str = List.map ~f:(fun (x,y) -> (y,x)) symbols in let of_string str = IList.assoc String.equal str symbols in let to_string sym = IList.assoc eq sym sym_to_str in mk ~deprecated ~long ?short ~default ?parse_mode ~meta doc @@ -500,7 +500,7 @@ let mk_symbol ~default ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode ?( ~mk_spec:(fun set -> Symbol (strings, set)) let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = - let strings = IList.map fst symbols in + let strings = List.map ~f:fst symbols in let of_string str = IList.assoc String.equal str symbols in mk ~deprecated ~long ?short ~default:None ?parse_mode ~meta doc ~default_to_string:(fun _ -> "") @@ -510,13 +510,13 @@ let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") let mk_symbol_seq ?(default=[]) ~symbols ~eq ?(deprecated=[]) ~long ?short ?parse_mode ?(meta="") doc = - let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in + let sym_to_str = List.map ~f:(fun (x,y) -> (y,x)) symbols in let of_string str = IList.assoc String.equal str symbols in let to_string sym = IList.assoc eq sym sym_to_str in mk ~deprecated ~long ?short ~default ?parse_mode ~meta:(",-separated sequence" ^ meta) doc - ~default_to_string:(fun syms -> String.concat ~sep:" " (IList.map to_string syms)) + ~default_to_string:(fun syms -> String.concat ~sep:" " (List.map ~f:to_string syms)) ~mk_setter:(fun var str_seq -> - var := IList.map of_string (Str.split (Str.regexp_string ",") str_seq)) + var := List.map ~f:of_string (Str.split (Str.regexp_string ",") str_seq)) ~decode_json:(fun json -> [dashdash long; String.concat ~sep:"," (YBU.convert_each YBU.to_string json)]) diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index 489015858..c472214c1 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -30,7 +30,7 @@ let exes = [ ] let exe_name = - let exe_to_name = IList.map (fun (n,a) -> (a,n)) exes in + let exe_to_name = List.map ~f:(fun (n,a) -> (a,n)) exes in fun exe -> IList.assoc equal_exe exe exe_to_name let frontend_parse_modes = CLOpt.(Infer [Clang]) @@ -445,7 +445,7 @@ and ( let mk_option analyzer_name = let long = Printf.sprintf "%s-%s" analyzer_name suffix in let deprecated = - IList.map (Printf.sprintf "%s_%s" analyzer_name) deprecated_suffix in + List.map ~f:(Printf.sprintf "%s_%s" analyzer_name) deprecated_suffix in (* empty doc to hide the options from --help since there are many redundant ones *) CLOpt.mk_string_list ~deprecated ~long ~meta "" in ignore ( @@ -454,7 +454,7 @@ and ( ~parse_mode:CLOpt.(Infer [Driver;Print]) help ); - IList.map (fun (name, analyzer) -> (analyzer, mk_option name)) string_to_analyzer in + List.map ~f:(fun (name, analyzer) -> (analyzer, mk_option name)) string_to_analyzer in ( mk_filtering_options ~suffix:"blacklist-files-containing" @@ -1383,7 +1383,7 @@ let post_parsing_initialization () = let analyzer_name = IList.assoc equal_analyzer (match !analyzer with Some a -> a | None -> Infer) - (IList.map (fun (n,a) -> (a,n)) string_to_analyzer) in + (List.map ~f:(fun (n,a) -> (a,n)) string_to_analyzer) in let infer_version = Version.commit in F.eprintf "%s/%s/%s@." javac_version analyzer_name infer_version | `Javac -> @@ -1453,13 +1453,13 @@ and abs_struct = !abs_struct and abs_val_orig = !abs_val and allow_specs_cleanup = !allow_specs_cleanup and analysis_path_regex_whitelist_options = - IList.map (fun (a, b) -> (a, !b)) analysis_path_regex_whitelist_options + List.map ~f:(fun (a, b) -> (a, !b)) analysis_path_regex_whitelist_options and analysis_path_regex_blacklist_options = - IList.map (fun (a, b) -> (a, !b)) analysis_path_regex_blacklist_options + List.map ~f:(fun (a, b) -> (a, !b)) analysis_path_regex_blacklist_options and analysis_blacklist_files_containing_options = - IList.map (fun (a, b) -> (a, !b)) analysis_blacklist_files_containing_options + List.map ~f:(fun (a, b) -> (a, !b)) analysis_blacklist_files_containing_options and analysis_suppress_errors_options = - IList.map (fun (a, b) -> (a, !b)) analysis_suppress_errors_options + List.map ~f:(fun (a, b) -> (a, !b)) analysis_suppress_errors_options and analysis_stops = !analysis_stops and angelic_execution = !angelic_execution and annotation_reachability = !annotation_reachability diff --git a/infer/src/base/IList.ml b/infer/src/base/IList.ml index bdfbe9979..5de711745 100644 --- a/infer/src/base/IList.ml +++ b/infer/src/base/IList.ml @@ -7,14 +7,9 @@ * of patent rights can be found in the PATENTS file in the same directory. *) -let exists = List.exists -let fold_left = List.fold_left -let length = List.length -let nth = List.nth let partition = List.partition let rev = List.rev let rev_append = List.rev_append -let rev_map = List.rev_map let sort = List.sort let stable_sort = List.stable_sort @@ -23,10 +18,6 @@ let rec last = function | [x] -> Some x | _ :: xs -> last xs -let flatten_options list = - fold_left (fun list -> function | Some x -> x:: list | None -> list) [] list - |> rev - let rec drop_first n = function | xs when n == 0 -> xs | _ :: xs -> drop_first (n - 1) xs @@ -35,14 +26,10 @@ let rec drop_first n = function let drop_last n list = rev (drop_first n (rev list)) -(** tail-recursive variant of List.map *) -let map f l = - rev (rev_map f l) - (** like map, but returns the original list if unchanged *) let map_changed (f : 'a -> 'a) l = let l', changed = - fold_left + List.fold_left (fun (l_acc, changed) e -> let e' = f e in e' :: l_acc, changed || e' != e) @@ -55,7 +42,7 @@ let map_changed (f : 'a -> 'a) l = (** like filter, but returns the original list if unchanged *) let filter_changed (f : 'a -> bool) l = let l', changed = - fold_left + List.fold_left (fun (l_acc, changed) e -> if f e then e :: l_acc, changed @@ -66,15 +53,6 @@ let filter_changed (f : 'a -> bool) l = then rev l' else l -(** tail-recursive variant of List.mapi *) -let mapi f l = - let i = ref 0 in - rev (rev_map - (fun x -> - incr i; - f (!i - 1) x) - l) - (** Remove consecutive equal elements from a list (according to the given comparison functions) *) let remove_duplicates compare l = let rec remove compare acc = function @@ -147,19 +125,6 @@ let inter compare xs ys = in inter_ [] rev_xs rev_ys -exception Fail - -(** Apply [f] to pairs of elements; raise [Fail] if the two lists have different lenghts. *) -let map2 f l1 l2 = - let rec go l1 l2 acc = - match l1, l2 with - | [],[] -> rev acc - | x1 :: l1', x2 :: l2' -> - let x' = f x1 x2 in - go l1' l2' (x':: acc) - | _ -> raise Fail in - go l1 l2 [] - (** Return the first non-None result found when applying f to elements of l *) let rec find_map_opt f = function | [] -> None @@ -179,7 +144,7 @@ let to_string f l = (** Like List.mem_assoc but without builtin equality *) let mem_assoc equal a l = - exists (fun x -> equal a (fst x)) l + List.exists (fun x -> equal a (fst x)) l (** Like List.assoc but without builtin equality *) let assoc equal a l = diff --git a/infer/src/base/IList.mli b/infer/src/base/IList.mli index 62ffc3b1c..9b55e0c33 100644 --- a/infer/src/base/IList.mli +++ b/infer/src/base/IList.mli @@ -7,28 +7,15 @@ * of patent rights can be found in the PATENTS file in the same directory. *) -(** Remove all None elements from the list. *) -val flatten_options : ('a option) list -> 'a list - -val length : 'a list -> int - -(** tail-recursive variant of List.map *) -val map : ('a -> 'b) -> 'a list -> 'b list - (** like map, but returns the original list if unchanged *) val map_changed : ('a -> 'a) -> 'a list -> 'a list (** like filter, but returns the original list if unchanged *) val filter_changed : ('a -> bool) -> 'a list -> 'a list -(** tail-recursive variant of List.mapi *) -val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list - -val nth : 'a list -> int -> 'a val partition : ('a -> bool) -> 'a list -> 'a list * 'a list val rev : 'a list -> 'a list val rev_append : 'a list -> 'a list -> 'a list -val rev_map : ('a -> 'b) -> 'a list -> 'b list val sort : ('a -> 'a -> int) -> 'a list -> 'a list val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list @@ -64,11 +51,6 @@ val mem_assoc : ('a -> 'a -> bool) -> 'a -> ('a * 'b) list -> bool (** Like List.assoc but without builtin equality *) val assoc : ('a -> 'a -> bool) -> 'a -> ('a * 'b) list -> 'b -exception Fail - -(** Apply [f] to pairs of elements; raise [Fail] if the two lists have different lenghts. *) -val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list - (** Return the first non-None result found when applying f to elements of l *) val find_map_opt : ('a -> 'b option) -> 'a list -> 'b option diff --git a/infer/src/base/SourceFile.ml b/infer/src/base/SourceFile.ml index 17aa45ed1..2e4bca314 100644 --- a/infer/src/base/SourceFile.ml +++ b/infer/src/base/SourceFile.ml @@ -127,7 +127,7 @@ let of_header header_file = let file_no_ext, ext_opt = Filename.split_extension abs_path in let file_opt = match ext_opt with | Some ext when List.mem ~equal:String.equal header_exts ext -> ( - let possible_files = IList.map (fun ext -> file_no_ext ^ "." ^ ext) source_exts in + let possible_files = List.map ~f:(fun ext -> file_no_ext ^ "." ^ ext) source_exts in List.find ~f:path_exists possible_files ) | _ -> None in diff --git a/infer/src/base/StatisticsToolbox.re b/infer/src/base/StatisticsToolbox.re index 5b322cd26..c73d49f6e 100644 --- a/infer/src/base/StatisticsToolbox.re +++ b/infer/src/base/StatisticsToolbox.re @@ -46,7 +46,7 @@ let from_json json => { }; let compute_statistics values => { - let num_elements = IList.length values; + let num_elements = List.length 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; diff --git a/infer/src/bufferoverrun/arrayBlk.ml b/infer/src/bufferoverrun/arrayBlk.ml index 551026858..66cc9ea6f 100644 --- a/infer/src/bufferoverrun/arrayBlk.ml +++ b/infer/src/bufferoverrun/arrayBlk.ml @@ -176,7 +176,7 @@ let subst : astate -> Itv.Bound.t Itv.SubstMap.t -> astate let get_symbols : astate -> Itv.Symbol.t list = fun a -> - List.concat (IList.map (fun (_, ai) -> ArrInfo.get_symbols ai) (bindings a)) + List.concat_map ~f:(fun (_, ai) -> ArrInfo.get_symbols ai) (bindings a) let normalize : astate -> astate = fun a -> map ArrInfo.normalize a diff --git a/infer/src/bufferoverrun/bufferOverrunChecker.ml b/infer/src/bufferoverrun/bufferOverrunChecker.ml index cf00e0cf8..9c5010813 100644 --- a/infer/src/bufferoverrun/bufferOverrunChecker.ml +++ b/infer/src/bufferoverrun/bufferOverrunChecker.ml @@ -380,7 +380,7 @@ struct : extras ProcData.t -> Analyzer.invariant_map -> Dom.ConditionSet.t -> CFG.node -> Dom.ConditionSet.t = fun pdata inv_map cond_set node -> - let instrs = CFG.instr_ids node |> IList.map fst in + let instrs = CFG.instr_ids node |> List.map ~f:fst in match Analyzer.extract_pre (CFG.id node) inv_map with | Some mem -> collect_instrs pdata node instrs mem cond_set | _ -> cond_set diff --git a/infer/src/bufferoverrun/bufferOverrunDomain.ml b/infer/src/bufferoverrun/bufferOverrunDomain.ml index ed3f6a9e9..8fda74239 100644 --- a/infer/src/bufferoverrun/bufferOverrunDomain.ml +++ b/infer/src/bufferoverrun/bufferOverrunDomain.ml @@ -491,7 +491,7 @@ struct let get_symbols : astate -> Itv.Symbol.t list = fun mem -> - List.concat (IList.map (fun (_, v) -> Val.get_symbols v) (bindings mem)) + List.concat_map ~f:(fun (_, v) -> Val.get_symbols v) (bindings mem) let get_return : astate -> Val.t = fun mem -> diff --git a/infer/src/bufferoverrun/bufferOverrunSemantics.ml b/infer/src/bufferoverrun/bufferOverrunSemantics.ml index 9ae5e59c8..af4c7bdcc 100644 --- a/infer/src/bufferoverrun/bufferOverrunSemantics.ml +++ b/infer/src/bufferoverrun/bufferOverrunSemantics.ml @@ -259,7 +259,7 @@ struct = fun pdesc -> let proc_name = Procdesc.get_proc_name pdesc in Procdesc.get_formals pdesc - |> IList.map (fun (name, typ) -> (Pvar.mk name proc_name, typ)) + |> List.map ~f:(fun (name, typ) -> (Pvar.mk name proc_name, typ)) let get_matching_pairs : Tenv.t -> Val.t -> Val.t -> Typ.t -> Mem.astate -> Mem.astate @@ -298,7 +298,7 @@ struct | Typ.Tptr (Typ.Tstruct typename, _) -> (match Tenv.lookup tenv typename with | Some str -> - let fns = IList.map get_field_name str.StructTyp.fields in + let fns = List.map ~f:get_field_name str.StructTyp.fields in List.fold ~f:(add_pair_field v1 v2) ~init:pairs fns | _ -> pairs) | Typ.Tptr (_ ,_) -> @@ -344,7 +344,7 @@ struct List.append new_matching l in let formals = get_formals callee_pdesc in - let actuals = IList.map (fun (a, _) -> eval a caller_mem loc) params in + let actuals = List.map ~f:(fun (a, _) -> eval a caller_mem loc) params in list_fold2_def Val.bot add_pair formals actuals [] |> subst_map_of_pairs end diff --git a/infer/src/bufferoverrun/itv.ml b/infer/src/bufferoverrun/itv.ml index dd2cf81c8..ce43e1783 100644 --- a/infer/src/bufferoverrun/itv.ml +++ b/infer/src/bufferoverrun/itv.ml @@ -10,6 +10,7 @@ * of patent rights can be found in the PATENTS file in the same directory. *) +open! IStd module F = Format module L = Logging @@ -19,8 +20,7 @@ module Symbol = struct type t = Procname.t * int [@@deriving compare] - let eq : t -> t -> bool - = fun x y -> compare x y = 0 + let eq = [%compare.equal : t] let get_new : Procname.t -> t = fun pname -> @@ -39,11 +39,11 @@ struct F.fprintf fmt "%s-s$%d" (fst x |> Procname.to_string) (snd x) end -module SubstMap = Map.Make (Symbol) +module SubstMap = Caml.Map.Make (Symbol) module SymLinear = struct - module M = Map.Make (Symbol) + module M = Caml.Map.Make (Symbol) type t = int M.t [@@deriving compare] @@ -87,8 +87,8 @@ struct let pp1 : F.formatter -> (Symbol.t * int) -> unit = fun fmt (s, c) -> - if c = 0 then () - else if c = 1 then + if Int.equal c 0 then () + else if Int.equal c 1 then F.fprintf fmt "%a" Symbol.pp s else if c < 0 then F.fprintf fmt "(%d)x%a" c Symbol.pp s @@ -97,7 +97,7 @@ struct let pp : F.formatter -> t -> unit = fun fmt x -> - if M.cardinal x = 0 then F.fprintf fmt "empty" else + if M.is_empty x then F.fprintf fmt "empty" else let (s1, c1) = M.min_binding x in pp1 fmt (s1, c1); M.iter (fun s c -> F.fprintf fmt " + %a" pp1 (s, c)) (M.remove s1 x) @@ -106,19 +106,19 @@ struct = M.empty let is_zero : t -> bool - = fun x -> M.for_all (fun _ v -> v = 0) x + = fun x -> M.for_all (fun _ v -> Int.equal v 0) x let is_mod_zero : t -> int -> bool = fun x n -> assert (n <> 0); - M.for_all (fun _ v -> v mod n = 0) x + M.for_all (fun _ v -> Int.equal (v mod n) 0) x let neg : t -> t = fun x -> M.map (~-) x (* Returns (Some n) only when n is not 0. *) let is_non_zero : int -> int option - = fun n -> if n = 0 then None else Some n + = fun n -> if Int.equal n 0 then None else Some n let plus : t -> t -> t = fun x y -> @@ -153,9 +153,9 @@ struct let one_symbol : t -> Symbol.t option = fun x -> let x = M.filter (fun _ v -> v <> 0) x in - if M.cardinal x = 1 then + if Int.equal (M.cardinal x) 1 then let (k, v) = M.choose x in - if v = 1 then Some k else None + if Int.equal v 1 then Some k else None else None let is_one_symbol : t -> bool @@ -165,7 +165,7 @@ struct | None -> false let get_symbols : t -> Symbol.t list - = fun x -> IList.map fst (M.bindings x) + = fun x -> List.map ~f:fst (M.bindings x) end module Bound = @@ -179,6 +179,8 @@ struct [@@deriving compare] and min_max_t = Min | Max +let equal = [%compare.equal : t] + let pp_min_max : F.formatter -> min_max_t -> unit = fun fmt -> function | Min -> F.fprintf fmt "min" @@ -193,7 +195,7 @@ let pp : F.formatter -> t -> unit | Linear (c, x) -> if SymLinear.le x SymLinear.empty then F.fprintf fmt "%d" c - else if c = 0 then + else if Int.equal c 0 then F.fprintf fmt "%a" SymLinear.pp x else F.fprintf fmt "%a + %d" SymLinear.pp x c @@ -221,12 +223,12 @@ let opt_lift : ('a -> 'b -> bool) -> 'a option -> 'b option -> bool let eq_symbol : Symbol.t -> t -> bool = fun s -> function | Linear (c, se) -> - c = 0 && opt_lift Symbol.eq (SymLinear.one_symbol se) (Some s) + Int.equal c 0 && opt_lift Symbol.eq (SymLinear.one_symbol se) (Some s) | _ -> false let one_symbol : t -> Symbol.t option = function - | Linear (c, se) when c = 0 -> SymLinear.one_symbol se + | Linear (c, se) when Int.equal c 0 -> SymLinear.one_symbol se | _ -> None let is_one_symbol : t -> bool @@ -288,10 +290,10 @@ let le : t -> t -> bool | MinMax (Max, c0, x0), MinMax (Max, c1, x1) -> c0 <= c1 && Symbol.eq x0 x1 | MinMax (Min, c0, x0), Linear (c1, x1) -> (c0 <= c1 && SymLinear.is_zero x1) - || (c1 = 0 && opt_lift Symbol.eq (SymLinear.one_symbol x1) (Some x0)) + || (Int.equal c1 0 && opt_lift Symbol.eq (SymLinear.one_symbol x1) (Some x0)) | Linear (c1, x1), MinMax (Max, c0, x0) -> (c1 <= c0 && SymLinear.is_zero x1) - || (c1 = 0 && opt_lift Symbol.eq (SymLinear.one_symbol x1) (Some x0)) + || (Int.equal c1 0 && opt_lift Symbol.eq (SymLinear.one_symbol x1) (Some x0)) | MinMax (Min, c0, x0), MinMax (Max, c1, x1) -> c0 <= c1 || Symbol.eq x0 x1 | _, _ -> false @@ -315,8 +317,8 @@ let gt : t -> t -> bool let eq : t -> t -> bool = fun x y -> - if x = Bot && y = Bot then true else - if x = Bot || y = Bot then false else + if equal x Bot && equal y Bot then true else + if equal x Bot || equal y Bot then false else le x y && le y x let min : t -> t -> t @@ -326,12 +328,12 @@ let min : t -> t -> t if le y x then y else match x, y with | Linear (c0, x0), Linear (c1, x1) - when SymLinear.is_zero x0 && c1 = 0 && SymLinear.is_one_symbol x1 -> + when SymLinear.is_zero x0 && Int.equal c1 0 && SymLinear.is_one_symbol x1 -> (match SymLinear.one_symbol x1 with | Some x' -> MinMax (Min, c0, x') | None -> assert false) | Linear (c0, x0), Linear (c1, x1) - when SymLinear.is_zero x1 && c0 = 0 && SymLinear.is_one_symbol x0 -> + when SymLinear.is_zero x1 && Int.equal c0 0 && SymLinear.is_one_symbol x0 -> (match SymLinear.one_symbol x0 with | Some x' -> MinMax (Min, c1, x') | None -> assert false) @@ -347,12 +349,12 @@ let max : t -> t -> t if le y x then x else match x, y with | Linear (c0, x0), Linear (c1, x1) - when SymLinear.is_zero x0 && c1 = 0 && SymLinear.is_one_symbol x1 -> + when SymLinear.is_zero x0 && Int.equal c1 0 && SymLinear.is_one_symbol x1 -> (match SymLinear.one_symbol x1 with | Some x' -> MinMax (Max, c0, x') | None -> assert false) | Linear (c0, x0), Linear (c1, x1) - when SymLinear.is_zero x1 && c0 = 0 && SymLinear.is_one_symbol x0 -> + when SymLinear.is_zero x1 && Int.equal c0 0 && SymLinear.is_one_symbol x0 -> (match SymLinear.one_symbol x0 with | Some x' -> MinMax (Max, c1, x') | None -> assert false) @@ -364,14 +366,14 @@ let max : t -> t -> t let widen_l : t -> t -> t = fun x y -> assert (x <> Bot && y <> Bot); - if x = PInf || y = PInf then failwith "Lower bound cannot be +oo." else + if equal x PInf || equal y PInf then failwith "Lower bound cannot be +oo." else if le x y then x else MInf let widen_u : t -> t -> t = fun x y -> assert (x <> Bot && y <> Bot); - if x = MInf || y = MInf then failwith "Upper bound cannot be -oo." else + if equal x MInf || equal y MInf then failwith "Upper bound cannot be -oo." else if le y x then x else PInf @@ -391,7 +393,7 @@ let is_zero : t -> bool = fun x -> assert (x <> Bot); match x with - | Linear (c, y) -> c = 0 && SymLinear.is_zero y + | Linear (c, y) -> Int.equal c 0 && SymLinear.is_zero y | _ -> false let is_const : t -> int option @@ -436,12 +438,12 @@ let mult_const : t -> int -> t option let div_const : t -> int -> t option = fun x n -> assert (x <> Bot); - if n = 0 then Some zero else + if Int.equal n 0 then Some zero else match x with | MInf -> Some (if n > 0 then MInf else PInf) | PInf -> Some (if n > 0 then PInf else MInf) | Linear (c, x') -> - if c mod n = 0 && SymLinear.is_mod_zero x' n then + if Int.equal (c mod n) 0 && SymLinear.is_mod_zero x' n then Some (Linear (c / n, SymLinear.div_const x' n)) else None | _ -> None @@ -459,12 +461,12 @@ let make_min_max : min_max_t -> t -> t -> t option assert (x <> Bot && y <> Bot); match x, y with | Linear (cx, x'), Linear (cy, y') - when cy = 0 && SymLinear.is_zero x' && SymLinear.is_one_symbol y' -> + when Int.equal cy 0 && SymLinear.is_zero x' && SymLinear.is_one_symbol y' -> (match SymLinear.one_symbol y' with | Some s -> Some (MinMax (m, cx, s)) | None -> None) | Linear (cx, x'), Linear (cy, y') - when cx = 0 && SymLinear.is_zero y' && SymLinear.is_one_symbol x' -> + when Int.equal cx 0 && SymLinear.is_zero y' && SymLinear.is_one_symbol x' -> (match SymLinear.one_symbol x' with | Some s -> Some (MinMax (m, cy, s)) | None -> None) @@ -579,7 +581,7 @@ struct let is_const : t -> int option = fun (l, u) -> match Bound.is_const l, Bound.is_const u with - | Some n, Some m when n = m -> Some n + | Some n, Some m when Int.equal n m -> Some n | _, _ -> None let is_symbolic : t -> bool @@ -587,8 +589,8 @@ struct let neg : t -> t = fun (l, u) -> - let l' = Option.default Bound.MInf (Bound.neg u) in - let u' = Option.default Bound.PInf (Bound.neg l) in + let l' = Option.value ~default:Bound.MInf (Bound.neg u) in + let u' = Option.value ~default:Bound.PInf (Bound.neg l) in (l', u') let lnot : t -> t @@ -605,14 +607,14 @@ struct let mult_const : t -> int -> t = fun (l, u) n -> - if n = 0 then zero else + if Int.equal n 0 then zero else if n > 0 then - let l' = Option.default Bound.MInf (Bound.mult_const l n) in - let u' = Option.default Bound.PInf (Bound.mult_const u n) in + let l' = Option.value ~default:Bound.MInf (Bound.mult_const l n) in + let u' = Option.value ~default:Bound.PInf (Bound.mult_const u n) in (l', u') else - let l' = Option.default Bound.MInf (Bound.mult_const u n) in - let u' = Option.default Bound.PInf (Bound.mult_const l n) in + let l' = Option.value ~default:Bound.MInf (Bound.mult_const u n) in + let u' = Option.value ~default:Bound.PInf (Bound.mult_const l n) in (l', u') (* Returns a correct value only when all coefficients are divided by @@ -621,12 +623,12 @@ struct = fun (l, u) n -> assert (n <> 0); if n > 0 then - let l' = Option.default Bound.MInf (Bound.div_const l n) in - let u' = Option.default Bound.PInf (Bound.div_const u n) in + let l' = Option.value ~default:Bound.MInf (Bound.div_const l n) in + let u' = Option.value ~default:Bound.PInf (Bound.div_const u n) in (l', u') else - let l' = Option.default Bound.MInf (Bound.div_const u n) in - let u' = Option.default Bound.PInf (Bound.div_const l n) in + let l' = Option.value ~default:Bound.MInf (Bound.div_const u n) in + let u' = Option.value ~default:Bound.PInf (Bound.div_const l n) in (l', u') let mult : t -> t -> t @@ -646,7 +648,7 @@ struct let mod_sem : t -> t -> t = fun x y -> match is_const x, is_const y with - | Some n, Some m -> if m = 0 then x else of_int (n mod m) + | Some n, Some m -> if Int.equal m 0 then x else of_int (n mod m) | _, Some m -> (Bound.of_int (-m), Bound.of_int m) | _, None -> top @@ -708,13 +710,13 @@ struct let invalid : t -> bool = fun (l, u) -> - l = Bound.Bot || u = Bound.Bot + Bound.equal l Bound.Bot || Bound.equal u Bound.Bot || Bound.eq l Bound.PInf || Bound.eq u Bound.MInf || Bound.lt u l let prune_le : t -> t -> t = fun x y -> match x, y with - | (l1, u1), (_, u2) when u1 = Bound.PInf -> (l1, u2) + | (l1, u1), (_, u2) when Bound.equal u1 Bound.PInf -> (l1, u2) | (l1, Bound.Linear (c1, s1)), (_, Bound.Linear (c2, s2)) when SymLinear.eq s1 s2 -> (l1, Bound.Linear (min c1 c2, s1)) @@ -741,7 +743,7 @@ struct let prune_ge : t -> t -> t = fun x y -> match x, y with - | (l1, u1), (l2, _) when l1 = Bound.MInf -> (l2, u1) + | (l1, u1), (l2, _) when Bound.equal l1 Bound.MInf -> (l2, u1) | (Bound.Linear (c1, s1), u1), (Bound.Linear (c2, s2), _) when SymLinear.eq s1 s2 -> (Bound.Linear (max c1 c2, s1), u1) @@ -816,7 +818,7 @@ struct let has_bnd_bot : t -> bool = fun (l, u) -> - l = Bound.Bot || u = Bound.Bot + Bound.equal l Bound.Bot || Bound.equal u Bound.Bot end include AbstractDomain.BottomLifted (ItvPure) @@ -831,6 +833,8 @@ let compare : t -> t -> int | _, Bottom -> 1 | NonBottom x, NonBottom y -> ItvPure.compare_astate x y +let equal = [%compare.equal : t] + let compare_astate = compare let bot : t @@ -853,7 +857,7 @@ let of_int : int -> astate = fun n -> NonBottom (ItvPure.of_int n) let is_bot : t -> bool - = fun x -> x = Bottom + = fun x -> equal x Bottom let is_finite : t -> bool = function diff --git a/infer/src/checkers/AbstractInterpreter.ml b/infer/src/checkers/AbstractInterpreter.ml index 24cef212b..568df121c 100644 --- a/infer/src/checkers/AbstractInterpreter.ml +++ b/infer/src/checkers/AbstractInterpreter.ml @@ -89,7 +89,7 @@ module MakeNoCFG then begin let str = - let instrs = IList.map fst instr_ids in + let instrs = List.map ~f:fst instr_ids in Format.asprintf "PRE: %a@.INSTRS: %aPOST: %a@." Domain.pp pre (Sil.pp_instr_list Pp.text) instrs Domain.pp astate_post in L.d_strln str @@ -118,12 +118,12 @@ module MakeNoCFG let compute_pre node inv_map = (* if the [pred] -> [node] transition was normal, use post([pred]) *) let extract_post_ pred = extract_post (CFG.id pred) inv_map in - let normal_posts = IList.map extract_post_ (CFG.normal_preds cfg node) in + let normal_posts = List.map ~f: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 = List.fold ~f:extract_pre_f ~init:normal_posts (CFG.exceptional_preds cfg node) in - match IList.flatten_options all_posts with + match List.filter_opt all_posts with | post :: posts -> Some (List.fold ~f:Domain.join ~init:post posts) | [] -> None in match Scheduler.pop work_queue with diff --git a/infer/src/checkers/BoundedCallTree.ml b/infer/src/checkers/BoundedCallTree.ml index 3415e08a0..40980d78a 100644 --- a/infer/src/checkers/BoundedCallTree.ml +++ b/infer/src/checkers/BoundedCallTree.ml @@ -75,18 +75,18 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let stacktree_of_astate pdesc astate loc location_type get_proc_desc = let procs = Domain.elements astate in - let callees = IList.map - (fun pn -> - match SpecSummary.read_summary pdesc pn with - | None | Some None -> (match get_proc_desc pn with - | None -> stacktree_stub_of_procname pn - (* This can happen when the callee is in the same cluster/ buck - target, but it hasn't been checked yet. So we need both the - inter-target lookup (SpecSummary) and the intra-target - lookup (using get_proc_desc). *) - | Some callee_pdesc -> - stacktree_of_pdesc callee_pdesc "proc_start") - | Some (Some stracktree) -> stracktree ) + let callees = List.map + ~f:(fun pn -> + match SpecSummary.read_summary pdesc pn with + | None | Some None -> (match get_proc_desc pn with + | None -> stacktree_stub_of_procname pn + (* This can happen when the callee is in the same cluster/ buck + target, but it hasn't been checked yet. So we need both the + inter-target lookup (SpecSummary) and the intra-target + lookup (using get_proc_desc). *) + | Some callee_pdesc -> + stacktree_of_pdesc callee_pdesc "proc_start") + | Some (Some stracktree) -> stracktree ) procs in stacktree_of_pdesc pdesc ~loc ~callees location_type @@ -123,7 +123,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct String.equal frame.Stacktrace.method_str (Procname.get_method caller) && matches_class caller in let all_frames = List.concat - (IList.map (fun trace -> trace.Stacktrace.frames) traces) in + (List.map ~f:(fun trace -> trace.Stacktrace.frames) traces) in begin match List.find ~f:matches_proc all_frames with | Some frame -> @@ -161,7 +161,7 @@ let loaded_stacktraces = | Some fname, Some dir -> Some (fname :: (json_files_in_dir dir)) in match filenames with | None -> None - | Some files -> Some (IList.map Stacktrace.of_json_file files) + | Some files -> Some (List.map ~f:Stacktrace.of_json_file files) let checker { Callbacks.proc_desc; tenv; get_proc_desc; } = match loaded_stacktraces with diff --git a/infer/src/checkers/FormalMap.ml b/infer/src/checkers/FormalMap.ml index 86733e3c4..d7ebbd9c2 100644 --- a/infer/src/checkers/FormalMap.ml +++ b/infer/src/checkers/FormalMap.ml @@ -18,8 +18,8 @@ let make pdesc = let pname = Procdesc.get_proc_name pdesc in let attrs = Procdesc.get_attributes pdesc in let formals_with_nums = - IList.mapi - (fun index (name, typ) -> + List.mapi + ~f:(fun index (name, typ) -> let pvar = Pvar.mk name pname in AccessPath.base_of_pvar pvar typ, index) attrs.ProcAttributes.formals in diff --git a/infer/src/checkers/Sink.ml b/infer/src/checkers/Sink.ml index 32d38b60d..39cf5606a 100644 --- a/infer/src/checkers/Sink.ml +++ b/infer/src/checkers/Sink.ml @@ -72,8 +72,8 @@ module Make (Kind : Kind) = struct { sink; index; report_reachable; } let get site actuals tenv = - IList.map - (fun (kind, index, report_reachable) -> + List.map + ~f:(fun (kind, index, report_reachable) -> make_sink_param (make kind site) index ~report_reachable) (Kind.get (CallSite.pname site) actuals tenv) diff --git a/infer/src/checkers/SinkTrace.ml b/infer/src/checkers/SinkTrace.ml index 2c98ee41c..909f0a645 100644 --- a/infer/src/checkers/SinkTrace.ml +++ b/infer/src/checkers/SinkTrace.ml @@ -51,8 +51,8 @@ module Make (TraceElem : TraceElem.S) = struct of_source dummy_source let get_reportable_sink_paths t ~trace_of_pname = - IList.map - (fun (passthroughs, _, sinks) -> passthroughs, sinks) + List.map + ~f:(fun (passthroughs, _, sinks) -> passthroughs, sinks) (get_reportable_paths t ~trace_of_pname) let to_sink_loc_trace ?desc_of_sink ?sink_should_nest (passthroughs, sinks) = diff --git a/infer/src/checkers/Siof.ml b/infer/src/checkers/Siof.ml index f91847b63..7c23935a8 100644 --- a/infer/src/checkers/Siof.ml +++ b/infer/src/checkers/Siof.ml @@ -79,7 +79,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct && not (is_compile_time_constructed pdesc pv) in let globals_accesses = Exp.get_vars e |> snd |> List.filter ~f:is_dangerous_global - |> IList.map (fun v -> (v, loc)) in + |> List.map ~f:(fun v -> (v, loc)) in GlobalsAccesses.of_list globals_accesses let filter_global_accesses initialized globals = @@ -108,7 +108,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct (Domain.BottomSiofTrace.NonBottom globals_trace, snd astate) let add_params_globals astate pdesc call_loc params = - IList.map (fun (e, _) -> get_globals pdesc call_loc e) params + List.map ~f:(fun (e, _) -> get_globals pdesc call_loc e) params |> List.fold ~f:GlobalsAccesses.union ~init:GlobalsAccesses.empty |> add_globals astate (Procdesc.get_loc pdesc) diff --git a/infer/src/checkers/SiofDomain.ml b/infer/src/checkers/SiofDomain.ml index e641fb07c..f3f83a696 100644 --- a/infer/src/checkers/SiofDomain.ml +++ b/infer/src/checkers/SiofDomain.ml @@ -30,7 +30,7 @@ let normalize ((trace, initialized) as astate) = match trace with procdesc. Use the loc of the first access. *) let loc = CallSite.loc (SiofTrace.Sink.call_site access) in let kind = - IList.map SiofTrace.Sink.kind direct + List.map ~f:SiofTrace.Sink.kind direct |> List.fold ~f:SiofTrace.GlobalsAccesses.union ~init:SiofTrace.GlobalsAccesses.empty in diff --git a/infer/src/checkers/Source.ml b/infer/src/checkers/Source.ml index c05cb727a..4225d7cfb 100644 --- a/infer/src/checkers/Source.ml +++ b/infer/src/checkers/Source.ml @@ -14,7 +14,7 @@ module F = Format let all_formals_untainted pdesc = let make_untainted (name, typ) = name, typ, None in - IList.map make_untainted (Procdesc.get_formals pdesc) + List.map ~f:make_untainted (Procdesc.get_formals pdesc) module type Kind = sig include TraceElem.Kind @@ -86,8 +86,9 @@ module Make (Kind : Kind) = struct let get_tainted_formals pdesc tenv = let site = CallSite.make (Procdesc.get_proc_name pdesc) (Procdesc.get_loc pdesc) in - IList.map - (fun (name, typ, kind_opt) -> name, typ, Option.map kind_opt ~f:(fun kind -> make kind site)) + List.map + ~f:(fun (name, typ, kind_opt) -> + name, typ, Option.map kind_opt ~f:(fun kind -> make kind site)) (Kind.get_tainted_formals pdesc tenv) let with_callsite t callee_site = @@ -122,7 +123,7 @@ module Dummy = struct let get _ _ = None let get_tainted_formals pdesc _= - IList.map (fun (name, typ) -> name, typ, None) (Procdesc.get_formals pdesc) + List.map ~f:(fun (name, typ) -> name, typ, None) (Procdesc.get_formals pdesc) module Kind = struct type nonrec t = t diff --git a/infer/src/checkers/Stacktrace.ml b/infer/src/checkers/Stacktrace.ml index 53b9439ba..1f70880ea 100644 --- a/infer/src/checkers/Stacktrace.ml +++ b/infer/src/checkers/Stacktrace.ml @@ -84,7 +84,7 @@ let of_string s = match lines with | exception_line :: trace -> let exception_name = parse_exception_line exception_line in - let parsed = IList.map parse_stack_frame trace in + let parsed = List.map ~f:parse_stack_frame trace in make exception_name parsed | [] -> failwith "Empty stack trace" @@ -99,10 +99,10 @@ let of_json filename json = Yojson.Basic.Util.to_string (extract_json_member exception_name_key) in let frames = Yojson.Basic.Util.to_list (extract_json_member frames_key) - |> IList.map Yojson.Basic.Util.to_string - |> IList.map String.strip + |> List.map ~f:Yojson.Basic.Util.to_string + |> List.map ~f:String.strip |> List.filter ~f:(fun s -> s <> "") - |> IList.map parse_stack_frame in + |> List.map ~f:parse_stack_frame in make exception_name frames let of_json_file filename = diff --git a/infer/src/checkers/Trace.ml b/infer/src/checkers/Trace.ml index 16f47ccbd..8d33d87ff 100644 --- a/infer/src/checkers/Trace.ml +++ b/infer/src/checkers/Trace.ml @@ -257,13 +257,13 @@ module Make (Spec : Spec) = struct sink ~elems_passthroughs_of_pname:sinks_of_pname ~filter_passthroughs in sources_passthroughs, sinks_passthroughs in - IList.map - (fun (source, sink, passthroughs) -> - let sources_passthroughs, sinks_passthroughs = expand_path source sink in - let filtered_passthroughs = - filter_passthroughs_ - Top_level (Source.call_site source) (Sink.call_site sink) passthroughs in - filtered_passthroughs, sources_passthroughs, sinks_passthroughs) + List.map + ~f:(fun (source, sink, passthroughs) -> + let sources_passthroughs, sinks_passthroughs = expand_path source sink in + let filtered_passthroughs = + filter_passthroughs_ + Top_level (Source.call_site source) (Sink.call_site sink) passthroughs in + filtered_passthroughs, sources_passthroughs, sinks_passthroughs) (get_reports ?cur_site t) let to_loc_trace @@ -298,7 +298,7 @@ module Make (Spec : Spec) = struct if should_nest elem then incr level; pair, !level in - IList.map get_nesting_ (IList.rev elems) in + List.map ~f:get_nesting_ (IList.rev elems) in let trace_elems_of_path_elem call_site desc ~is_source ((elem, passthroughs), lt_level) acc = let desc = desc elem in @@ -353,8 +353,8 @@ module Make (Spec : Spec) = struct then caller_trace.sources else - IList.map - (fun sink -> Source.with_callsite sink callee_site) + List.map + ~f:(fun sink -> Source.with_callsite sink callee_site) (Sources.elements non_footprint_callee_sources) |> Sources.of_list |> Sources.union caller_trace.sources in @@ -364,8 +364,8 @@ module Make (Spec : Spec) = struct then caller_trace.sinks else - IList.map - (fun sink -> Sink.with_callsite sink callee_site) + List.map + ~f:(fun sink -> Sink.with_callsite sink callee_site) (Sinks.elements callee_trace.sinks) |> Sinks.of_list |> Sinks.union caller_trace.sinks in diff --git a/infer/src/checkers/annotationReachability.ml b/infer/src/checkers/annotationReachability.ml index b8df9b5c6..309ba32d5 100644 --- a/infer/src/checkers/annotationReachability.ml +++ b/infer/src/checkers/annotationReachability.ml @@ -38,9 +38,9 @@ let src_snk_pairs () = ([Annotations.any_thread; Annotations.for_non_ui_thread], Annotations.ui_thread) :: ([Annotations.ui_thread; Annotations.for_ui_thread], Annotations.for_non_ui_thread) :: (parse_user_defined_specs Config.annotation_reachability) in - IList.map - (fun (src_annot_str_list, snk_annot_str) -> - IList.map annotation_of_str src_annot_str_list, annotation_of_str snk_annot_str) + List.map + ~f:(fun (src_annot_str_list, snk_annot_str) -> + List.map ~f:annotation_of_str src_annot_str_list, annotation_of_str snk_annot_str) specs module Domain = struct @@ -385,7 +385,7 @@ module Interprocedural = struct (CallSite.make proc_name loc) calls in let calls = extract_calls_with_annot snk_annot call_map in - if not (Int.equal (IList.length calls) 0) + if not (Int.equal (List.length calls) 0) then List.iter ~f:(report_src_snk_path calls) src_annot_list in let initial = diff --git a/infer/src/checkers/checkDeadCode.ml b/infer/src/checkers/checkDeadCode.ml index cdd657cd3..256559c93 100644 --- a/infer/src/checkers/checkDeadCode.ml +++ b/infer/src/checkers/checkDeadCode.ml @@ -69,7 +69,7 @@ let report_error tenv description pn pd loc = (** Check the final state at the end of the analysis. *) let check_final_state tenv proc_name proc_desc final_s = let proc_nodes = Procdesc.get_nodes proc_desc in - let tot_nodes = IList.length proc_nodes in + let tot_nodes = List.length proc_nodes in let tot_visited = State.num_visited final_s in if verbose then L.stderr "TOT nodes: %d (visited: %n)@." tot_nodes tot_visited; if tot_nodes <> tot_visited then diff --git a/infer/src/checkers/checkTraceCallSequence.ml b/infer/src/checkers/checkTraceCallSequence.ml index 956adb92f..134d8b92d 100644 --- a/infer/src/checkers/checkTraceCallSequence.ml +++ b/infer/src/checkers/checkTraceCallSequence.ml @@ -122,7 +122,7 @@ module State = struct (** Map a function to the elements of the set, and filter out inconsistencies. *) 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 + let l' = List.filter ~f:Elem.is_consistent (List.concat_map ~f:f l) in List.fold_right ~f:ElemSet.add l' ~init:ElemSet.empty let map (f : Elem.t -> Elem.t) s = diff --git a/infer/src/checkers/checkers.ml b/infer/src/checkers/checkers.ml index a878ca17b..2ab812093 100644 --- a/infer/src/checkers/checkers.ml +++ b/infer/src/checkers/checkers.ml @@ -260,11 +260,11 @@ let callback_check_write_to_parcel_java | _ -> assert false in let r_call_descs = - IList.map node_to_call_desc + List.map ~f:node_to_call_desc (List.filter ~f:is_serialization_node (Procdesc.get_sliced_slope r_desc is_serialization_node)) in let w_call_descs = - IList.map node_to_call_desc + List.map ~f:node_to_call_desc (List.filter ~f:is_serialization_node (Procdesc.get_sliced_slope w_desc is_serialization_node)) in @@ -333,7 +333,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } = | Typ.Tptr (Typ.Tstruct _, _) -> true | _ -> false in List.filter ~f:is_class_type formals in - IList.map fst class_formals) in + List.map ~f:fst class_formals) in let equal_formal_param exp formal_name = match exp with | Exp.Lvar pvar -> let name = Pvar.get_name pvar in @@ -363,7 +363,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } = let summary_checks_of_formals () = let formal_names = Lazy.force class_formal_names in let nchecks = Exp.Set.cardinal !checks_to_formals in - let nformals = IList.length formal_names in + let nformals = List.length formal_names in if (nchecks > 0 && nchecks < nformals) then begin let was_not_found formal_name = @@ -427,7 +427,7 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p (fun n -> Procdesc.Node.get_sliced_preds n has_instr) in let instrs = List.concat - (IList.map (fun n -> IList.rev (Procdesc.Node.get_instrs n)) preds) in + (List.map ~f:(fun n -> IList.rev (Procdesc.Node.get_instrs n)) preds) in List.find ~f instrs in let get_return_const proc_name' = @@ -471,7 +471,7 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p | _ -> "?") | _ -> "?" in let arg_name (exp, _) = find_const exp in - Some (IList.map arg_name args) + Some (List.map ~f:arg_name args) with _ -> None) | _ -> None in diff --git a/infer/src/checkers/liveness.ml b/infer/src/checkers/liveness.ml index 6892adced..fff657eac 100644 --- a/infer/src/checkers/liveness.ml +++ b/infer/src/checkers/liveness.ml @@ -55,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 - |> (fun x -> List.fold_right ~f:exp_add_live (IList.map fst params) ~init:x) + |> (fun x -> List.fold_right ~f:exp_add_live (List.map ~f:fst params) ~init:x) | Sil.Declare_locals _ | Remove_temps _ | Abstract _ | Nullify _ -> astate end diff --git a/infer/src/checkers/patternMatch.ml b/infer/src/checkers/patternMatch.ml index af7ce3f63..91835af30 100644 --- a/infer/src/checkers/patternMatch.ml +++ b/infer/src/checkers/patternMatch.ml @@ -210,7 +210,7 @@ let get_vararg_type_names tenv let has_formal_proc_argument_type_names proc_desc argument_type_names = let formals = Procdesc.get_formals proc_desc in let equal_formal_arg (_, typ) arg_type_name = String.equal (get_type_name typ) arg_type_name in - Int.equal (IList.length formals) (IList.length argument_type_names) + Int.equal (List.length formals) (List.length argument_type_names) && List.for_all2_exn ~f:equal_formal_arg formals argument_type_names let has_formal_method_argument_type_names cfg pname_java argument_type_names = @@ -235,7 +235,7 @@ let get_java_method_call_formal_signature = function | Sil.Call (_, Exp.Const (Const.Cfun pn), (_, tt):: args, _, _) -> (match pn with | Procname.Java pn_java -> - let arg_names = IList.map (function | _, t -> get_type_name t) args in + let arg_names = List.map ~f:(function | _, t -> get_type_name t) args in let rt_name = Procname.java_get_return_type pn_java in let m_name = Procname.java_get_method pn_java in Some (get_type_name tt, m_name, arg_names, rt_name) @@ -252,8 +252,8 @@ let type_is_class typ = | _ -> false let initializer_classes = - IList.map - (fun name -> Typename.TN_csu (Csu.Class Csu.Java, Mangled.from_string name)) + List.map + ~f:(fun name -> Typename.TN_csu (Csu.Class Csu.Java, Mangled.from_string name)) [ "android.app.Activity"; "android.app.Application"; @@ -410,7 +410,7 @@ let rec find_superclasses_with_attributes check tenv tname = match Tenv.lookup tenv tname with | Some (struct_typ) -> let result_from_supers = List.concat - (IList.map (find_superclasses_with_attributes check tenv) struct_typ.supers) + (List.map ~f:(find_superclasses_with_attributes check tenv) struct_typ.supers) in if check struct_typ.annots then tname ::result_from_supers diff --git a/infer/src/checkers/printfArgs.ml b/infer/src/checkers/printfArgs.ml index 3bcf38ea4..fd4cb8fa7 100644 --- a/infer/src/checkers/printfArgs.ml +++ b/infer/src/checkers/printfArgs.ml @@ -84,15 +84,15 @@ let format_arguments (printf: printf_signature) (args: (Exp.t * Typ.t) list): (string option * (Exp.t list) * (Exp.t option)) = - let format_string = match IList.nth args printf.format_pos with + let format_string = match List.nth_exn args printf.format_pos with | Exp.Const (Const.Cstr fmt), _ -> Some fmt | _ -> None in - let fixed_nvars = IList.map - (fun i -> fst (IList.nth args i)) + let fixed_nvars = List.map + ~f:(fun i -> fst (List.nth_exn args i)) printf.fixed_pos in let varargs_nvar = match printf.vararg_pos with - | Some pos -> Some (fst (IList.nth args pos)) + | Some pos -> Some (fst (List.nth_exn args pos)) | None -> None in format_string, fixed_nvars, varargs_nvar @@ -178,7 +178,7 @@ let check_printf_args_ok tenv try let fmt, fixed_nvars, array_nvar = format_arguments printf args in let instrs = Procdesc.Node.get_instrs node in - let fixed_nvar_type_names = IList.map (fixed_nvar_type_name instrs) fixed_nvars in + let fixed_nvar_type_names = List.map ~f:(fixed_nvar_type_name instrs) fixed_nvars in let vararg_ivar_type_names = match array_nvar with | Some nvar -> ( let ivar = array_ivar instrs nvar in @@ -218,6 +218,6 @@ let printf_signature_to_string "{%s; %d [%s] %s}" printf.unique_id printf.format_pos - (String.concat ~sep:"," (IList.map string_of_int printf.fixed_pos)) + (String.concat ~sep:"," (List.map ~f:string_of_int printf.fixed_pos)) (match printf.vararg_pos with | Some i -> string_of_int i | _ -> "-") *) diff --git a/infer/src/checkers/procCfg.ml b/infer/src/checkers/procCfg.ml index 58d988dd2..406504c2c 100644 --- a/infer/src/checkers/procCfg.ml +++ b/infer/src/checkers/procCfg.ml @@ -120,7 +120,7 @@ module Normal = struct include (DefaultNode : module type of DefaultNode with type t := node) let instrs = Procdesc.Node.get_instrs - let instr_ids n = IList.map (fun i -> i, None) (instrs n) + let instr_ids n = List.map ~f:(fun i -> i, None) (instrs n) let normal_succs _ n = Procdesc.Node.get_succs n let normal_preds _ n = Procdesc.Node.get_preds n (* prune away exceptional control flow *) @@ -163,7 +163,7 @@ module Exceptional = struct let instrs = Procdesc.Node.get_instrs - let instr_ids n = IList.map (fun i -> i, None) (instrs n) + let instr_ids n = List.map ~f:(fun i -> i, None) (instrs n) let nodes (t, _) = Procdesc.get_nodes t @@ -229,8 +229,8 @@ module OneInstrPerNode (Base : S with type node = Procdesc.Node.t (* keep the invariants before/after each instruction *) let instr_ids t = - IList.mapi - (fun i instr -> + List.mapi + ~f:(fun i instr -> let id = Procdesc.Node.get_id t, Instr_index i in instr, Some id) (instrs t) diff --git a/infer/src/checkers/registerCheckers.ml b/infer/src/checkers/registerCheckers.ml index 900fc5607..c0851febf 100644 --- a/infer/src/checkers/registerCheckers.ml +++ b/infer/src/checkers/registerCheckers.ml @@ -43,7 +43,7 @@ let active_procedure_checkers () = ] in (* make sure SimpleChecker.ml is not dead code *) if false then (let module SC = SimpleChecker.Make in ()); - IList.map (fun (x, y) -> (x, y, Some Config.Java)) l in + List.map ~f:(fun (x, y) -> (x, y, Some Config.Java)) l in let c_cpp_checkers = let l = [ @@ -54,7 +54,7 @@ let active_procedure_checkers () = Siof.checker, checkers_enabled; BufferOverrunChecker.checker, Config.bufferoverrun; ] in - IList.map (fun (x, y) -> (x, y, Some Config.Clang)) l in + List.map ~f:(fun (x, y) -> (x, y, Some Config.Clang)) l in java_checkers @ c_cpp_checkers diff --git a/infer/src/checkers/scheduler.ml b/infer/src/checkers/scheduler.ml index d388cfb26..6030c43a3 100644 --- a/infer/src/checkers/scheduler.ml +++ b/infer/src/checkers/scheduler.ml @@ -50,7 +50,7 @@ module ReversePostorder (CFG : ProcCfg.S) = struct let priority t = t.priority let compute_priority cfg node visited_preds = - IList.length (CFG.preds cfg node) - IdSet.cardinal visited_preds + List.length (CFG.preds cfg node) - IdSet.cardinal visited_preds let make cfg node = let visited_preds = IdSet.empty in diff --git a/infer/src/checkers/sqlChecker.ml b/infer/src/checkers/sqlChecker.ml index 8119710b3..86ec89011 100644 --- a/infer/src/checkers/sqlChecker.ml +++ b/infer/src/checkers/sqlChecker.ml @@ -24,7 +24,7 @@ let callback_sql { Callbacks.proc_desc; proc_name; tenv } = "update .* set.*"; "delete .* from.*"; ] in - IList.map Str.regexp_case_fold _sql_start in + List.map ~f:Str.regexp_case_fold _sql_start in (* Check for SQL string concatenations *) let do_instr const_map node instr = diff --git a/infer/src/clang/CType_decl.ml b/infer/src/clang/CType_decl.ml index d38a331a3..3e01d9aa9 100644 --- a/infer/src/clang/CType_decl.ml +++ b/infer/src/clang/CType_decl.ml @@ -92,7 +92,7 @@ let get_class_methods class_name decl_list = Some procname | _ -> None in (* poor mans list_filter_map *) - IList.flatten_options (IList.map process_method_decl decl_list) + List.filter_map ~f:process_method_decl decl_list let get_superclass_decls decl = let open Clang_ast_t in @@ -104,7 +104,7 @@ let get_superclass_decls decl = let get_decl_or_fail typ_ptr = match CAst_utils.get_decl_from_typ_ptr typ_ptr with | Some decl -> decl | None -> assert false in - IList.map get_decl_or_fail base_ptr + List.map ~f:get_decl_or_fail base_ptr | _ -> [] (** fetches list of superclasses for C++ classes *) @@ -113,7 +113,7 @@ let get_superclass_list_cpp decl = let decl_to_mangled_name decl = Mangled.from_string (get_record_name decl) in let get_super_field super_decl = Typename.TN_csu (Csu.Class Csu.CPP, decl_to_mangled_name super_decl) in - IList.map get_super_field base_decls + List.map ~f:get_super_field base_decls let get_translate_as_friend_decl decl_list = let is_translate_as_friend_name (_, name_info) = @@ -162,8 +162,8 @@ let rec get_struct_fields tenv decl = [(id, typ, annotation_items)] | _ -> [] in let base_decls = get_superclass_decls decl in - let base_class_fields = IList.map (get_struct_fields tenv) base_decls in - List.concat (base_class_fields @ (IList.map do_one_decl decl_list)) + let base_class_fields = List.map ~f:(get_struct_fields tenv) base_decls in + List.concat (base_class_fields @ (List.map ~f:do_one_decl decl_list)) (* For a record declaration it returns/constructs the type *) and get_record_declaration_type tenv decl = diff --git a/infer/src/clang/ClangCommand.re b/infer/src/clang/ClangCommand.re index 0273c7c5e..6a6574899 100644 --- a/infer/src/clang/ClangCommand.re +++ b/infer/src/clang/ClangCommand.re @@ -143,7 +143,7 @@ let command_to_run cmd => { let mk_cmd normalizer => { let {exec, argv, quoting_style} = normalizer cmd; Printf.sprintf - "'%s' %s" exec (IList.map (ClangQuotes.quote quoting_style) argv |> String.concat sep::" ") + "'%s' %s" exec (List.map f::(ClangQuotes.quote quoting_style) argv |> String.concat sep::" ") }; if (can_attach_ast_exporter cmd) { mk_cmd clang_cc1_cmd_sanitizer diff --git a/infer/src/clang/ComponentKit.ml b/infer/src/clang/ComponentKit.ml index 74d4a7fc2..56db03801 100644 --- a/infer/src/clang/ComponentKit.ml +++ b/infer/src/clang/ComponentKit.ml @@ -234,14 +234,14 @@ let component_with_multiple_factory_methods_advice context an = | ObjCMethodDecl (decl_info, _, _) -> decl_info.Clang_ast_t.di_attributes | _ -> assert false in let unavailable_attrs = (List.filter ~f:is_unavailable_attr attrs) in - let is_available = Int.equal (IList.length unavailable_attrs) 0 in + let is_available = Int.equal (List.length unavailable_attrs) 0 in (CAst_utils.is_objc_factory_method if_decl decl) && is_available in let check_interface if_decl = match if_decl with | Clang_ast_t.ObjCInterfaceDecl (_, _, decls, _, _) -> let factory_methods = List.filter ~f:(is_available_factory_method if_decl) decls in - CTL.True, IList.map (fun meth_decl -> { + CTL.True, List.map ~f:(fun meth_decl -> { CIssue.name = "COMPONENT_WITH_MULTIPLE_FACTORY_METHODS"; severity = Exceptions.Kadvice; mode = CIssue.On; @@ -328,7 +328,7 @@ let component_file_line_count_info (context: CLintersContext.context) dec = let source_file = context.translation_unit_context.CFrontend_config.source_file in let line_count = SourceFile.line_count source_file in - CTL.True, IList.map (fun i -> { + CTL.True, List.map ~f:(fun i -> { CIssue.name = "COMPONENT_FILE_LINE_COUNT"; severity = Exceptions.Kinfo; mode = CIssue.Off; diff --git a/infer/src/clang/ast_expressions.ml b/infer/src/clang/ast_expressions.ml index f3bd564b7..79b4da294 100644 --- a/infer/src/clang/ast_expressions.ml +++ b/infer/src/clang/ast_expressions.ml @@ -310,7 +310,7 @@ let translate_dispatch_function stmt_info stmt_list n = match stmt_list with | _:: args_stmts -> let expr_info_call = make_general_expr_info create_void_star_type `XValue `Ordinary in - let arg_stmt = try IList.nth args_stmts n with Failure _ -> assert false in + let arg_stmt = try List.nth_exn args_stmts n with Failure _ -> assert false in CallExpr (stmt_info, [arg_stmt], expr_info_call) | _ -> assert false diff --git a/infer/src/clang/cAst_utils.ml b/infer/src/clang/cAst_utils.ml index cbdc589d6..cc63128aa 100644 --- a/infer/src/clang/cAst_utils.ml +++ b/infer/src/clang/cAst_utils.ml @@ -335,7 +335,7 @@ let get_tag ast_item = let rec generate_key_stmt stmt = let tag_str = string_of_int (get_tag stmt) in let _, stmts = Clang_ast_proj.get_stmt_tuple stmt in - let tags = IList.map generate_key_stmt stmts in + let tags = List.map ~f:generate_key_stmt stmts in let buffer = Buffer.create 16 in let tags = tag_str :: tags in List.iter ~f:(fun tag -> Buffer.add_string buffer tag) tags; diff --git a/infer/src/clang/cContext.ml b/infer/src/clang/cContext.ml index 1206678b2..65f22657a 100644 --- a/infer/src/clang/cContext.ml +++ b/infer/src/clang/cContext.ml @@ -113,7 +113,7 @@ let create_curr_class tenv class_name ck = let class_tn_name = Typename.TN_csu (Csu.Class ck, (Mangled.from_string class_name)) in match Tenv.lookup tenv class_tn_name with | Some { supers } -> - (let supers_names = IList.map Typename.name supers in + (let supers_names = List.map ~f:Typename.name supers in match supers_names with | superclass:: protocols -> ContextCls (class_name, Some superclass, protocols) diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index 9c6445942..72493ab3c 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -35,7 +35,7 @@ let fields_superclass tenv interface_decl_info ck = | _ -> [] let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_attributes = - let prop_atts = IList.map Clang_ast_j.string_of_property_attribute prop_attributes in + let prop_atts = List.map ~f:Clang_ast_j.string_of_property_attribute prop_attributes in let annotation_from_type t = match t with | Typ.Tptr (_, Typ.Pk_objc_weak) -> [Config.weak] diff --git a/infer/src/clang/cFrontend_errors.ml b/infer/src/clang/cFrontend_errors.ml index 7df490de8..f5c05b751 100644 --- a/infer/src/clang/cFrontend_errors.ml +++ b/infer/src/clang/cFrontend_errors.ml @@ -25,7 +25,7 @@ let decl_single_checkers_list = let decl_checkers_list = ComponentKit.component_with_multiple_factory_methods_advice:: (ComponentKit.component_file_line_count_info:: - (IList.map single_to_multi decl_single_checkers_list)) + (List.map ~f:single_to_multi decl_single_checkers_list)) (* List of checkers on stmts *that return 0 or 1 issue* *) let stmt_single_checkers_list = @@ -33,7 +33,7 @@ let stmt_single_checkers_list = ComponentKit.component_initializer_with_side_effects_advice; GraphQL.DeprecatedAPIUsage.checker;] -let stmt_checkers_list = IList.map single_to_multi stmt_single_checkers_list +let stmt_checkers_list = List.map ~f:single_to_multi stmt_single_checkers_list (* List of checkers that will be filled after parsing them from a file *) let checkers_decl_stmt = ref [] @@ -123,7 +123,7 @@ let make_condition_issue_desc_pair checkers = Logging.out "\nCondition =\n %a\n" CTL.Debug.pp_formula condition; Logging.out "\nIssue_desc = %a\n" CIssue.pp_issue issue); condition, issue in - checkers_decl_stmt := IList.map do_one_checker checkers + checkers_decl_stmt := List.map ~f:do_one_checker checkers (* expands use of let defined formula id in checkers with their definition *) @@ -170,7 +170,7 @@ let expand_checkers checkers = CSet (report_when_const, expand phi map) :: defs | cl -> cl :: defs) ~init:[] c.definitions in { c with definitions = exp_defs} in - let expanded_checkers = IList.map expand_one_checker checkers in + let expanded_checkers = List.map ~f:expand_one_checker checkers in expanded_checkers let get_err_log translation_unit_context method_decl_opt = diff --git a/infer/src/clang/cGeneral_utils.ml b/infer/src/clang/cGeneral_utils.ml index eb74097bd..b69a7c632 100644 --- a/infer/src/clang/cGeneral_utils.ml +++ b/infer/src/clang/cGeneral_utils.ml @@ -130,7 +130,7 @@ let list_range i j = if n < i then acc else aux (n -1) (n :: acc) in aux j [] ;; -let replicate n el = IList.map (fun _ -> el) (list_range 0 (n -1)) +let replicate n el = List.map ~f:(fun _ -> el) (list_range 0 (n -1)) let mk_class_field_name field_qual_name = let field_name = field_qual_name.Clang_ast_t.ni_name in diff --git a/infer/src/clang/cMethod_signature.ml b/infer/src/clang/cMethod_signature.ml index 3dfef7807..defeb273c 100644 --- a/infer/src/clang/cMethod_signature.ml +++ b/infer/src/clang/cMethod_signature.ml @@ -66,13 +66,13 @@ let ms_get_return_param_typ { return_param_typ } = (* it has 1 argument (this includes self) *) let ms_is_getter { pointer_to_property_opt; args } = Option.is_some pointer_to_property_opt && - Int.equal (IList.length args) 1 + Int.equal (List.length args) 1 (* A method is a setter if it has a link to a property and *) (* it has 2 argument (this includes self) *) let ms_is_setter { pointer_to_property_opt; args } = Option.is_some pointer_to_property_opt && - Int.equal (IList.length args) 2 + Int.equal (List.length args) 2 let make_ms name args ret_type attributes loc is_instance ?is_cpp_virtual language pointer_to_parent pointer_to_property_opt return_param_typ = diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index c397c6a09..7ed4f72de 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -118,7 +118,7 @@ let get_parameters trans_unit_ctx tenv function_method_decl_info = | _ -> qt.Clang_ast_t.qt_type_ptr in (mangled, {qt with qt_type_ptr}) | _ -> assert false in - let pars = IList.map par_to_ms_par (get_param_decls function_method_decl_info) in + let pars = List.map ~f:par_to_ms_par (get_param_decls function_method_decl_info) in get_class_param function_method_decl_info @ pars @ get_return_param tenv function_method_decl_info (** get return type of the function and optionally type of function's return parameter *) @@ -151,11 +151,11 @@ let get_assume_not_null_calls param_decls = decl_info name qt.Clang_ast_t.qt_type_ptr in [(`ClangStmt assume_call)] | _ -> [] in - List.concat (IList.map do_one_param param_decls) + List.concat_map ~f:do_one_param param_decls let get_init_list_instrs method_decl_info = let create_custom_instr construct_instr = `CXXConstructorInit construct_instr in - IList.map create_custom_instr method_decl_info.Clang_ast_t.xmdi_cxx_ctor_initializers + List.map ~f:create_custom_instr method_decl_info.Clang_ast_t.xmdi_cxx_ctor_initializers let method_signature_of_decl trans_unit_ctx tenv meth_decl block_data_opt = let open Clang_ast_t in @@ -381,7 +381,7 @@ let get_const_args_indices ~shift args = (** Creates a procedure description. *) let create_local_procdesc trans_unit_ctx cfg tenv ms fbody captured is_objc_inst_method = - let defined = not (Int.equal (IList.length fbody) 0) in + let defined = not (Int.equal (List.length fbody) 0) in let proc_name = CMethod_signature.ms_get_name ms in let pname = Procname.to_string proc_name in let attributes = sil_func_attributes_of_attributes (CMethod_signature.ms_get_attributes ms) in @@ -393,11 +393,11 @@ let create_local_procdesc trans_unit_ctx cfg tenv ms fbody captured is_objc_inst CFrontend_config.equal_clang_lang (CMethod_signature.ms_get_lang ms) CFrontend_config.CPP in let create_new_procdesc () = let formals = get_formal_parameters tenv ms in - let captured_mangled = IList.map (fun (var, t) -> (Pvar.get_name var), t) captured in + let captured_mangled = List.map ~f:(fun (var, t) -> (Pvar.get_name var), t) captured in (* Captured variables for blocks are treated as parameters *) let formals = captured_mangled @ formals in let const_formals = get_const_args_indices - ~shift:(IList.length captured_mangled) + ~shift:(List.length captured_mangled) (CMethod_signature.ms_get_args ms) in let source_range = CMethod_signature.ms_get_loc ms in Logging.out_debug "\nCreating a new procdesc for function: '%s'\n@." pname; @@ -445,7 +445,7 @@ let create_external_procdesc cfg proc_name is_objc_inst_method type_opt = let ret_type, formals = (match type_opt with | Some (ret_type, arg_types) -> - ret_type, IList.map (fun typ -> (Mangled.from_string "x", typ)) arg_types + ret_type, List.map ~f:(fun typ -> (Mangled.from_string "x", typ)) arg_types | None -> Typ.Tvoid, []) in let loc = Location.dummy in let proc_attributes = diff --git a/infer/src/clang/cPredicates.ml b/infer/src/clang/cPredicates.ml index 4f794087f..9c388c492 100644 --- a/infer/src/clang/cPredicates.ml +++ b/infer/src/clang/cPredicates.ml @@ -196,7 +196,7 @@ let is_objc_dealloc context = | _ -> false let captures_cxx_references an = - IList.length (captured_variables_cxx_ref an) > 0 + List.length (captured_variables_cxx_ref an) > 0 let is_binop_with_kind str_kind an = if not (Clang_ast_proj.is_valid_binop_kind_name str_kind) then diff --git a/infer/src/clang/cTL.ml b/infer/src/clang/cTL.ml index f6faa2ba4..e82e87642 100644 --- a/infer/src/clang/cTL.ml +++ b/infer/src/clang/cTL.ml @@ -217,7 +217,7 @@ module Debug = struct | Stmt stmt -> Clang_ast_proj.get_stmt_kind_string stmt | Decl decl -> Clang_ast_proj.get_decl_kind_string decl in let smart_string_of_formula phi = - let num_children = IList.length children in + let num_children = List.length children in match phi with | And _ when Int.equal num_children 2 -> "(...) AND (...)" | Or _ when Int.equal num_children 2 -> "(...) OR (...)" @@ -312,11 +312,11 @@ let get_successor_nodes an = match an with | Stmt st -> let _, succs_st = Clang_ast_proj.get_stmt_tuple st in - let succs = IList.map (fun s -> Stmt s) succs_st in + let succs = List.map ~f:(fun s -> Stmt s) succs_st in succs @ (get_decl_of_stmt st) | Decl dec -> (match Clang_ast_proj.get_decl_context_tuple dec with - | Some (decl_list, _) -> IList.map (fun d -> Decl d) decl_list + | Some (decl_list, _) -> List.map ~f:(fun d -> Decl d) decl_list | None -> []) let node_to_string an = diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index 541abd2ae..c424febd9 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -112,7 +112,7 @@ struct let fname = CGeneral_utils.mk_class_field_name qual_name in let item_annot = Annot.Item.empty in fname, typ, item_annot in - let fields = IList.map mk_field_from_captured_var captured_vars in + let fields = List.map ~f:mk_field_from_captured_var captured_vars in Logging.out_debug "Block %s field:\n" block_name; List.iter ~f:(fun (fn, _, _) -> Logging.out_debug "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; @@ -133,9 +133,9 @@ struct let create_field_exp (var, typ) = let id = Ident.create_fresh Ident.knormal in id, Sil.Load (id, Exp.Lvar var, typ, loc) in - let ids, captured_instrs = List.unzip (IList.map create_field_exp captured_vars) in + let ids, captured_instrs = List.unzip (List.map ~f:create_field_exp captured_vars) in let fields_ids = List.zip_exn fields ids in - let set_fields = IList.map (fun ((f, t, _), id) -> + let set_fields = List.map ~f:(fun ((f, t, _), id) -> Sil.Store (Exp.Lfield (Exp.Var id_block, f, block_type), t, Exp.Var id, loc)) fields_ids in (declare_block_local :: trans_res.instrs) @ [set_instr] @ @@ -161,17 +161,17 @@ struct (Typ.Tptr((Typ.Tfun _), _ ) as t)) :: es' -> let app = let function_name = make_function_name t name in - let args = IList.map (make_arg t) captured_vars in + let args = List.map ~f:(make_arg t) captured_vars in function_name :: args in app @ (f es') | e :: es' -> e :: f es' in (f exps, !insts) let collect_exprs res_trans_list = - List.concat (IList.map (fun res_trans -> res_trans.exps) res_trans_list) + List.concat_map ~f:(fun res_trans -> res_trans.exps) res_trans_list let collect_initid_exprs res_trans_list = - List.concat (IList.map (fun res_trans -> res_trans.initd_exps) res_trans_list) + List.concat_map ~f:(fun res_trans -> res_trans.initd_exps) res_trans_list (* If e is a block and the calling node has the priority then *) (* we need to release the priority to allow*) @@ -816,7 +816,7 @@ struct (* Create a node if the priority if free and there are instructions *) let creating_node = (PriorityNode.own_priority_node trans_state_pri.priority stmt_info) && - (IList.length instr_bin >0) in + (List.length instr_bin >0) in let extra_instrs, exp_to_parent = if (is_binary_assign_op binary_operator_info) (* assignment operator result is lvalue in CPP, rvalue in C, *) @@ -877,7 +877,7 @@ struct { trans_state_pri with succ_nodes = []; var_exp_typ = None } in let result_trans_subexprs = let instruction' = exec_with_self_exception (exec_with_glvalue_as_reference instruction) in - let res_trans_p = IList.map (instruction' trans_state_param) params_stmt in + let res_trans_p = List.map ~f:(instruction' trans_state_param) params_stmt in res_trans_callee :: res_trans_p in match Option.bind callee_pname_opt (CTrans_utils.builtin_trans @@ -889,7 +889,7 @@ struct ~f:CTrans_models.is_cf_retain_release ~default:false callee_pname_opt in let act_params = let params = List.tl_exn (collect_exprs result_trans_subexprs) in - if Int.equal (IList.length params) (IList.length params_stmt) then + if Int.equal (List.length params) (List.length params_stmt) then params else (Logging.err_debug "WARNING: stmt_list and res_trans_par.exps must have same size. \ @@ -928,7 +928,7 @@ struct let procname = Procdesc.get_proc_name context.procdesc in let sil_loc = CLocation.get_sil_location si context in (* first for method address, second for 'this' expression *) - assert (Int.equal (IList.length result_trans_callee.exps) 2); + assert (Int.equal (List.length result_trans_callee.exps) 2); let (sil_method, _) = List.hd_exn result_trans_callee.exps in let callee_pname = match sil_method with @@ -941,7 +941,7 @@ struct let trans_state_param = { trans_state_pri with succ_nodes = []; var_exp_typ = None } in let instruction' = exec_with_self_exception (exec_with_glvalue_as_reference instruction) in - let res_trans_p = IList.map (instruction' trans_state_param) params_stmt in + let res_trans_p = List.map ~f:(instruction' trans_state_param) params_stmt in result_trans_callee :: res_trans_p in (* first expr is method address, rest are params including 'this' parameter *) let actual_params = List.tl_exn (collect_exprs result_trans_subexprs) in @@ -1064,7 +1064,7 @@ struct obj_c_message_expr_info, empty_res_trans in let instruction' = exec_with_self_exception (exec_with_glvalue_as_reference instruction) in - let l = IList.map (instruction' trans_state_param) rest in + let l = List.map ~f:(instruction' trans_state_param) rest in obj_c_message_expr_info, fst_res_trans :: l | [] -> obj_c_message_expr_info, [empty_res_trans] @@ -1234,7 +1234,7 @@ struct List.iter ~f:(fun n' -> Procdesc.node_set_succs_exn context.procdesc n' [prune_t; prune_f] []) res_trans_cond.leaf_nodes; - let rnodes = if Int.equal (IList.length res_trans_cond.root_nodes) 0 then + let rnodes = if Int.equal (List.length res_trans_cond.root_nodes) 0 then [prune_t; prune_f] else res_trans_cond.root_nodes in { empty_res_trans with @@ -1268,7 +1268,7 @@ struct ~f:(fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans_s2.root_nodes []) prune_to_s2; let root_nodes_to_parent = - if Int.equal (IList.length res_trans_s1.root_nodes) 0 + if Int.equal (List.length res_trans_s1.root_nodes) 0 then res_trans_s1.leaf_nodes else res_trans_s1.root_nodes in let (exp1, typ1) = extract_exp res_trans_s1.exps in @@ -1647,7 +1647,7 @@ struct let res_trans_subexpr_list = initListExpr_initializers_trans trans_state var_exp 0 stmts typ false stmt_info in let rh_exps = collect_exprs res_trans_subexpr_list in - if Int.equal (IList.length rh_exps) 0 then + if Int.equal (List.length rh_exps) 0 then let exps = match Sil.zero_value_of_numerical_type_option var_type with | Some zero_exp -> [(zero_exp, typ)] @@ -1657,11 +1657,11 @@ struct (* For arrays, the size in the type may be an overapproximation of the number *) (* of literals the array is initialized with *) let lh = - if is_array var_type && IList.length lh > IList.length rh_exps then - let i = IList.length lh - IList.length rh_exps in + if is_array var_type && List.length lh > List.length rh_exps then + let i = List.length lh - List.length rh_exps in IList.drop_last i lh else lh in - if Int.equal (IList.length rh_exps) (IList.length lh) then + if Int.equal (List.length rh_exps) (List.length lh) then (* Creating new instructions by assigning right hand side to left hand side expressions *) let assign_instr (lh_exp, lh_t) (rh_exp, _) = Sil.Store (lh_exp, lh_t, rh_exp, sil_loc) in let assign_instrs = @@ -1674,7 +1674,7 @@ struct ~f:((fun arr index -> Exp.is_array_index_of index arr) var_exp) initd_exps then [] - else IList.map2 assign_instr lh rh_exps in + else List.map2_exn ~f:assign_instr lh rh_exps in let initlist_expr_res = { empty_res_trans with exps = [(var_exp, var_type)]; @@ -1949,7 +1949,7 @@ struct ~f:(fun n -> Procdesc.node_set_succs_exn procdesc n [ret_node] []) res_trans_stmt.leaf_nodes; let root_nodes_to_parent = - if IList.length res_trans_stmt.root_nodes >0 + if List.length res_trans_stmt.root_nodes >0 then res_trans_stmt.root_nodes else [ret_node] in { empty_res_trans with root_nodes = root_nodes_to_parent; leaf_nodes = []} @@ -2069,13 +2069,13 @@ struct Cg.add_edge context.cg procname block_pname; let captured_block_vars = block_decl_info.Clang_ast_t.bdi_captured_variables in let captureds = CVar_decl.captured_vars_from_block_info context captured_block_vars in - let ids_instrs = IList.map assign_captured_var captureds in + let ids_instrs = List.map ~f:assign_captured_var captureds in let ids, instrs = List.unzip ids_instrs in let block_data = (context, type_ptr, block_pname, captureds) in F.function_decl context.translation_unit_context context.tenv context.cfg context.cg decl (Some block_data); let captured_vars = - IList.map2 (fun id (pvar, typ) -> (Exp.Var id, pvar, typ)) ids captureds in + List.map2_exn ~f:(fun id (pvar, typ) -> (Exp.Var id, pvar, typ)) ids captureds in let closure = Exp.Closure { name=block_pname; captured_vars } in let block_name = Procname.to_string block_pname in let static_vars = CContext.static_vars_for_block context block_pname in @@ -2269,7 +2269,7 @@ struct let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_param = { trans_state_pri with succ_nodes = [] } in let res_trans_subexpr_list = - IList.map (exec_with_glvalue_as_reference instruction trans_state_param) stmts in + List.map ~f:(exec_with_glvalue_as_reference instruction trans_state_param) stmts in let params = collect_exprs res_trans_subexpr_list in let sil_fun = Exp.Const (Const.Cfun pname) in let call_instr = Sil.Call (None, sil_fun, params, sil_loc, CallFlags.default) in @@ -2329,7 +2329,7 @@ struct let fun_name = Procname.from_string_c_fun CFrontend_config.infer_skip_fun in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_param = { trans_state_pri with succ_nodes = [] } in - let res_trans_subexpr_list = IList.map (instruction trans_state_param) stmts in + let res_trans_subexpr_list = List.map ~f:(instruction trans_state_param) stmts in let params = collect_exprs res_trans_subexpr_list in let sil_fun = Exp.Const (Const.Cfun fun_name) in let ret_id = Ident.create_fresh Ident.knormal in @@ -2735,7 +2735,7 @@ struct (** Given a translation state, this function translates a list of clang statements. *) and instructions trans_state stmt_list = - let stmt_trans_fun = IList.map get_clang_stmt_trans stmt_list in + let stmt_trans_fun = List.map ~f:get_clang_stmt_trans stmt_list in exec_trans_instrs trans_state stmt_trans_fun and expression_trans context stmt warning = @@ -2762,7 +2762,7 @@ struct obj_bridged_cast_typ = None } in let instrs = extra_instrs @ [`ClangStmt body] in - let instrs_trans = IList.map get_custom_stmt_trans instrs in + let instrs_trans = List.map ~f:get_custom_stmt_trans instrs in let res_trans = exec_trans_instrs trans_state instrs_trans in res_trans.root_nodes diff --git a/infer/src/clang/cTrans_utils.ml b/infer/src/clang/cTrans_utils.ml index 8fbdfdf63..d5ff106aa 100644 --- a/infer/src/clang/cTrans_utils.ml +++ b/infer/src/clang/cTrans_utils.ml @@ -513,7 +513,7 @@ let define_condition_side_effects e_cond instrs_cond sil_loc = | _ -> [(e', typ)], instrs_cond let fix_param_exps_mismatch params_stmt exps_param = - let diff = IList.length params_stmt - IList.length exps_param in + let diff = List.length params_stmt - List.length exps_param in let args = if diff >0 then Array.create ~len:diff dummy_exp else assert false in let exps'= exps_param @ (Array.to_list args) in @@ -694,7 +694,7 @@ let is_dispatch_function stmt_list = | None -> None | Some (_, block_arg_pos) -> try - let arg_stmt = IList.nth arg_stmts block_arg_pos in + let arg_stmt = List.nth_exn arg_stmts block_arg_pos in if is_block_stmt arg_stmt then Some block_arg_pos else None with Failure _ -> None) | _ -> None)) @@ -720,10 +720,10 @@ let var_or_zero_in_init_list tenv e typ ~return_zero:return_zero = match Tenv.lookup tenv tn with | Some { fields } -> let lh_exprs = - IList.map (fun (fieldname, _, _) -> Exp.Lfield (e, fieldname, typ)) fields in - let lh_types = IList.map (fun (_, fieldtype, _) -> fieldtype) fields in + List.map ~f:(fun (fieldname, _, _) -> Exp.Lfield (e, fieldname, typ)) fields in + let lh_types = List.map ~f:(fun (_, fieldtype, _) -> fieldtype) fields in let exp_types = zip lh_exprs lh_types in - IList.map (fun (e, t) -> List.concat (var_or_zero_in_init_list' e t tns)) exp_types + List.map ~f:(fun (e, t) -> List.concat (var_or_zero_in_init_list' e t tns)) exp_types | None -> assert false ) @@ -731,12 +731,12 @@ let var_or_zero_in_init_list tenv e typ ~return_zero:return_zero = let size = IntLit.to_int n in let indices = list_range 0 (size - 1) in let index_constants = - IList.map (fun i -> (Exp.Const (Const.Cint (IntLit.of_int i)))) indices in + List.map ~f:(fun i -> (Exp.Const (Const.Cint (IntLit.of_int i)))) indices in let lh_exprs = - IList.map (fun index_expr -> Exp.Lindex (e, index_expr)) index_constants in + List.map ~f:(fun index_expr -> Exp.Lindex (e, index_expr)) index_constants in let lh_types = replicate size arrtyp in let exp_types = zip lh_exprs lh_types in - IList.map (fun (e, t) -> + List.map ~f:(fun (e, t) -> List.concat (var_or_zero_in_init_list' e t tns)) exp_types | Typ.Tint _ | Typ.Tfloat _ | Typ.Tptr _ -> let exp = if return_zero then Sil.zero_value_of_numerical_type typ else e in diff --git a/infer/src/clang/objcInterface_decl.ml b/infer/src/clang/objcInterface_decl.ml index 85b371ee4..579de7e90 100644 --- a/infer/src/clang/objcInterface_decl.ml +++ b/infer/src/clang/objcInterface_decl.ml @@ -29,7 +29,7 @@ let get_super_interface_decl otdi_super = | _ -> None let get_protocols protocols = - let protocol_names = IList.map ( + let protocol_names = List.map ~f:( fun decl -> match decl.Clang_ast_t.dr_name with | Some name_info -> CAst_utils.get_qualified_name name_info | None -> assert false @@ -77,7 +77,7 @@ let get_interface_supers super_opt protocols = match super_opt with | None -> [] | Some super -> [Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string super)] in - let protocol_names = IList.map ( + let protocol_names = List.map ~f:( fun name -> Typename.TN_csu (Csu.Protocol, Mangled.from_string name) ) protocols in let super_classes = super_class@protocol_names in diff --git a/infer/src/eradicate/eradicate.ml b/infer/src/eradicate/eradicate.ml index c33bb439c..6ea085e88 100644 --- a/infer/src/eradicate/eradicate.ml +++ b/infer/src/eradicate/eradicate.ml @@ -46,7 +46,7 @@ struct let update_summary proc_name proc_desc final_typestate_opt = match Specs.get_summary proc_name with | Some old_summ -> - let nodes = IList.map (fun n -> Procdesc.Node.get_id n) (Procdesc.get_nodes proc_desc) in + let nodes = List.map ~f:(fun n -> Procdesc.Node.get_id n) (Procdesc.get_nodes proc_desc) in let method_annotation = (Specs.pdesc_resolve_attributes proc_desc).ProcAttributes.method_annotation in let new_summ = diff --git a/infer/src/eradicate/eradicateChecks.ml b/infer/src/eradicate/eradicateChecks.ml index 51b8e23f6..ebdd447be 100644 --- a/infer/src/eradicate/eradicateChecks.ml +++ b/infer/src/eradicate/eradicateChecks.ml @@ -448,7 +448,7 @@ let check_call_parameters tenv sig_params call_params loc instr_ref typecheck_expr : unit = let callee_pname = callee_attributes.ProcAttributes.proc_name in let has_this = is_virtual sig_params in - let tot_param_num = IList.length sig_params - (if has_this then 1 else 0) in + let tot_param_num = List.length sig_params - (if has_this then 1 else 0) in let rec check sparams cparams = match sparams, cparams with | (s1, ia1, t1) :: sparams', ((orig_e2, e2), t2) :: cparams' -> let param_is_this = String.equal (Mangled.to_string s1) "this" in @@ -480,7 +480,7 @@ let check_call_parameters tenv | None -> "formal parameter " ^ (Mangled.to_string s1) in let origin_descr = TypeAnnotation.descr_origin tenv ta2 in - let param_num = IList.length sparams' + (if has_this then 0 else 1) in + let param_num = List.length sparams' + (if has_this then 0 else 1) in let callee_loc = callee_attributes.ProcAttributes.loc in report_error tenv find_canonical_duplicate @@ -548,7 +548,7 @@ let check_overridden_annotations let current_params = annotated_signature.AnnotatedSignature.params 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 + if Int.equal (List.length current_params) (List.length overridden_params) then ignore (List.fold2_exn ~f:compare ~init:initial_pos current_params overridden_params) in let check overriden_proc_name = diff --git a/infer/src/eradicate/modelTables.ml b/infer/src/eradicate/modelTables.ml index b1144695f..e5c56fce2 100644 --- a/infer/src/eradicate/modelTables.ml +++ b/infer/src/eradicate/modelTables.ml @@ -51,7 +51,7 @@ let check_not_null_parameter_list, check_not_null_list = 1, (o, [n]), "com.facebook.infer.annotation.Assertions.assumeNotNull(java.lang.Object):java.lang.Object"; 1, (o, [n; o]), "com.facebook.infer.annotation.Assertions.assumeNotNull(java.lang.Object,java.lang.String):java.lang.Object"; ] in - IList.map (fun (x, _, z) -> (x, z)) list, IList.map (fun (_, y, z) -> (y, z)) list + List.map ~f:(fun (x, _, z) -> (x, z)) list, List.map ~f:(fun (_, y, z) -> (y, z)) list let check_state_list = [ diff --git a/infer/src/eradicate/typeCheck.ml b/infer/src/eradicate/typeCheck.ml index bf0689d4c..6a677d3d1 100644 --- a/infer/src/eradicate/typeCheck.ml +++ b/infer/src/eradicate/typeCheck.ml @@ -573,14 +573,14 @@ let typecheck_instr proc_attributes | None -> let formals = - IList.mapi - (fun i (_, typ) -> - let arg = - if Int.equal i 0 && - not (Procname.java_is_static callee_pname) - then "this" - else Printf.sprintf "arg%d" i in - (Mangled.from_string arg, typ)) + List.mapi + ~f:(fun i (_, typ) -> + let arg = + if Int.equal i 0 && + not (Procname.java_is_static callee_pname) + then "this" + else Printf.sprintf "arg%d" i in + (Mangled.from_string arg, typ)) etl_ in let ret_type = Typ.java_proc_return_typ callee_pname_java in let proc_attributes = @@ -818,7 +818,7 @@ let typecheck_instr (typecheck_expr find_canonical_duplicate calls_this checks tenv); let typestate2 = if checks.check_extension then - let etl' = IList.map (fun ((_, e), t) -> (e, t)) call_params in + let etl' = List.map ~f:(fun ((_, e), t) -> (e, t)) call_params in let extension = TypeState.get_extension typestate1 in let extension' = ext.TypeState.check_instr @@ -839,7 +839,7 @@ let typecheck_instr if has_method callee_pname "checkNotNull" && Procname.java_is_vararg callee_pname then - let last_parameter = IList.length call_params in + let last_parameter = List.length call_params in do_preconditions_check_not_null last_parameter true (* is_vararg *) diff --git a/infer/src/harness/inhabit.ml b/infer/src/harness/inhabit.ml index a27beabbe..9b93c2473 100644 --- a/infer/src/harness/inhabit.ml +++ b/infer/src/harness/inhabit.ml @@ -260,7 +260,7 @@ let setup_harness_cfg harness_name env cg cfg = (** create a procedure named harness_name that calls each of the methods in trace in the specified * order with the specified receiver and add it to the execution environment *) let inhabit_trace tenv trace harness_name cg cfg = - if IList.length trace > 0 then + if List.length trace > 0 then let source_file = Cg.get_source cg in let harness_filename = create_dummy_harness_filename harness_name in let start_line = 1 in diff --git a/infer/src/integration/CaptureCompilationDatabase.ml b/infer/src/integration/CaptureCompilationDatabase.ml index bd9af3c92..d459d0fd2 100644 --- a/infer/src/integration/CaptureCompilationDatabase.ml +++ b/infer/src/integration/CaptureCompilationDatabase.ml @@ -42,7 +42,7 @@ let add_flavor_to_targets args = (* Targets are assumed to start with //, aliases are not allowed *) if String.is_prefix ~prefix:"//" arg then arg ^ flavor else arg in - IList.map process_arg args + List.map ~f:process_arg args let create_files_stack compilation_database should_capture_file = let stack = Stack.create () in diff --git a/infer/src/integration/ClangQuotes.re b/infer/src/integration/ClangQuotes.re index a081a235a..0dd82c8b0 100644 --- a/infer/src/integration/ClangQuotes.re +++ b/infer/src/integration/ClangQuotes.re @@ -35,7 +35,7 @@ let mk_arg_file prefix style args => { Utils.create_dir temp_dir; let file = Filename.temp_file in_dir::temp_dir prefix ".txt"; let write_args outc => - output_string outc (IList.map (quote style) args |> String.concat sep::" "); + output_string outc (List.map f::(quote style) args |> String.concat sep::" "); Utils.with_file file f::write_args |> ignore; Logging.out "Clang options stored in file %s@\n" file; file diff --git a/infer/src/java/jAnnotation.ml b/infer/src/java/jAnnotation.ml index 8ba1fcd5b..5881b4adc 100644 --- a/infer/src/java/jAnnotation.ml +++ b/infer/src/java/jAnnotation.ml @@ -26,7 +26,7 @@ let translate a : Annot.t = let element_value_pairs = a.JBasics.element_value_pairs in { Annot. class_name; - parameters = IList.map translate_value_pair element_value_pairs } + parameters = List.map ~f:translate_value_pair element_value_pairs } (** Translate an item annotation. *) @@ -35,7 +35,7 @@ let translate_item avlist : Annot.Item.t = | Javalib.RTVisible -> true | Javalib.RTInvisible -> false in let trans (a, v) = translate a, trans_vis v in - IList.map trans avlist + List.map ~f:trans avlist (** Translate a method annotation. *) @@ -43,5 +43,5 @@ let translate_method ann : Annot.Method.t = let global_ann = ann.Javalib.ma_global in let param_ann = ann.Javalib.ma_parameters in let ret_item = translate_item global_ann in - let param_items = IList.map translate_item param_ann in + let param_items = List.map ~f:translate_item param_ann in ret_item, param_items diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index 0db4003f4..91e850dce 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -97,7 +97,7 @@ let get_undefined_method_call ovt = let retrieve_fieldname fieldname = try let subs = Str.split (Str.regexp (Str.quote ".")) (Ident.fieldname_to_string fieldname) in - if Int.equal (IList.length subs) 0 then + if Int.equal (List.length subs) 0 then assert false else List.hd_exn (IList.rev subs) @@ -286,7 +286,7 @@ let create_am_procdesc program icfg am proc_name : Procdesc.t = let proc_attributes = { (ProcAttributes.default proc_name Config.Java) with ProcAttributes.access = trans_access am.Javalib.am_access; - exceptions = IList.map JBasics.cn_name am.Javalib.am_exceptions; + exceptions = List.map ~f:JBasics.cn_name am.Javalib.am_exceptions; formals; is_abstract = true; is_bridge_method = am.Javalib.am_bridge; @@ -318,7 +318,7 @@ let create_native_procdesc program icfg cm proc_name = let proc_attributes = { (ProcAttributes.default proc_name Config.Java) with ProcAttributes.access = trans_access cm.Javalib.cm_access; - exceptions = IList.map JBasics.cn_name cm.Javalib.cm_exceptions; + exceptions = List.map ~f:JBasics.cn_name cm.Javalib.cm_exceptions; formals; is_bridge_method = cm.Javalib.cm_bridge; is_model = Config.models_mode; @@ -351,7 +351,7 @@ let create_cm_procdesc source_file program linereader icfg cm proc_name = let proc_attributes = { (ProcAttributes.default proc_name Config.Java) with ProcAttributes.access = trans_access cm.Javalib.cm_access; - exceptions = IList.map JBasics.cn_name cm.Javalib.cm_exceptions; + exceptions = List.map ~f:JBasics.cn_name cm.Javalib.cm_exceptions; formals; is_bridge_method = cm.Javalib.cm_bridge; is_defined = true; @@ -837,7 +837,7 @@ let rec instruction (context : JContext.t) pc instr : translation = | JBir.NewArray (var, vt, expr_list) -> let builtin_new_array = Exp.Const (Const.Cfun BuiltinDecl.__new_array) in let content_type = JTransType.value_type program tenv vt in - let array_type = JTransType.create_array_type content_type (IList.length expr_list) in + let array_type = JTransType.create_array_type content_type (List.length expr_list) in let array_name = JContext.set_pvar context var array_type in let (instrs, array_size) = get_array_length context pc expr_list content_type in let call_args = [(array_size, array_type)] in diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 5d38223aa..7621dc8bf 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -312,7 +312,7 @@ and get_class_struct_typ program tenv cn = | Some node -> let create_super_list interface_names = List.iter ~f:(fun cn -> ignore (get_class_struct_typ program tenv cn)) interface_names; - IList.map typename_of_classname interface_names in + List.map ~f:typename_of_classname interface_names in let supers, fields, statics, annots = match node with | Javalib.JInterface jinterface -> diff --git a/infer/src/quandary/ClangTrace.ml b/infer/src/quandary/ClangTrace.ml index e2adbf54c..28af117ab 100644 --- a/infer/src/quandary/ClangTrace.ml +++ b/infer/src/quandary/ClangTrace.ml @@ -63,8 +63,8 @@ module SinkKind = struct let get pname actuals _ = let taint_all actuals kind ~report_reachable = - IList.mapi - (fun actual_num _ -> kind, actual_num, report_reachable) + List.mapi + ~f:(fun actual_num _ -> kind, actual_num, report_reachable) actuals in match pname with | (Procname.ObjC_Cpp cpp_pname) as pname -> diff --git a/infer/src/quandary/JavaTrace.ml b/infer/src/quandary/JavaTrace.ml index aa6c5f9e0..04fac8a92 100644 --- a/infer/src/quandary/JavaTrace.ml +++ b/infer/src/quandary/JavaTrace.ml @@ -93,7 +93,7 @@ module SourceKind = struct formal_name, formal_typ, Some kind else make_untainted formal in - IList.map taint_formal_with_types formals in + List.map ~f:taint_formal_with_types formals in let formals = Procdesc.get_formals pdesc in match Procdesc.get_proc_name pdesc with @@ -157,8 +157,8 @@ module SinkKind = struct if Procname.java_is_static pname || taint_this then actuals, 0 else List.tl_exn actuals, 1 in - IList.mapi - (fun param_num _ -> kind, param_num + offset, report_reachable) + List.mapi + ~f:(fun param_num _ -> kind, param_num + offset, report_reachable) actuals_to_taint in (* taint the nth non-"this" parameter (0-indexed) *) let taint_nth n kind ~report_reachable = diff --git a/infer/src/quandary/QuandaryConfig.ml b/infer/src/quandary/QuandaryConfig.ml index 9bbef5d81..3406e87d3 100644 --- a/infer/src/quandary/QuandaryConfig.ml +++ b/infer/src/quandary/QuandaryConfig.ml @@ -23,7 +23,7 @@ module Source = struct let procedure = json |> member "procedure" |> to_string |> Str.regexp in let kind = json |> member "kind" |> to_string in { procedure; kind; } in - IList.map parse_source sources + List.map ~f:parse_source sources | _ -> [] end @@ -39,7 +39,7 @@ module Sink = struct let kind = json |> member "kind" |> to_string in let index = json |> member "index" |> to_string in { procedure; kind; index; } in - IList.map parse_sink sinks + List.map ~f:parse_sink sinks | _ -> [] end diff --git a/infer/src/quandary/TaintAnalysis.ml b/infer/src/quandary/TaintAnalysis.ml index 2d6a6baee..bdb0e43e8 100644 --- a/infer/src/quandary/TaintAnalysis.ml +++ b/infer/src/quandary/TaintAnalysis.ml @@ -190,7 +190,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct let f_resolve_id = resolve_id id_map in (* add [sink] to the trace associated with the [formal_index]th actual *) let add_sink_to_actual access_tree_acc (sink_param : TraceDomain.Sink.parameter) = - let actual_exp, actual_typ = IList.nth actuals sink_param.index in + let actual_exp, actual_typ = List.nth_exn actuals sink_param.index in match AccessPath.of_lhs_exp actual_exp actual_typ ~f_resolve_id with | Some actual_ap_raw -> let actual_ap = @@ -236,12 +236,11 @@ module Make (TaintSpecification : TaintSpec.S) = struct | None -> failwith "Have summary for retval, but no ret id to bind it to!" in let get_actual_ap formal_index = let f_resolve_id = resolve_id astate_in.id_map in - try - let actual_exp, actual_typ = - IList.nth actuals formal_index in - AccessPath.of_lhs_exp actual_exp actual_typ ~f_resolve_id - with Failure _ -> - None in + List.nth actuals formal_index |> + Option.value_map + ~f:(fun (actual_exp, actual_typ) -> + AccessPath.of_lhs_exp actual_exp actual_typ ~f_resolve_id ) + ~default:None in let project ~formal_ap ~actual_ap = let projected_ap = AccessPath.append actual_ap (snd (AccessPath.extract formal_ap)) in if AccessPath.is_exact formal_ap @@ -450,7 +449,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct practice. this is obviously unsound; will try to remove in the future. *) let max_calls = 3 in let targets = - if IList.length call_flags.cf_targets <= max_calls + if List.length call_flags.cf_targets <= max_calls then called_pname :: call_flags.cf_targets else diff --git a/infer/src/unit/TraceTests.ml b/infer/src/unit/TraceTests.ml index 64e898ca8..d0ac32a68 100644 --- a/infer/src/unit/TraceTests.ml +++ b/infer/src/unit/TraceTests.ml @@ -95,7 +95,7 @@ let tests = |> MockTrace.add_sink sink2 in let reports = MockTrace.get_reports trace in - assert_equal (IList.length reports) 2; + assert_equal (List.length reports) 2; assert_bool "Reports should contain source1 -> sink1" (List.exists diff --git a/infer/src/unit/accessPathTestUtils.ml b/infer/src/unit/accessPathTestUtils.ml index a811e972c..b97216e84 100644 --- a/infer/src/unit/accessPathTestUtils.ml +++ b/infer/src/unit/accessPathTestUtils.ml @@ -7,6 +7,8 @@ * of patent rights can be found in the PATENTS file in the same directory. *) +open! IStd + let make_var var_str = Pvar.mk (Mangled.from_string var_str) Procname.empty_block @@ -23,4 +25,4 @@ let make_array_access typ = AccessPath.ArrayAccess typ let make_access_path base_str access_strs = - make_base base_str, IList.map make_field_access access_strs + make_base base_str, List.map ~f:make_field_access access_strs diff --git a/infer/src/unit/accessTreeTests.ml b/infer/src/unit/accessTreeTests.ml index 7a70d7572..1231d6349 100644 --- a/infer/src/unit/accessTreeTests.ml +++ b/infer/src/unit/accessTreeTests.ml @@ -445,7 +445,7 @@ let tests = ~f:(fun (ap, trace) -> AccessPath.equal ap ap_in && MockTraceDomain.equal trace trace_in) ap_traces in - assert_bool "Should have six ap/trace pairs" (Int.equal (IList.length ap_traces) 6); + assert_bool "Should have six ap/trace pairs" (Int.equal (List.length ap_traces) 6); assert_bool "has x pair" (has_ap_trace_pair x x_trace); assert_bool "has xF pair" (has_ap_trace_pair xF xF_trace); assert_bool "has xFG pair" (has_ap_trace_pair xFG xFG_trace); diff --git a/infer/src/unit/addressTakenTests.ml b/infer/src/unit/addressTakenTests.ml index 9dc388813..f461fc2f2 100644 --- a/infer/src/unit/addressTakenTests.ml +++ b/infer/src/unit/addressTakenTests.ml @@ -22,7 +22,7 @@ let tests = let fun_ptr_typ = Typ.Tptr (Tfun false, Pk_pointer) in let closure_exp captureds = let mk_captured_var str = (Exp.Var (ident_of_str str), pvar_of_str str, int_ptr_typ) in - let captured_vars = IList.map mk_captured_var captureds in + let captured_vars = List.map ~f:mk_captured_var captureds in let closure = { Exp.name=dummy_procname; captured_vars; } in Exp.Closure closure in let test_list = [ diff --git a/infer/src/unit/analyzerTester.ml b/infer/src/unit/analyzerTester.ml index 2104957ca..62c4d2436 100644 --- a/infer/src/unit/analyzerTester.ml +++ b/infer/src/unit/analyzerTester.ml @@ -147,7 +147,7 @@ module StructuredSil = struct make_set ~rhs_typ ~lhs_exp ~rhs_exp let call_unknown ret_id_str_opt arg_strs = - let args = IList.map (fun param_str -> (var_of_str param_str, dummy_typ)) arg_strs in + let args = List.map ~f:(fun param_str -> (var_of_str param_str, dummy_typ)) arg_strs in let ret_id = Option.map ~f:(fun (str, typ) -> (ident_of_str str, typ)) ret_id_str_opt in make_call ret_id args @@ -278,7 +278,7 @@ module Make (CFG : ProcCfg.S with type node = Procdesc.Node.t) (T : TransferFunc let create_tests ?(test_pname=Procname.empty_block) ~initial ?pp_opt extras tests = let open OUnit2 in - IList.map (fun (name, test_program) -> + List.map ~f:(fun (name, test_program) -> name>::create_test test_program extras ~initial pp_opt test_pname) tests end diff --git a/infer/src/unit/livenessTests.ml b/infer/src/unit/livenessTests.ml index f1e740940..f18dd74a2 100644 --- a/infer/src/unit/livenessTests.ml +++ b/infer/src/unit/livenessTests.ml @@ -21,7 +21,7 @@ let tests = let fun_ptr_typ = Typ.Tptr (Tfun false, Pk_pointer) in let closure_exp captured_pvars = let mk_captured_var str = (Exp.Var (ident_of_str str), pvar_of_str str, dummy_typ) in - let captured_vars = IList.map mk_captured_var captured_pvars in + let captured_vars = List.map ~f:mk_captured_var captured_pvars in let closure = { Exp.name=dummy_procname; captured_vars; } in Exp.Closure closure in let unknown_cond = diff --git a/infer/src/unit/procCfgTests.ml b/infer/src/unit/procCfgTests.ml index 0ea3430d6..6bef783bd 100644 --- a/infer/src/unit/procCfgTests.ml +++ b/infer/src/unit/procCfgTests.ml @@ -162,6 +162,6 @@ let tests = ("exn_normal_succs_n1", ProcCfg.Exceptional.normal_succs exceptional_proc_cfg n1, [n2]); ("exn_normal_preds_n2", ProcCfg.Exceptional.normal_preds exceptional_proc_cfg n2, [n1]); ] - |> IList.map (fun (name, test, expected) -> name>::create_test test expected) in + |> List.map ~f:(fun (name, test, expected) -> name>::create_test test expected) in let tests = instr_test :: graph_tests in "procCfgSuite">:::tests diff --git a/infer/src/unit/schedulerTests.ml b/infer/src/unit/schedulerTests.ml index 600481834..33c05152c 100644 --- a/infer/src/unit/schedulerTests.ml +++ b/infer/src/unit/schedulerTests.ml @@ -50,12 +50,12 @@ module MockProcCfg = struct let node_id = id n in List.filter ~f:(fun (_, succs) -> - List.exists ~f:(fun node -> equal_id (id node) node_id) succs) + List.exists ~f:(fun node -> equal_id (id node) node_id) succs) t - |> IList.map fst + |> List.map ~f:fst with Not_found -> [] - let nodes t = IList.map fst t + let nodes t = List.map ~f:fst t let normal_succs = succs let normal_preds = preds @@ -133,6 +133,6 @@ let tests = (3, [7]);], [1; 2; 3; 7; 11; 10]); ] - |> IList.map - (fun (name, test, expected) -> name>::create_test test expected) in + |> List.map + ~f:(fun (name, test, expected) -> name>::create_test test expected) in "scheduler_suite">:::test_list