From 701eb20f8320f546aab500873c325d1ce2ba66b3 Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Mon, 8 Aug 2016 09:47:07 -0700 Subject: [PATCH] Refactor Sil.exp to Exp.t Summary: Create Exp module and refactor Sil.exp to Exp.t Reviewed By: cristianoc Differential Revision: D3669394 fbshipit-source-id: 1f52a90 --- infer/src/IR/Cfg.re | 66 +- infer/src/IR/Cfg.rei | 2 +- infer/src/IR/Exp.re | 52 ++ infer/src/IR/Exp.rei | 52 ++ infer/src/IR/Sil.re | 220 +++--- infer/src/IR/Sil.rei | 221 +++--- infer/src/backend/abs.ml | 118 +-- infer/src/backend/absarray.ml | 54 +- infer/src/backend/buckets.ml | 12 +- infer/src/backend/builtin.ml | 2 +- infer/src/backend/builtin.mli | 2 +- infer/src/backend/dom.ml | 361 ++++----- infer/src/backend/dotty.ml | 39 +- infer/src/backend/errdesc.ml | 132 ++-- infer/src/backend/errdesc.mli | 24 +- infer/src/backend/interproc.ml | 30 +- infer/src/backend/localise.ml | 16 +- infer/src/backend/localise.mli | 4 +- infer/src/backend/match.ml | 44 +- infer/src/backend/match.mli | 35 +- infer/src/backend/modelBuiltins.ml | 92 +-- infer/src/backend/preanal.ml | 10 +- infer/src/backend/printer.ml | 6 +- infer/src/backend/prop.ml | 764 +++++++++---------- infer/src/backend/prop.mli | 97 +-- infer/src/backend/propgraph.ml | 16 +- infer/src/backend/prover.ml | 388 +++++----- infer/src/backend/prover.mli | 26 +- infer/src/backend/rearrange.ml | 104 +-- infer/src/backend/rearrange.mli | 6 +- infer/src/backend/specs.ml | 4 +- infer/src/backend/state.ml | 7 +- infer/src/backend/state.mli | 2 +- infer/src/backend/symExec.ml | 168 ++-- infer/src/backend/symExec.mli | 6 +- infer/src/backend/tabulation.ml | 88 +-- infer/src/backend/tabulation.mli | 4 +- infer/src/backend/taint.ml | 2 +- infer/src/checkers/accessPath.ml | 8 +- infer/src/checkers/accessPath.mli | 2 +- infer/src/checkers/addressTaken.ml | 14 +- infer/src/checkers/annotationReachability.ml | 12 +- infer/src/checkers/checkTraceCallSequence.ml | 18 +- infer/src/checkers/checkers.ml | 50 +- infer/src/checkers/codeQuery.ml | 16 +- infer/src/checkers/constantPropagation.ml | 30 +- infer/src/checkers/constantPropagation.mli | 2 +- infer/src/checkers/copyPropagation.ml | 8 +- infer/src/checkers/dataflow.ml | 6 +- infer/src/checkers/idenv.ml | 10 +- infer/src/checkers/idenv.mli | 8 +- infer/src/checkers/patternMatch.ml | 24 +- infer/src/checkers/patternMatch.mli | 2 +- infer/src/checkers/printfArgs.ml | 14 +- infer/src/checkers/repeatedCallsChecker.ml | 8 +- infer/src/checkers/sqlChecker.ml | 6 +- infer/src/checkers/var.ml | 4 +- infer/src/checkers/var.mli | 2 +- infer/src/clang/cArithmetic_trans.ml | 46 +- infer/src/clang/cArithmetic_trans.mli | 10 +- infer/src/clang/cFrontend_config.mli | 2 +- infer/src/clang/cFrontend_utils.mli | 6 +- infer/src/clang/cMethod_trans.mli | 2 +- infer/src/clang/cTrans.ml | 136 ++-- infer/src/clang/cTrans_utils.ml | 56 +- infer/src/clang/cTrans_utils.mli | 38 +- infer/src/clang/cVar_decl.ml | 2 +- infer/src/clang/cVar_decl.mli | 2 +- infer/src/eradicate/eradicate.mli | 2 +- infer/src/eradicate/eradicateChecks.ml | 2 +- infer/src/eradicate/typeCheck.ml | 146 ++-- infer/src/eradicate/typeState.ml | 14 +- infer/src/eradicate/typeState.mli | 2 +- infer/src/harness/inhabit.ml | 18 +- infer/src/java/jTrans.ml | 137 ++-- infer/src/java/jTransExn.ml | 22 +- infer/src/java/jTransStaticField.ml | 6 +- infer/src/java/jTransStaticField.mli | 2 +- infer/src/java/jTransType.ml | 4 +- infer/src/java/jTransType.mli | 2 +- infer/src/llvm/lTrans.ml | 12 +- infer/src/unit/BoundedCallTreeTests.ml | 2 +- infer/src/unit/accessPathTests.ml | 12 +- infer/src/unit/addressTakenTests.ml | 6 +- infer/src/unit/analyzerTester.ml | 18 +- infer/src/unit/livenessTests.ml | 6 +- 86 files changed, 2147 insertions(+), 2086 deletions(-) create mode 100644 infer/src/IR/Exp.re create mode 100644 infer/src/IR/Exp.rei diff --git a/infer/src/IR/Cfg.re b/infer/src/IR/Cfg.re index 41fde0f92..8e30bab7f 100644 --- a/infer/src/IR/Cfg.re +++ b/infer/src/IR/Cfg.re @@ -347,7 +347,7 @@ let module Node = { switch instr { | Sil.Call _ exp _ _ _ => switch exp { - | Sil.Const (Const.Cfun procname) => [procname, ...callees] + | Exp.Const (Const.Cfun procname) => [procname, ...callees] | _ => callees } | _ => callees @@ -656,7 +656,7 @@ let module Node = { let convert_pvar pvar => Pvar.mk (Pvar.get_name pvar) resolved_proc_name; let convert_exp = fun - | Sil.Lvar origin_pvar => Sil.Lvar (convert_pvar origin_pvar) + | Exp.Lvar origin_pvar => Exp.Lvar (convert_pvar origin_pvar) | exp => exp; let extract_class_name = fun @@ -670,7 +670,7 @@ let module Node = { }; let convert_instr instrs => fun - | Sil.Letderef id (Sil.Lvar origin_pvar as origin_exp) origin_typ loc => { + | Sil.Letderef id (Exp.Lvar origin_pvar as origin_exp) origin_typ loc => { let (_, specialized_typ) = { let pvar_name = Pvar.get_name origin_pvar; try (IList.find (fun (n, _) => Mangled.equal n pvar_name) substitutions) { @@ -680,7 +680,7 @@ let module Node = { subst_map := Ident.IdentMap.add id specialized_typ !subst_map; [Sil.Letderef id (convert_exp origin_exp) specialized_typ loc, ...instrs] } - | Sil.Letderef id (Sil.Var origin_id as origin_exp) origin_typ loc => { + | Sil.Letderef id (Exp.Var origin_id as origin_exp) origin_typ loc => { let updated_typ = switch (Ident.IdentMap.find origin_id !subst_map) { | Typ.Tptr typ _ => typ @@ -700,8 +700,8 @@ let module Node = { } | Sil.Call return_ids - (Sil.Const (Const.Cfun (Procname.Java callee_pname_java))) - [(Sil.Var id, _), ...origin_args] + (Exp.Const (Const.Cfun (Procname.Java callee_pname_java))) + [(Exp.Var id, _), ...origin_args] loc call_flags when call_flags.CallFlags.cf_virtual && redirected_class_name id != None => { @@ -711,10 +711,10 @@ let module Node = { (Procname.Java callee_pname_java) (extract_class_name redirected_typ) and args = { let other_args = IList.map (fun (exp, typ) => (convert_exp exp, typ)) origin_args; - [(Sil.Var id, redirected_typ), ...other_args] + [(Exp.Var id, redirected_typ), ...other_args] }; let call_instr = - Sil.Call return_ids (Sil.Const (Const.Cfun redirected_pname)) args loc call_flags; + Sil.Call return_ids (Exp.Const (Const.Cfun redirected_pname)) args loc call_flags; [call_instr, ...instrs] } | Sil.Call return_ids origin_call_exp origin_args loc call_flags => { @@ -871,7 +871,7 @@ let get_name_of_objc_static_locals (curr_f: Procdesc.t) p => { let local_static e => switch e { /* is a local static if it's a global and it has a static local name */ - | Sil.Lvar pvar when Pvar.is_global pvar && Sil.is_static_local_name pname pvar => [pvar] + | Exp.Lvar pvar when Pvar.is_global pvar && Sil.is_static_local_name pname pvar => [pvar] | _ => [] }; let hpred_local_static hpred => @@ -887,7 +887,7 @@ let get_name_of_objc_static_locals (curr_f: Procdesc.t) p => { let get_name_of_objc_block_locals p => { let local_blocks e => switch e { - | Sil.Lvar pvar when Sil.is_block_pvar pvar => [pvar] + | Exp.Lvar pvar when Sil.is_block_pvar pvar => [pvar] | _ => [] }; let hpred_local_blocks hpred => @@ -906,7 +906,7 @@ let remove_abducted_retvars p => let (sigma, pi) = (Prop.get_sigma p, Prop.get_pi p); let rec collect_exps exps => fun - | Sil.Eexp (Sil.Exn e) _ => Sil.ExpSet.add e exps + | Sil.Eexp (Exp.Exn e) _ => Sil.ExpSet.add e exps | Sil.Eexp e _ => Sil.ExpSet.add e exps | Sil.Estruct flds _ => IList.fold_left (fun exps (_, strexp) => collect_exps exps strexp) exps flds @@ -951,11 +951,11 @@ let remove_abducted_retvars p => let rec exp_contains = fun | exp when Sil.ExpSet.mem exp reach_exps => true - | Sil.UnOp _ e _ - | Sil.Cast _ e - | Sil.Lfield e _ _ => exp_contains e - | Sil.BinOp _ e0 e1 - | Sil.Lindex e0 e1 => exp_contains e0 || exp_contains e1 + | Exp.UnOp _ e _ + | Exp.Cast _ e + | Exp.Lfield e _ _ => exp_contains e + | Exp.BinOp _ e0 e1 + | Exp.Lindex e0 e1 => exp_contains e0 || exp_contains e1 | _ => false; IList.filter ( @@ -975,7 +975,7 @@ let remove_abducted_retvars p => ( fun pvars hpred => switch hpred { - | Sil.Hpointsto (Sil.Lvar pvar) _ _ => + | Sil.Hpointsto (Exp.Lvar pvar) _ _ => let (abducteds, normal_pvars) = pvars; if (Pvar.is_abducted pvar) { ([pvar, ...abducteds], normal_pvars) @@ -990,7 +990,7 @@ let remove_abducted_retvars p => let (_, p') = Prop.deallocate_stack_vars p abducteds; let normal_pvar_set = IList.fold_left - (fun normal_pvar_set pvar => Sil.ExpSet.add (Sil.Lvar pvar) normal_pvar_set) + (fun normal_pvar_set pvar => Sil.ExpSet.add (Exp.Lvar pvar) normal_pvar_set) Sil.ExpSet.empty normal_pvars; /* walk forward from non-abducted pvars, keep everything reachable. remove everything else */ @@ -1053,7 +1053,7 @@ let remove_locals_formals (curr_f: Procdesc.t) p => { let remove_seed_vars (prop: Prop.t 'a) :Prop.t Prop.normal => { let hpred_not_seed = fun - | Sil.Hpointsto (Sil.Lvar pv) _ _ => not (Pvar.is_seed pv) + | Sil.Hpointsto (Exp.Lvar pv) _ _ => not (Pvar.is_seed pv) | _ => true; let sigma = Prop.get_sigma prop; let sigma' = IList.filter hpred_not_seed sigma; @@ -1107,7 +1107,7 @@ let remove_seed_captured_vars_block captured_vars prop => { let is_captured pname vn => Mangled.equal pname vn; let hpred_seed_captured = fun - | Sil.Hpointsto (Sil.Lvar pv) _ _ => { + | Sil.Hpointsto (Exp.Lvar pv) _ _ => { let pname = Pvar.get_name pv; Pvar.is_seed pv && IList.mem is_captured pname captured_vars } @@ -1194,33 +1194,33 @@ let inline_synthetic_method ret_ids etl proc_desc loc_call :option Sil.instr => let do_instr _ instr => switch (instr, ret_ids, etl) { | ( - Sil.Letderef _ (Sil.Lfield (Sil.Var _) fn ft) bt _, + Sil.Letderef _ (Exp.Lfield (Exp.Var _) fn ft) bt _, [ret_id], [(e1, _)] /* getter for fields */ ) => - let instr' = Sil.Letderef ret_id (Sil.Lfield e1 fn ft) bt loc_call; + let instr' = Sil.Letderef ret_id (Exp.Lfield e1 fn ft) bt loc_call; found instr instr' - | (Sil.Letderef _ (Sil.Lfield (Sil.Lvar pvar) fn ft) bt _, [ret_id], []) + | (Sil.Letderef _ (Exp.Lfield (Exp.Lvar pvar) fn ft) bt _, [ret_id], []) when Pvar.is_global pvar => /* getter for static fields */ - let instr' = Sil.Letderef ret_id (Sil.Lfield (Sil.Lvar pvar) fn ft) bt loc_call; + let instr' = Sil.Letderef ret_id (Exp.Lfield (Exp.Lvar pvar) fn ft) bt loc_call; found instr instr' | ( - Sil.Set (Sil.Lfield _ fn ft) bt _ _, + Sil.Set (Exp.Lfield _ fn ft) bt _ _, _, [(e1, _), (e2, _)] /* setter for fields */ ) => - let instr' = Sil.Set (Sil.Lfield e1 fn ft) bt e2 loc_call; + let instr' = Sil.Set (Exp.Lfield e1 fn ft) bt e2 loc_call; found instr instr' - | (Sil.Set (Sil.Lfield (Sil.Lvar pvar) fn ft) bt _ _, _, [(e1, _)]) when Pvar.is_global pvar => + | (Sil.Set (Exp.Lfield (Exp.Lvar pvar) fn ft) bt _ _, _, [(e1, _)]) when Pvar.is_global pvar => /* setter for static fields */ - let instr' = Sil.Set (Sil.Lfield (Sil.Lvar pvar) fn ft) bt e1 loc_call; + let instr' = Sil.Set (Exp.Lfield (Exp.Lvar pvar) fn ft) bt e1 loc_call; found instr instr' - | (Sil.Call ret_ids' (Sil.Const (Const.Cfun pn)) etl' _ cf, _, _) + | (Sil.Call ret_ids' (Exp.Const (Const.Cfun pn)) etl' _ cf, _, _) when IList.length ret_ids == IList.length ret_ids' && IList.length etl' == IList.length etl => - let instr' = Sil.Call ret_ids (Sil.Const (Const.Cfun pn)) etl loc_call cf; + let instr' = Sil.Call ret_ids (Exp.Const (Const.Cfun pn)) etl loc_call cf; found instr instr' - | (Sil.Call ret_ids' (Sil.Const (Const.Cfun pn)) etl' _ cf, _, _) + | (Sil.Call ret_ids' (Exp.Const (Const.Cfun pn)) etl' _ cf, _, _) when IList.length ret_ids == IList.length ret_ids' && IList.length etl' + 1 == IList.length etl => @@ -1230,7 +1230,7 @@ let inline_synthetic_method ret_ids etl proc_desc loc_call :option Sil.instr => | [_, ...l] => IList.rev l | [] => assert false }; - let instr' = Sil.Call ret_ids (Sil.Const (Const.Cfun pn)) etl1 loc_call cf; + let instr' = Sil.Call ret_ids (Exp.Const (Const.Cfun pn)) etl1 loc_call cf; found instr instr' | _ => () }; @@ -1243,7 +1243,7 @@ let inline_synthetic_method ret_ids etl proc_desc loc_call :option Sil.instr => let proc_inline_synthetic_methods cfg proc_desc :unit => { let instr_inline_synthetic_method = fun - | Sil.Call ret_ids (Sil.Const (Const.Cfun pn)) etl loc _ => + | Sil.Call ret_ids (Exp.Const (Const.Cfun pn)) etl loc _ => switch (Procdesc.find_from_name cfg pn) { | Some pd => let is_access = Procname.java_is_access_method pn; diff --git a/infer/src/IR/Cfg.rei b/infer/src/IR/Cfg.rei index 88e7d2670..e6e7d7966 100644 --- a/infer/src/IR/Cfg.rei +++ b/infer/src/IR/Cfg.rei @@ -331,4 +331,4 @@ let remove_seed_captured_vars_block: list Mangled.t => Prop.t Prop.normal => Pro (name, typ) where name is a parameter. The resulting procdesc is isomorphic but all the type of the parameters are replaced in the instructions according to the list. The virtual calls are also replaced to match the parameter types */ -let specialize_types: Procdesc.t => Procname.t => list (Sil.exp, Typ.t) => Procdesc.t; +let specialize_types: Procdesc.t => Procname.t => list (Exp.t, Typ.t) => Procdesc.t; diff --git a/infer/src/IR/Exp.re b/infer/src/IR/Exp.re new file mode 100644 index 000000000..3435a25cc --- /dev/null +++ b/infer/src/IR/Exp.re @@ -0,0 +1,52 @@ +/* + * vim: set ft=rust: + * vim: set ft=reason: + * + * Copyright (c) 2009 - 2013 Monoidics ltd. + * Copyright (c) 2013 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + */ + +open! Utils; + + +/** The Smallfoot Intermediate Language: Expressions */ +let module L = Logging; + +let module F = Format; + +type closure = {name: Procname.t, captured_vars: list (t, Pvar.t, Typ.t)} +/** dynamically determined length of an array value, if any */ +and dynamic_length = option t +/** Program expressions. */ +and t = + /** Pure variable: it is not an lvalue */ + | Var of Ident.t + /** Unary operator with type of the result if known */ + | UnOp of Unop.t t (option Typ.t) + /** Binary operator */ + | BinOp of Binop.t t t + /** Exception */ + | Exn of t + /** Anonymous function */ + | Closure of closure + /** Constants */ + | Const of Const.t + /** Type cast */ + | Cast of Typ.t t + /** The address of a program variable */ + | Lvar of Pvar.t + /** A field offset, the type is the surrounding struct type */ + | Lfield of t Ident.fieldname Typ.t + /** An array index offset: [exp1\[exp2\]] */ + | Lindex of t t + /** A sizeof expression. [Sizeof (Tarray elt (Some static_length)) (Some dynamic_length)] + represents the size of an array value consisting of [dynamic_length] elements of type [elt]. + The [dynamic_length], tracked by symbolic execution, may differ from the [static_length] + obtained from the type definition, e.g. when an array is over-allocated. For struct types, + the [dynamic_length] is that of the final extensible array, if any. */ + | Sizeof of Typ.t dynamic_length Subtype.t; diff --git a/infer/src/IR/Exp.rei b/infer/src/IR/Exp.rei new file mode 100644 index 000000000..3435a25cc --- /dev/null +++ b/infer/src/IR/Exp.rei @@ -0,0 +1,52 @@ +/* + * vim: set ft=rust: + * vim: set ft=reason: + * + * Copyright (c) 2009 - 2013 Monoidics ltd. + * Copyright (c) 2013 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + */ + +open! Utils; + + +/** The Smallfoot Intermediate Language: Expressions */ +let module L = Logging; + +let module F = Format; + +type closure = {name: Procname.t, captured_vars: list (t, Pvar.t, Typ.t)} +/** dynamically determined length of an array value, if any */ +and dynamic_length = option t +/** Program expressions. */ +and t = + /** Pure variable: it is not an lvalue */ + | Var of Ident.t + /** Unary operator with type of the result if known */ + | UnOp of Unop.t t (option Typ.t) + /** Binary operator */ + | BinOp of Binop.t t t + /** Exception */ + | Exn of t + /** Anonymous function */ + | Closure of closure + /** Constants */ + | Const of Const.t + /** Type cast */ + | Cast of Typ.t t + /** The address of a program variable */ + | Lvar of Pvar.t + /** A field offset, the type is the surrounding struct type */ + | Lfield of t Ident.fieldname Typ.t + /** An array index offset: [exp1\[exp2\]] */ + | Lindex of t t + /** A sizeof expression. [Sizeof (Tarray elt (Some static_length)) (Some dynamic_length)] + represents the size of an array value consisting of [dynamic_length] elements of type [elt]. + The [dynamic_length], tracked by symbolic execution, may differ from the [static_length] + obtained from the type definition, e.g. when an array is over-allocated. For struct types, + the [dynamic_length] is that of the final extensible array, if any. */ + | Sizeof of Typ.t dynamic_length Subtype.t; diff --git a/infer/src/IR/Sil.re b/infer/src/IR/Sil.re index d30baa035..447e889cb 100644 --- a/infer/src/IR/Sil.re +++ b/infer/src/IR/Sil.re @@ -114,38 +114,6 @@ type attribute = /** denotes an object unsubscribed from observers of a notification center */ | Aunsubscribed_observer; -type closure = {name: Procname.t, captured_vars: list (exp, Pvar.t, Typ.t)} -/** dynamically determined length of an array value, if any */ -and dynamic_length = option exp -/** Program expressions. */ -and exp = - /** Pure variable: it is not an lvalue */ - | Var of Ident.t - /** Unary operator with type of the result if known */ - | UnOp of Unop.t exp (option Typ.t) - /** Binary operator */ - | BinOp of Binop.t exp exp - /** Exception */ - | Exn of exp - /** Anonymous function */ - | Closure of closure - /** Constants */ - | Const of Const.t - /** Type cast */ - | Cast of Typ.t exp - /** The address of a program variable */ - | Lvar of Pvar.t - /** A field offset, the type is the surrounding struct type */ - | Lfield of exp Ident.fieldname Typ.t - /** An array index offset: [exp1\[exp2\]] */ - | Lindex of exp exp - /** A sizeof expression. [Sizeof (Tarray elt (Some static_length)) (Some dynamic_length)] - represents the size of an array value consisting of [dynamic_length] elements of type [elt]. - The [dynamic_length], tracked by symbolic execution, may differ from the [static_length] - obtained from the type definition, e.g. when an array is over-allocated. For struct types, - the [dynamic_length] is that of the final extensible array, if any. */ - | Sizeof of Typ.t dynamic_length Subtype.t; - /** Kind of prune instruction */ type if_kind = @@ -170,15 +138,15 @@ type instr = /** declaration [let x = *lexp:typ] where [typ] is the root type of [lexp] */ /* note for frontend writers: [x] must be used in a subsequent instruction, otherwise the entire `Letderef` instruction may be eliminated by copy-propagation */ - | Letderef of Ident.t exp Typ.t Location.t + | Letderef of Ident.t Exp.t Typ.t Location.t /** assignment [*lexp1:typ = exp2] where [typ] is the root type of [lexp1] */ - | Set of exp Typ.t exp Location.t + | Set of Exp.t Typ.t Exp.t Location.t /** prune the state based on [exp=1], the boolean indicates whether true branch */ - | Prune of exp Location.t bool if_kind + | Prune of Exp.t Location.t bool if_kind /** [Call (ret_id1..ret_idn, e_fun, arg_ts, loc, call_flags)] represents an instructions [ret_id1..ret_idn = e_fun(arg_ts);] where n = 0 for void return and n > 1 for struct return */ - | Call of (list Ident.t) exp (list (exp, Typ.t)) Location.t CallFlags.t + | Call of (list Ident.t) Exp.t (list (Exp.t, Typ.t)) Location.t CallFlags.t /** nullify stack variable */ | Nullify of Pvar.t Location.t | Abstract of Location.t /** apply abstraction */ @@ -202,16 +170,16 @@ let instr_is_auxiliary = /** offset for an lvalue */ -type offset = | Off_fld of Ident.fieldname Typ.t | Off_index of exp; +type offset = | Off_fld of Ident.fieldname Typ.t | Off_index of Exp.t; /** {2 Components of Propositions} */ /** an atom is a pure atomic formula */ type atom = - | Aeq of exp exp /** equality */ - | Aneq of exp exp /** disequality */ - | Apred of attribute (list exp) /** predicate symbol applied to exps */ - | Anpred of attribute (list exp) /** negated predicate symbol applied to exps */; + | Aeq of Exp.t Exp.t /** equality */ + | Aneq of Exp.t Exp.t /** disequality */ + | Apred of attribute (list Exp.t) /** predicate symbol applied to exps */ + | Anpred of attribute (list Exp.t) /** negated predicate symbol applied to exps */; /** kind of lseg or dllseg predicates */ @@ -247,7 +215,7 @@ type inst = /** structured expressions represent a value of structured type, such as an array or a struct. */ type strexp = - | Eexp of exp inst /** Base case: expression with instrumentation */ + | Eexp of Exp.t inst /** Base case: expression with instrumentation */ | Estruct of (list (Ident.fieldname, strexp)) inst /** C structure */ /** Array of given length There are two conditions imposed / used in the array case. @@ -256,20 +224,20 @@ type strexp = For instance, x |->[10 | e1: v1] implies that e1 <= 9. Second, if two indices appear in an array, they should be different. For instance, x |->[10 | e1: v1, e2: v2] implies that e1 != e2. */ - | Earray of exp (list (exp, strexp)) inst; + | Earray of Exp.t (list (Exp.t, strexp)) inst; /** an atomic heap predicate */ type hpred = - | Hpointsto of exp strexp exp + | Hpointsto of Exp.t strexp Exp.t /** represents [exp|->strexp:typexp] where [typexp] is an expression representing a type, e.h. [sizeof(t)]. */ - | Hlseg of lseg_kind hpara exp exp (list exp) + | Hlseg of lseg_kind hpara Exp.t Exp.t (list Exp.t) /** higher - order predicate for singly - linked lists. Should ensure that exp1!= exp2 implies that exp1 is allocated. This assumption is used in the rearrangement. The last [exp list] parameter is used to denote the shared links by all the nodes in the list. */ - | Hdllseg of lseg_kind hpara_dll exp exp exp exp (list exp) + | Hdllseg of lseg_kind hpara_dll Exp.t Exp.t Exp.t Exp.t (list Exp.t) /** higher-order predicate for doubly-linked lists. */ /** parameter for the higher-order singly-linked list predicate. Means "lambda (root,next,svars). Exists evars. body". @@ -318,9 +286,9 @@ let has_objc_ref_counter hpred => /** Returns the zero value of a type, for int, float and ptr types, None othwewise */ let zero_value_of_numerical_type_option typ => switch typ { - | Typ.Tint _ => Some (Const (Cint IntLit.zero)) - | Typ.Tfloat _ => Some (Const (Cfloat 0.0)) - | Typ.Tptr _ => Some (Const (Cint IntLit.null)) + | Typ.Tint _ => Some (Exp.Const (Cint IntLit.zero)) + | Typ.Tfloat _ => Some (Exp.Const (Cfloat 0.0)) + | Typ.Tptr _ => Some (Exp.Const (Cint IntLit.null)) | _ => None }; @@ -346,17 +314,17 @@ let is_static_local_name pname pvar => let exp_is_zero = fun - | Const (Cint n) => IntLit.iszero n + | Exp.Const (Cint n) => IntLit.iszero n | _ => false; let exp_is_null_literal = fun - | Const (Cint n) => IntLit.isnull n + | Exp.Const (Cint n) => IntLit.isnull n | _ => false; let exp_is_this = fun - | Lvar pvar => Pvar.is_this pvar + | Exp.Lvar pvar => Pvar.is_this pvar | _ => false; @@ -364,7 +332,7 @@ let exp_is_this = with respect to the first argument. It returns an expression [e'] such that BinOp([binop], [e'], [exp1]) = [exp2]. If the [binop] operation is not invertible, the function raises an exception by calling "assert false". */ -let binop_invert bop e1 e2 => BinOp (Binop.invert bop) e2 e1; +let binop_invert bop e1 e2 => Exp.BinOp (Binop.invert bop) e2 e1; let path_pos_compare (pn1, nid1) (pn2, nid2) => { let n = Procname.compare pn1 pn2; @@ -550,7 +518,7 @@ let attribute_compare (att1: attribute) (att2: attribute) :int => /** Compare epressions. Variables come before other expressions. */ -let rec exp_compare (e1: exp) (e2: exp) :int => +let rec exp_compare (e1: Exp.t) (e2: Exp.t) :int => switch (e1, e2) { | (Var id1, Var id2) => Ident.compare id2 id1 | (Var _, _) => (-1) @@ -667,7 +635,7 @@ let exp_equal e1 e2 => exp_compare e1 e2 == 0; let rec exp_is_array_index_of exp1 exp2 => switch exp1 { - | Lindex exp _ => exp_is_array_index_of exp exp2 + | Exp.Lindex exp _ => exp_is_array_index_of exp exp2 | _ => exp_equal exp1 exp2 }; @@ -912,12 +880,12 @@ let hpara_dll_equal hpara1 hpara2 => hpara_dll_compare hpara1 hpara2 == 0; /** {2 Sets of expressions} */ let module ExpSet = Set.Make { - type t = exp; + type t = Exp.t; let compare = exp_compare; }; let module ExpMap = Map.Make { - type t = exp; + type t = Exp.t; let compare = exp_compare; }; @@ -1066,7 +1034,7 @@ let rec _pp_exp pe0 pp_t f e0 => { }; if (not (exp_equal e0 e)) { switch e { - | Lvar pvar => Pvar.pp_value pe f pvar + | Exp.Lvar pvar => Pvar.pp_value pe f pvar | _ => assert false } } else { @@ -1083,17 +1051,17 @@ let rec _pp_exp pe0 pp_t f e0 => { | Ge => F.fprintf f "(%a %s %a)" pp_exp e2 (Binop.str pe Le) pp_exp e1 | _ => F.fprintf f "(%a %s %a)" pp_exp e1 (Binop.str pe op) pp_exp e2 }; - switch e { + switch (e: Exp.t) { | Var id => (Ident.pp pe) f id | Const c => F.fprintf f "%a" (Const.pp pe) c | Cast typ e => F.fprintf f "(%a)%a" pp_t typ pp_exp e | UnOp op e _ => F.fprintf f "%s%a" (Unop.str op) pp_exp e - | BinOp op (Const c) e2 when Config.smt_output => print_binop_stm_output (Const c) op e2 + | BinOp op (Const c) e2 when Config.smt_output => print_binop_stm_output (Exp.Const c) op e2 | 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; - F.fprintf f "(%a)" (pp_comma_seq pp_exp) [Const (Cfun name), ...id_exps] + F.fprintf f "(%a)" (pp_comma_seq pp_exp) [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 | Lindex e1 e2 => F.fprintf f "%a[%a]" pp_exp e1 pp_exp e2 @@ -1113,7 +1081,7 @@ let exp_to_string e => pp_to_string (pp_exp pe_text) e; /** dump an expression. */ -let d_exp (e: exp) => L.add_print_action (L.PTexp, Obj.repr e); +let d_exp (e: Exp.t) => L.add_print_action (L.PTexp, Obj.repr e); /** Pretty print a list of expressions. */ @@ -1121,11 +1089,11 @@ let pp_exp_list pe f expl => (pp_seq (pp_exp pe)) f expl; /** dump a list of expressions. */ -let d_exp_list (el: list exp) => L.add_print_action (L.PTexp_list, Obj.repr el); +let d_exp_list (el: list Exp.t) => L.add_print_action (L.PTexp_list, Obj.repr el); let pp_texp pe f => fun - | Sizeof t l s => { + | Exp.Sizeof t l s => { let pp_len f l => Option.map_default (F.fprintf f "[%a]" (pp_exp pe)) () l; F.fprintf f "%a%a%a" (Typ.pp pe) t pp_len l Subtype.pp s } @@ -1135,7 +1103,7 @@ let pp_texp pe f => /** Pretty print a type with all the details. */ let pp_texp_full pe f => fun - | Sizeof t l s => { + | Exp.Sizeof t l s => { let pp_len f l => Option.map_default (F.fprintf f "[%a]" (pp_exp pe)) () l; F.fprintf f "%a%a%a" (Typ.pp_full pe) t pp_len l Subtype.pp s } @@ -1143,7 +1111,7 @@ let pp_texp_full pe f => /** Dump a type expression with all the details. */ -let d_texp_full (te: exp) => L.add_print_action (L.PTtexp_full, Obj.repr te); +let d_texp_full (te: Exp.t) => L.add_print_action (L.PTtexp_full, Obj.repr te); /** Pretty print an offset */ @@ -1188,13 +1156,13 @@ let instr_get_loc = /** get the expressions occurring in the instruction */ let instr_get_exps = fun - | Letderef id e _ _ => [Var id, e] + | Letderef id e _ _ => [Exp.Var id, e] | Set e1 _ e2 _ => [e1, e2] | Prune cond _ _ _ => [cond] - | Call ret_ids e _ _ _ => [e, ...(IList.map (fun id => Var id)) ret_ids] - | Nullify pvar _ => [Lvar pvar] + | Call ret_ids e _ _ _ => [e, ...(IList.map (fun id => Exp.Var id)) ret_ids] + | Nullify pvar _ => [Exp.Lvar pvar] | Abstract _ => [] - | Remove_temps temps _ => IList.map (fun id => Var id) temps + | Remove_temps temps _ => IList.map (fun id => Exp.Var id) temps | Stackop _ => [] | Declare_locals _ => []; @@ -1270,8 +1238,8 @@ let pp_atom pe0 f a => { | Aeq (BinOp op e1 e2) (Const (Cint i)) when IntLit.isone i => switch pe.pe_kind { | PP_TEXT - | PP_HTML => F.fprintf f "%a" (pp_exp pe) (BinOp op e1 e2) - | PP_LATEX => F.fprintf f "%a" (pp_exp pe) (BinOp op e1 e2) + | PP_HTML => F.fprintf f "%a" (pp_exp pe) (Exp.BinOp op e1 e2) + | PP_LATEX => F.fprintf f "%a" (pp_exp pe) (Exp.BinOp op e1 e2) } | Aeq e1 e2 => switch pe.pe_kind { @@ -1855,7 +1823,7 @@ let d_hpred (hpred: hpred) => L.add_print_action (L.PThpred, Obj.repr hpred); /** {2 Functions for traversing SIL data types} */ -let rec strexp_expmap (f: (exp, option inst) => (exp, option inst)) => { +let rec strexp_expmap (f: (Exp.t, option inst) => (Exp.t, option inst)) => { let fe e => fst (f (e, None)); let fei (e, inst) => switch (f (e, Some inst)) { @@ -1881,7 +1849,7 @@ let rec strexp_expmap (f: (exp, option inst) => (exp, option inst)) => { } }; -let hpred_expmap (f: (exp, option inst) => (exp, option inst)) => { +let hpred_expmap (f: (Exp.t, option inst) => (Exp.t, option inst)) => { let fe e => fst (f (e, None)); fun | Hpointsto e se te => { @@ -1934,17 +1902,17 @@ and hpred_instmap (fn: inst => inst) (hpred: hpred) :hpred => | Hdllseg k hpar_dll e f g h el => Hdllseg k (hpara_dll_instmap fn hpar_dll) e f g h el }; -let hpred_list_expmap (f: (exp, option inst) => (exp, option inst)) (hlist: list hpred) => +let hpred_list_expmap (f: (Exp.t, option inst) => (Exp.t, option inst)) (hlist: list hpred) => IList.map (hpred_expmap f) hlist; -let atom_expmap (f: exp => exp) => +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); -let atom_list_expmap (f: exp => exp) (alist: list atom) => IList.map (atom_expmap f) alist; +let atom_list_expmap (f: Exp.t => Exp.t) (alist: list atom) => IList.map (atom_expmap f) alist; /** {2 Function for computing lexps in sigma} */ @@ -1954,7 +1922,7 @@ let hpred_get_lexp acc => | Hlseg _ _ e _ _ => [e, ...acc] | Hdllseg _ _ e1 _ _ e2 _ => [e1, e2, ...acc]; -let hpred_list_get_lexps (filter: exp => bool) (hlist: list hpred) :list exp => { +let hpred_list_get_lexps (filter: Exp.t => bool) (hlist: list hpred) :list Exp.t => { let lexps = IList.fold_left hpred_get_lexp [] hlist; IList.filter filter lexps }; @@ -1965,13 +1933,13 @@ let hpred_list_get_lexps (filter: exp => bool) (hlist: list hpred) :list exp => If not a sizeof, return the default type if given, otherwise raise an exception */ let texp_to_typ default_opt => fun - | Sizeof t _ _ => t + | Exp.Sizeof t _ _ => t | _ => Typ.unsome "texp_to_typ" default_opt; /** Return the root of [lexp]. */ let rec root_of_lexp lexp => - switch lexp { + switch (lexp: Exp.t) { | Var _ => lexp | Const _ => lexp | Cast _ e => root_of_lexp e @@ -1990,12 +1958,12 @@ let rec root_of_lexp lexp => Currently, catches array - indexing expressions such as a[i] only. */ let rec exp_pointer_arith = fun - | Lfield e _ _ => exp_pointer_arith e - | Lindex _ => true + | Exp.Lfield e _ _ => exp_pointer_arith e + | Exp.Lindex _ => true | _ => false; let exp_get_undefined footprint => - Var ( + Exp.Var ( Ident.create_fresh ( if footprint { Ident.kfootprint @@ -2007,11 +1975,11 @@ let exp_get_undefined footprint => /** Create integer constant */ -let exp_int i => Const (Cint i); +let exp_int i => Exp.Const (Cint i); /** Create float constant */ -let exp_float v => Const (Cfloat v); +let exp_float v => Exp.Const (Cfloat v); /** Integer constant 0 */ @@ -2040,24 +2008,24 @@ let exp_bool b => /** Create expresstion [e1 == e2] */ -let exp_eq e1 e2 => BinOp Eq e1 e2; +let exp_eq e1 e2 => Exp.BinOp Eq e1 e2; /** Create expresstion [e1 != e2] */ -let exp_ne e1 e2 => BinOp Ne e1 e2; +let exp_ne e1 e2 => Exp.BinOp Ne e1 e2; /** Create expression [e1 <= e2] */ -let exp_le e1 e2 => BinOp Le e1 e2; +let exp_le e1 e2 => Exp.BinOp Le e1 e2; /** Create expression [e1 < e2] */ -let exp_lt e1 e2 => BinOp Lt e1 e2; +let exp_lt e1 e2 => Exp.BinOp Lt e1 e2; /** {2 Functions for computing program variables} */ -let rec exp_fpv = - fun +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 @@ -2071,7 +2039,8 @@ let rec exp_fpv = /* TODO: Sizeof length expressions may contain variables, do not ignore them. */ /* | Sizeof _ None _ => [] */ /* | Sizeof _ (Some l) _ => exp_fpv l */ - | Sizeof _ _ _ => []; + | Sizeof _ _ _ => [] + }; let exp_list_fpv el => IList.flatten (IList.map exp_fpv el); @@ -2251,28 +2220,27 @@ let fav_subset_ident fav1 fav2 => ident_sorted_list_subset (fav_to_list fav1) (f let fav_mem fav id => IList.exists (Ident.equal id) !fav; -let rec exp_fav_add fav => - fun +let rec exp_fav_add fav e => + switch (e: Exp.t) { | Var id => fav ++ id | Exn e => exp_fav_add fav e | Closure {captured_vars} => IList.iter (fun (e, _, _) => exp_fav_add fav e) captured_vars | Const (Cint _ | Cfun _ | Cstr _ | Cfloat _ | Cclass _ | Cptr_to_fld _) => () | Cast _ e | UnOp _ e _ => exp_fav_add fav e - | BinOp _ e1 e2 => { - exp_fav_add fav e1; - exp_fav_add fav e2 - } + | BinOp _ e1 e2 => + exp_fav_add fav e1; + exp_fav_add fav e2 | Lvar _ => () /* do nothing since we only count non-program variables */ | Lfield e _ _ => exp_fav_add fav e - | Lindex e1 e2 => { - exp_fav_add fav e1; - exp_fav_add fav e2 - } + | Lindex e1 e2 => + exp_fav_add fav e1; + exp_fav_add fav e2 /* TODO: Sizeof length expressions may contain variables, do not ignore them. */ /* | Sizeof _ None _ => () */ /* | Sizeof _ (Some l) _ => exp_fav_add fav l; */ - | Sizeof _ _ _ => (); + | Sizeof _ _ _ => () + }; let exp_fav = fav_imperative_to_functional exp_fav_add; @@ -2356,7 +2324,7 @@ let array_clean_new_index footprint_part new_idx => { ); L.d_ln (); let id = Ident.create_fresh Ident.kfootprint; - Var id + Exp.Var id } else { new_idx } @@ -2465,7 +2433,7 @@ let rec sorted_list_check_consecutives f => /** substitution */ -type subst = list (Ident.t, exp); +type subst = list (Ident.t, Exp.t); /** Comparison between substitutions. */ @@ -2651,8 +2619,8 @@ let sub_fpv (sub: subst) => IList.flatten (IList.map (fun (_, e) => exp_fpv e) s /** Substitutions do not contain binders */ let sub_av_add = sub_fav_add; -let rec exp_sub_ids (f: Ident.t => exp) exp => - switch exp { +let rec exp_sub_ids (f: Ident.t => Exp.t) exp => + switch (exp: Exp.t) { | Var id => f id | Lvar _ => exp | Exn e => @@ -2660,7 +2628,7 @@ let rec exp_sub_ids (f: Ident.t => exp) exp => if (e' === e) { exp } else { - Exn e' + Exp.Exn e' } | Closure c => let captured_vars = @@ -2679,7 +2647,7 @@ let rec exp_sub_ids (f: Ident.t => exp) exp => if (captured_vars === c.captured_vars) { exp } else { - Closure {...c, captured_vars} + Exp.Closure {...c, captured_vars} } | Const (Cint _ | Cfun _ | Cstr _ | Cfloat _ | Cclass _ | Cptr_to_fld _) => exp | Cast t e => @@ -2687,14 +2655,14 @@ let rec exp_sub_ids (f: Ident.t => exp) exp => if (e' === e) { exp } else { - Cast t e' + Exp.Cast t e' } | UnOp op e typ_opt => let e' = exp_sub_ids f e; if (e' === e) { exp } else { - UnOp op e' typ_opt + Exp.UnOp op e' typ_opt } | BinOp op e1 e2 => let e1' = exp_sub_ids f e1; @@ -2702,14 +2670,14 @@ let rec exp_sub_ids (f: Ident.t => exp) exp => if (e1' === e1 && e2' === e2) { exp } else { - BinOp op e1' e2' + Exp.BinOp op e1' e2' } | Lfield e fld typ => let e' = exp_sub_ids f e; if (e' === e) { exp } else { - Lfield e' fld typ + Exp.Lfield e' fld typ } | Lindex e1 e2 => let e1' = exp_sub_ids f e1; @@ -2717,7 +2685,7 @@ let rec exp_sub_ids (f: Ident.t => exp) exp => if (e1' === e1 && e2' === e2) { exp } else { - Lindex e1' e2' + Exp.Lindex e1' e2' } | Sizeof t l_opt s => switch l_opt { @@ -2726,7 +2694,7 @@ let rec exp_sub_ids (f: Ident.t => exp) exp => if (l' === l) { exp } else { - Sizeof t (Some l') s + Exp.Sizeof t (Some l') s } | None => exp } @@ -2734,7 +2702,7 @@ let rec exp_sub_ids (f: Ident.t => exp) exp => let rec apply_sub subst id => switch subst { - | [] => Var id + | [] => Exp.Var id | [(i, e), ...l] => if (Ident.equal i id) { e @@ -2747,7 +2715,7 @@ let exp_sub (subst: subst) e => exp_sub_ids (apply_sub subst) e; /** apply [f] to id's in [instr]. if [sub_id_binders] is false, [f] is only applied to bound id's */ -let instr_sub_ids sub_id_binders::sub_id_binders (f: Ident.t => exp) instr => { +let instr_sub_ids sub_id_binders::sub_id_binders (f: Ident.t => Exp.t) instr => { let sub_id id => switch (exp_sub_ids f (Var id)) { | Var id' => id' @@ -2979,7 +2947,7 @@ let rec exp_compare_structural e1 e2 exp_map => { /* assume e1 and e2 equal, enforce by adding to [exp_map] */ (0, ExpMap.add e1 e2 exp_map) }; - switch (e1, e2) { + switch (e1: Exp.t, e2: Exp.t) { | (Var _, Var _) => compare_exps_with_map e1 e2 exp_map | (UnOp o1 e1 to1, UnOp o2 e2 to2) => let n = Unop.compare o1 o2; @@ -3256,7 +3224,7 @@ let hpred_replace_exp epairs => /** {2 Compaction} */ let module ExpHash = Hashtbl.Make { - type t = exp; + type t = Exp.t; let equal = exp_equal; let hash = Hashtbl.hash; }; @@ -3267,7 +3235,7 @@ let module HpredHash = Hashtbl.Make { let hash = Hashtbl.hash; }; -type sharing_env = {exph: ExpHash.t exp, hpredh: HpredHash.t hpred}; +type sharing_env = {exph: ExpHash.t Exp.t, hpredh: HpredHash.t hpred}; /** Create a sharing env to store canonical representations */ @@ -3315,7 +3283,7 @@ let hpred_compact sh hpred => /** Extract the ids and pvars from an expression */ let exp_get_vars exp => { let rec exp_get_vars_ exp vars => - switch exp { + switch (exp: Exp.t) { | Lvar pvar => (fst vars, [pvar, ...snd vars]) | Var id => ([id, ...fst vars], snd vars) | Cast _ e @@ -3342,7 +3310,7 @@ let exp_get_vars exp => { /** Compute the offset list of an expression */ let exp_get_offsets exp => { let rec f offlist_past e => - switch e { + switch (e: Exp.t) { | Var _ | Const _ | UnOp _ @@ -3363,8 +3331,8 @@ let exp_add_offsets exp offsets => { let rec f acc => fun | [] => acc - | [Off_fld fld typ, ...offs'] => f (Lfield acc fld typ) offs' - | [Off_index e, ...offs'] => f (Lindex acc e) offs'; + | [Off_fld fld typ, ...offs'] => f (Exp.Lfield acc fld typ) offs' + | [Off_index e, ...offs'] => f (Exp.Lindex acc e) offs'; f exp offsets }; @@ -3414,7 +3382,7 @@ let hpara_instantiate para e1 e2 elist => { IList.map g para.evars }; let subst_for_evars = { - let g id id' => (id, Var id'); + let g id id' => (id, Exp.Var id'); try (IList.map2 g para.evars ids_evars) { | Invalid_argument _ => assert false } @@ -3443,7 +3411,7 @@ let hpara_dll_instantiate (para: hpara_dll) cell blink flink elist => { IList.map g para.evars_dll }; let subst_for_evars = { - let g id id' => (id, Var id'); + let g id id' => (id, Exp.Var id'); try (IList.map2 g para.evars_dll ids_evars) { | Invalid_argument _ => assert false } diff --git a/infer/src/IR/Sil.rei b/infer/src/IR/Sil.rei index 65edd633e..dbef6bc2f 100644 --- a/infer/src/IR/Sil.rei +++ b/infer/src/IR/Sil.rei @@ -102,53 +102,21 @@ type attribute = /** denotes an object unsubscribed from observers of a notification center */ | Aunsubscribed_observer; -type closure = {name: Procname.t, captured_vars: list (exp, Pvar.t, Typ.t)} -/** dynamically determined length of an array value, if any */ -and dynamic_length = option exp -/** Program expressions. */ -and exp = - /** Pure variable: it is not an lvalue */ - | Var of Ident.t - /** Unary operator with type of the result if known */ - | UnOp of Unop.t exp (option Typ.t) - /** Binary operator */ - | BinOp of Binop.t exp exp - /** Exception */ - | Exn of exp - /** Anonymous function */ - | Closure of closure - /** Constants */ - | Const of Const.t - /** Type cast */ - | Cast of Typ.t exp - /** The address of a program variable */ - | Lvar of Pvar.t - /** A field offset, the type is the surrounding struct type */ - | Lfield of exp Ident.fieldname Typ.t - /** An array index offset: [exp1\[exp2\]] */ - | Lindex of exp exp - /** A sizeof expression. [Sizeof (Tarray elt (Some static_length)) (Some dynamic_length)] - represents the size of an array value consisting of [dynamic_length] elements of type [elt]. - The [dynamic_length], tracked by symbolic execution, may differ from the [static_length] - obtained from the type definition, e.g. when an array is over-allocated. For struct types, - the [dynamic_length] is that of the final extensible array, if any. */ - | Sizeof of Typ.t dynamic_length Subtype.t; - /** Sets of expressions. */ -let module ExpSet: Set.S with type elt = exp; +let module ExpSet: Set.S with type elt = Exp.t; /** Maps with expression keys. */ -let module ExpMap: Map.S with type key = exp; +let module ExpMap: Map.S with type key = Exp.t; /** Hashtable with expressions as keys. */ -let module ExpHash: Hashtbl.S with type key = exp; +let module ExpHash: Hashtbl.S with type key = Exp.t; /** Convert expression lists to expression sets. */ -let elist_to_eset: list exp => ExpSet.t; +let elist_to_eset: list Exp.t => ExpSet.t; /** Kind of prune instruction */ @@ -174,15 +142,15 @@ type instr = /** declaration [let x = *lexp:typ] where [typ] is the root type of [lexp] */ /* note for frontend writers: [x] must be used in a subsequent instruction, otherwise the entire `Letderef` instruction may be eliminated by copy-propagation */ - | Letderef of Ident.t exp Typ.t Location.t + | Letderef of Ident.t Exp.t Typ.t Location.t /** assignment [*lexp1:typ = exp2] where [typ] is the root type of [lexp1] */ - | Set of exp Typ.t exp Location.t + | Set of Exp.t Typ.t Exp.t Location.t /** prune the state based on [exp=1], the boolean indicates whether true branch */ - | Prune of exp Location.t bool if_kind + | Prune of Exp.t Location.t bool if_kind /** [Call (ret_id1..ret_idn, e_fun, arg_ts, loc, call_flags)] represents an instructions [ret_id1..ret_idn = e_fun(arg_ts);] where n = 0 for void return and n > 1 for struct return */ - | Call of (list Ident.t) exp (list (exp, Typ.t)) Location.t CallFlags.t + | Call of (list Ident.t) Exp.t (list (Exp.t, Typ.t)) Location.t CallFlags.t /** nullify stack variable */ | Nullify of Pvar.t Location.t | Abstract of Location.t /** apply abstraction */ @@ -196,16 +164,16 @@ let instr_is_auxiliary: instr => bool; /** Offset for an lvalue. */ -type offset = | Off_fld of Ident.fieldname Typ.t | Off_index of exp; +type offset = | Off_fld of Ident.fieldname Typ.t | Off_index of Exp.t; /** {2 Components of Propositions} */ /** an atom is a pure atomic formula */ type atom = - | Aeq of exp exp /** equality */ - | Aneq of exp exp /** disequality */ - | Apred of attribute (list exp) /** predicate symbol applied to exps */ - | Anpred of attribute (list exp) /** negated predicate symbol applied to exps */; + | Aeq of Exp.t Exp.t /** equality */ + | Aneq of Exp.t Exp.t /** disequality */ + | Apred of attribute (list Exp.t) /** predicate symbol applied to exps */ + | Anpred of attribute (list Exp.t) /** negated predicate symbol applied to exps */; /** kind of lseg or dllseg predicates */ @@ -289,7 +257,7 @@ let inst_partial_meet: inst => inst => inst; /** structured expressions represent a value of structured type, such as an array or a struct. */ type strexp = - | Eexp of exp inst /** Base case: expression with instrumentation */ + | Eexp of Exp.t inst /** Base case: expression with instrumentation */ | Estruct of (list (Ident.fieldname, strexp)) inst /** C structure */ /** Array of given length There are two conditions imposed / used in the array case. @@ -298,20 +266,20 @@ type strexp = For instance, x |->[10 | e1: v1] implies that e1 <= 9. Second, if two indices appear in an array, they should be different. For instance, x |->[10 | e1: v1, e2: v2] implies that e1 != e2. */ - | Earray of exp (list (exp, strexp)) inst; + | Earray of Exp.t (list (Exp.t, strexp)) inst; /** an atomic heap predicate */ type hpred = - | Hpointsto of exp strexp exp + | Hpointsto of Exp.t strexp Exp.t /** represents [exp|->strexp:typexp] where [typexp] is an expression representing a type, e.g. [sizeof(t)]. */ - | Hlseg of lseg_kind hpara exp exp (list exp) + | Hlseg of lseg_kind hpara Exp.t Exp.t (list Exp.t) /** higher - order predicate for singly - linked lists. Should ensure that exp1!= exp2 implies that exp1 is allocated. This assumption is used in the rearrangement. The last [exp list] parameter is used to denote the shared links by all the nodes in the list.*/ - | Hdllseg of lseg_kind hpara_dll exp exp exp exp (list exp) + | Hdllseg of lseg_kind hpara_dll Exp.t Exp.t Exp.t Exp.t (list Exp.t) /** higher-order predicate for doubly-linked lists. */ /** parameter for the higher-order singly-linked list predicate. Means "lambda (root,next,svars). Exists evars. body". @@ -352,7 +320,7 @@ let create_sharing_env: unit => sharing_env; /** Return a canonical representation of the exp */ -let exp_compact: sharing_env => exp => exp; +let exp_compact: sharing_env => Exp.t => Exp.t; /** Return a compact representation of the exp */ @@ -362,23 +330,23 @@ let hpred_compact: sharing_env => hpred => hpred; /** {2 Comparision And Inspection Functions} */ let has_objc_ref_counter: hpred => bool; -let exp_is_zero: exp => bool; +let exp_is_zero: Exp.t => bool; -let exp_is_null_literal: exp => bool; +let exp_is_null_literal: Exp.t => bool; /** return true if [exp] is the special this/self expression */ -let exp_is_this: exp => bool; +let exp_is_this: Exp.t => bool; let path_pos_equal: path_pos => path_pos => bool; /** Returns the zero value of a type, for int, float and ptr types, None othwewise */ -let zero_value_of_numerical_type_option: Typ.t => option exp; +let zero_value_of_numerical_type_option: Typ.t => option Exp.t; /** Returns the zero value of a type, for int, float and ptr types, fail otherwise */ -let zero_value_of_numerical_type: Typ.t => exp; +let zero_value_of_numerical_type: Typ.t => Exp.t; /** Make a static local name in objc */ @@ -400,7 +368,7 @@ let is_block_pvar: Pvar.t => bool; with respect to the first argument. It returns an expression [e'] such that BinOp([binop], [e'], [exp1]) = [exp2]. If the [binop] operation is not invertible, the function raises an exception by calling "assert false". */ -let binop_invert: Binop.t => exp => exp => exp; +let binop_invert: Binop.t => Exp.t => Exp.t => Exp.t; let mem_kind_compare: mem_kind => mem_kind => int; @@ -435,15 +403,15 @@ let attribute_to_category: attribute => attribute_category; let attr_is_undef: attribute => bool; -let exp_compare: exp => exp => int; +let exp_compare: Exp.t => Exp.t => int; -let exp_equal: exp => exp => bool; +let exp_equal: Exp.t => Exp.t => bool; /** exp_is_array_index_of index arr returns true is index is an array index of arr. */ -let exp_is_array_index_of: exp => exp => bool; +let exp_is_array_index_of: Exp.t => Exp.t => bool; -let exp_typ_compare: (exp, Typ.t) => (exp, Typ.t) => int; +let exp_typ_compare: (Exp.t, Typ.t) => (Exp.t, Typ.t) => int; let instr_compare: instr => instr => int; @@ -451,11 +419,11 @@ let instr_compare: instr => instr => int; /** compare instructions from different procedures without considering loc's, ident's, and pvar's. the [exp_map] param gives a mapping of names used in the procedure of [instr1] to identifiers used in the procedure of [instr2] */ -let instr_compare_structural: instr => instr => ExpMap.t exp => (int, ExpMap.t exp); +let instr_compare_structural: instr => instr => ExpMap.t Exp.t => (int, ExpMap.t Exp.t); -let exp_list_compare: list exp => list exp => int; +let exp_list_compare: list Exp.t => list Exp.t => int; -let exp_list_equal: list exp => list exp => bool; +let exp_list_equal: list Exp.t => list Exp.t => bool; let atom_compare: atom => atom => int; @@ -486,11 +454,11 @@ let fld_strexp_compare: (Ident.fieldname, strexp) => (Ident.fieldname, strexp) = let fld_strexp_list_compare: list (Ident.fieldname, strexp) => list (Ident.fieldname, strexp) => int; -let exp_strexp_compare: (exp, strexp) => (exp, strexp) => int; +let exp_strexp_compare: (Exp.t, strexp) => (Exp.t, strexp) => int; /** Return the lhs expression of a hpred */ -let hpred_get_lhs: hpred => exp; +let hpred_get_lhs: hpred => Exp.t; /** Return the value of the FA_sentinel attribute in [attr_list] if it is found */ @@ -519,39 +487,39 @@ let attribute_to_string: printenv => attribute => string; /** Pretty print an expression. */ -let pp_exp: printenv => F.formatter => exp => unit; +let pp_exp: printenv => F.formatter => Exp.t => unit; /** Pretty print an expression with type. */ -let pp_exp_typ: printenv => F.formatter => (exp, Typ.t) => unit; +let pp_exp_typ: printenv => F.formatter => (Exp.t, Typ.t) => unit; /** Convert an expression to a string */ -let exp_to_string: exp => string; +let exp_to_string: Exp.t => string; /** dump an expression. */ -let d_exp: exp => unit; +let d_exp: Exp.t => unit; /** Pretty print a type. */ -let pp_texp: printenv => F.formatter => exp => unit; +let pp_texp: printenv => F.formatter => Exp.t => unit; /** Pretty print a type with all the details. */ -let pp_texp_full: printenv => F.formatter => exp => unit; +let pp_texp_full: printenv => F.formatter => Exp.t => unit; /** Dump a type expression with all the details. */ -let d_texp_full: exp => unit; +let d_texp_full: Exp.t => unit; /** Pretty print a list of expressions. */ -let pp_exp_list: printenv => F.formatter => list exp => unit; +let pp_exp_list: printenv => F.formatter => list Exp.t => unit; /** Dump a list of expressions. */ -let d_exp_list: list exp => unit; +let d_exp_list: list Exp.t => unit; /** Pretty print an offset */ @@ -575,7 +543,7 @@ let instr_get_loc: instr => Location.t; /** get the expressions occurring in the instruction */ -let instr_get_exps: instr => list exp; +let instr_get_exps: instr => list Exp.t; /** Pretty print an instruction. */ @@ -688,17 +656,17 @@ let pp_hpred_env: printenv => option Predicates.env => F.formatter => hpred => u index. This function "cleans" [exp] according to whether it is the footprint or current part of the prop. The function faults in the re - execution mode, as an internal check of the tool. */ -let array_clean_new_index: bool => exp => exp; +let array_clean_new_index: bool => Exp.t => Exp.t; /** Change exps in strexp using [f]. */ /** WARNING: the result might not be normalized. */ -let strexp_expmap: ((exp, option inst) => (exp, option inst)) => strexp => strexp; +let strexp_expmap: ((Exp.t, option inst) => (Exp.t, option inst)) => strexp => strexp; /** Change exps in hpred by [f]. */ /** WARNING: the result might not be normalized. */ -let hpred_expmap: ((exp, option inst) => (exp, option inst)) => hpred => hpred; +let hpred_expmap: ((Exp.t, option inst) => (Exp.t, option inst)) => hpred => hpred; /** Change instrumentations in hpred using [f]. */ @@ -707,89 +675,89 @@ let hpred_instmap: (inst => inst) => hpred => hpred; /** Change exps in hpred list by [f]. */ /** WARNING: the result might not be normalized. */ -let hpred_list_expmap: ((exp, option inst) => (exp, option inst)) => list hpred => list hpred; +let hpred_list_expmap: ((Exp.t, option inst) => (Exp.t, option inst)) => list hpred => list hpred; /** Change exps in atom by [f]. */ /** WARNING: the result might not be normalized. */ -let atom_expmap: (exp => exp) => atom => atom; +let atom_expmap: (Exp.t => Exp.t) => atom => atom; /** Change exps in atom list by [f]. */ /** WARNING: the result might not be normalized. */ -let atom_list_expmap: (exp => exp) => list atom => list atom; +let atom_list_expmap: (Exp.t => Exp.t) => list atom => list atom; /** {2 Function for computing lexps in sigma} */ -let hpred_list_get_lexps: (exp => bool) => list hpred => list exp; +let hpred_list_get_lexps: (Exp.t => bool) => list hpred => list Exp.t; /** {2 Utility Functions for Expressions} */ /** Turn an expression representing a type into the type it represents If not a sizeof, return the default type if given, otherwise raise an exception */ -let texp_to_typ: option Typ.t => exp => Typ.t; +let texp_to_typ: option Typ.t => Exp.t => Typ.t; /** Return the root of [lexp]. */ -let root_of_lexp: exp => exp; +let root_of_lexp: Exp.t => Exp.t; /** Get an expression "undefined", the boolean indicates whether the undefined value goest into the footprint */ -let exp_get_undefined: bool => exp; +let exp_get_undefined: bool => Exp.t; /** Checks whether an expression denotes a location using pointer arithmetic. Currently, catches array - indexing expressions such as a[i] only. */ -let exp_pointer_arith: exp => bool; +let exp_pointer_arith: Exp.t => bool; /** Integer constant 0 */ -let exp_zero: exp; +let exp_zero: Exp.t; /** Null constant */ -let exp_null: exp; +let exp_null: Exp.t; /** Integer constant 1 */ -let exp_one: exp; +let exp_one: Exp.t; /** Integer constant -1 */ -let exp_minus_one: exp; +let exp_minus_one: Exp.t; /** Create integer constant */ -let exp_int: IntLit.t => exp; +let exp_int: IntLit.t => Exp.t; /** Create float constant */ -let exp_float: float => exp; +let exp_float: float => Exp.t; /** Create integer constant corresponding to the boolean value */ -let exp_bool: bool => exp; +let exp_bool: bool => Exp.t; /** Create expresstion [e1 == e2] */ -let exp_eq: exp => exp => exp; +let exp_eq: Exp.t => Exp.t => Exp.t; /** Create expresstion [e1 != e2] */ -let exp_ne: exp => exp => exp; +let exp_ne: Exp.t => Exp.t => Exp.t; /** Create expresstion [e1 <= e2] */ -let exp_le: exp => exp => exp; +let exp_le: Exp.t => Exp.t => Exp.t; /** Create expression [e1 < e2] */ -let exp_lt: exp => exp => exp; +let exp_lt: Exp.t => Exp.t => Exp.t; /** {2 Functions for computing program variables} */ -let exp_fpv: exp => list Pvar.t; +let exp_fpv: Exp.t => list Pvar.t; let strexp_fpv: strexp => list Pvar.t; @@ -870,13 +838,13 @@ let ident_list_fav_add: list Ident.t => fav => unit; /** [exp_fav_add fav exp] extends [fav] with the free variables of [exp] */ -let exp_fav_add: fav => exp => unit; +let exp_fav_add: fav => Exp.t => unit; -let exp_fav: exp => fav; +let exp_fav: Exp.t => fav; -let exp_fav_list: exp => list Ident.t; +let exp_fav_list: Exp.t => list Ident.t; -let ident_in_exp: Ident.t => exp => bool; +let ident_in_exp: Ident.t => Exp.t => bool; let strexp_fav_add: fav => strexp => unit; @@ -902,7 +870,7 @@ let hpara_dll_shallow_av: hpara_dll => fav; variables. Thus, the functions essentially compute all the identifiers occuring in a parameter. Some variables can appear more than once in the result. */ -let exp_av_add: fav => exp => unit; +let exp_av_add: fav => Exp.t => unit; let strexp_av_add: fav => strexp => unit; @@ -920,15 +888,15 @@ type subst; /** Create a substitution from a list of pairs. For all (id1, e1), (id2, e2) in the input list, if id1 = id2, then e1 = e2. */ -let sub_of_list: list (Ident.t, exp) => subst; +let sub_of_list: list (Ident.t, Exp.t) => subst; /** like sub_of_list, but allow duplicate ids and only keep the first occurrence */ -let sub_of_list_duplicates: list (Ident.t, exp) => subst; +let sub_of_list_duplicates: list (Ident.t, Exp.t) => subst; /** Convert a subst to a list of pairs. */ -let sub_to_list: subst => list (Ident.t, exp); +let sub_to_list: subst => list (Ident.t, Exp.t); /** The empty substitution. */ @@ -960,7 +928,7 @@ let sub_symmetric_difference: subst => subst => (subst, subst, subst); /** [sub_find filter sub] returns the expression associated to the first identifier that satisfies [filter]. Raise [Not_found] if there isn't one. */ -let sub_find: (Ident.t => bool) => subst => exp; +let sub_find: (Ident.t => bool) => subst => Exp.t; /** [sub_filter filter sub] restricts the domain of [sub] to the @@ -970,12 +938,12 @@ let sub_filter: (Ident.t => bool) => subst => subst; /** [sub_filter_exp filter sub] restricts the domain of [sub] to the identifiers satisfying [filter(id, sub(id))]. */ -let sub_filter_pair: ((Ident.t, exp) => bool) => subst => subst; +let sub_filter_pair: ((Ident.t, Exp.t) => bool) => subst => subst; /** [sub_range_partition filter sub] partitions [sub] according to whether range expressions satisfy [filter]. */ -let sub_range_partition: (exp => bool) => subst => (subst, subst); +let sub_range_partition: (Exp.t => bool) => subst => (subst, subst); /** [sub_domain_partition filter sub] partitions [sub] according to @@ -988,16 +956,16 @@ let sub_domain: subst => list Ident.t; /** Return the list of expressions in the range of the substitution. */ -let sub_range: subst => list exp; +let sub_range: subst => list Exp.t; /** [sub_range_map f sub] applies [f] to the expressions in the range of [sub]. */ -let sub_range_map: (exp => exp) => subst => subst; +let sub_range_map: (Exp.t => Exp.t) => subst => subst; /** [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: (Ident.t => Ident.t) => (exp => exp) => subst => subst; +let sub_map: (Ident.t => Ident.t) => (Exp.t => Exp.t) => subst => subst; /** Checks whether [id] belongs to the domain of [subst]. */ @@ -1005,7 +973,7 @@ let mem_sub: Ident.t => subst => bool; /** Extend substitution and return [None] if not possible. */ -let extend_sub: subst => Ident.t => exp => option subst; +let extend_sub: subst => Ident.t => Exp.t => option subst; /** Free auxilary variables in the domain and range of the @@ -1024,7 +992,7 @@ let sub_fpv: subst => list Pvar.t; /** substitution functions */ /** WARNING: these functions do not ensure that the results are normalized. */ -let exp_sub: subst => exp => exp; +let exp_sub: subst => Exp.t => Exp.t; let atom_sub: subst => atom => atom; @@ -1034,36 +1002,36 @@ let instr_sub: subst => instr => instr; let hpred_sub: subst => hpred => hpred; -let exp_sub_ids: (Ident.t => exp) => exp => exp; +let exp_sub_ids: (Ident.t => Exp.t) => Exp.t => Exp.t; /** apply [f] to id's in [instr]. if [sub_id_binders] is false, [f] is only applied to bound id's */ -let instr_sub_ids: sub_id_binders::bool => (Ident.t => exp) => instr => instr; +let instr_sub_ids: sub_id_binders::bool => (Ident.t => Exp.t) => instr => instr; /** {2 Functions for replacing occurrences of expressions.} */ /** The first parameter should define a partial function. No parts of hpara are replaced by these functions. */ -let exp_replace_exp: list (exp, exp) => exp => exp; +let exp_replace_exp: list (Exp.t, Exp.t) => Exp.t => Exp.t; -let strexp_replace_exp: list (exp, exp) => strexp => strexp; +let strexp_replace_exp: list (Exp.t, Exp.t) => strexp => strexp; -let atom_replace_exp: list (exp, exp) => atom => atom; +let atom_replace_exp: list (Exp.t, Exp.t) => atom => atom; -let hpred_replace_exp: list (exp, exp) => hpred => hpred; +let hpred_replace_exp: list (Exp.t, Exp.t) => hpred => hpred; /** {2 Functions for constructing or destructing entities in this module} */ /** Extract the ids and pvars from an expression */ -let exp_get_vars: exp => (list Ident.t, list Pvar.t); +let exp_get_vars: Exp.t => (list Ident.t, list Pvar.t); /** Compute the offset list of an expression */ -let exp_get_offsets: exp => list offset; +let exp_get_offsets: Exp.t => list offset; /** Add the offset list to an expression */ -let exp_add_offsets: exp => list offset => exp; +let exp_add_offsets: Exp.t => list offset => Exp.t; let sigma_to_sigma_ne: list hpred => list (list atom, list hpred); @@ -1072,7 +1040,7 @@ let sigma_to_sigma_ne: list hpred => list (list atom, list hpred); [e2] and [elist]. If [para = lambda (x, y, xs). exists zs. b], then the result of the instantiation is [b\[e1 / x, e2 / y, elist / xs, _zs'/ zs\]] for some fresh [_zs'].*/ -let hpara_instantiate: hpara => exp => exp => list exp => (list Ident.t, list hpred); +let hpara_instantiate: hpara => Exp.t => Exp.t => list Exp.t => (list Ident.t, list hpred); /** [hpara_dll_instantiate para cell blink flink elist] instantiates [para] with [cell], @@ -1080,6 +1048,7 @@ let hpara_instantiate: hpara => exp => exp => list exp => (list Ident.t, list hp then the result of the instantiation is [b\[cell / x, blink / y, flink / z, elist / xs, _zs'/ zs\]] for some fresh [_zs'].*/ -let hpara_dll_instantiate: hpara_dll => exp => exp => exp => list exp => (list Ident.t, list hpred); +let hpara_dll_instantiate: + hpara_dll => Exp.t => Exp.t => Exp.t => list Exp.t => (list Ident.t, list hpred); let custom_error: Pvar.t; diff --git a/infer/src/backend/abs.ml b/infer/src/backend/abs.ml index 0ac431581..e618bdce9 100644 --- a/infer/src/backend/abs.ml +++ b/infer/src/backend/abs.ml @@ -56,10 +56,10 @@ let create_fresh_primeds_ls para = let f _ = Ident.create_fresh Ident.kprimed in IList.map f svars in let ids_tuple = (id_base, id_next, id_end, ids_shared) in - let exp_base = Sil.Var id_base in - let exp_next = Sil.Var id_next in - let exp_end = Sil.Var id_end in - let exps_shared = IList.map (fun id -> Sil.Var id) 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_tuple = (exp_base, exp_next, exp_end, exps_shared) in (ids_tuple, exps_tuple) @@ -243,11 +243,11 @@ let mk_rule_ptspts_dll impl_ok1 impl_ok2 para = let svars = para.Sil.svars_dll in let f _ = Ident.create_fresh Ident.kprimed in IList.map f svars in - let exp_iF = Sil.Var id_iF in - let exp_iF' = Sil.Var id_iF' in - let exp_oB = Sil.Var id_oB in - let exp_oF = Sil.Var id_oF in - let exps_shared = IList.map (fun id -> Sil.Var id) ids_shared 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 (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 @@ -291,12 +291,12 @@ let mk_rule_ptsdll_dll k2 impl_ok1 impl_ok2 para = let svars = para.Sil.svars_dll in let f _ = Ident.create_fresh Ident.kprimed in IList.map f svars in - let exp_iF = Sil.Var id_iF in - let exp_iF' = Sil.Var id_iF' in - let exp_oB = Sil.Var id_oB in - let exp_oF = Sil.Var id_oF in - let exp_iB = Sil.Var id_iB in - let exps_shared = IList.map (fun id -> Sil.Var id) ids_shared 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 (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 @@ -327,12 +327,12 @@ let mk_rule_dllpts_dll k1 impl_ok1 impl_ok2 para = let svars = para.Sil.svars_dll in let f _ = Ident.create_fresh Ident.kprimed in IList.map f svars in - let exp_iF = Sil.Var id_iF in - let exp_iF' = Sil.Var id_iF' in - let exp_oB = Sil.Var id_oB in - let exp_oB' = Sil.Var id_oB' in - let exp_oF = Sil.Var id_oF in - let exps_shared = IList.map (fun id -> Sil.Var id) ids_shared 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 (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 @@ -361,13 +361,13 @@ let mk_rule_dlldll_dll k1 k2 impl_ok1 impl_ok2 para = let svars = para.Sil.svars_dll in let f _ = Ident.create_fresh Ident.kprimed in IList.map f svars in - let exp_iF = Sil.Var id_iF in - let exp_iF' = Sil.Var id_iF' in - let exp_oB = Sil.Var id_oB in - let exp_oB' = Sil.Var id_oB' in - let exp_oF = Sil.Var id_oF in - let exp_iB = Sil.Var id_iB in - let exps_shared = IList.map (fun id -> Sil.Var id) ids_shared 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 lseg_fst_pat = { Match.hpred = Prop.mk_dllseg 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 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,15 +420,15 @@ let typ_get_recursive_flds tenv typ_exp = false in match typ_exp with - | Sil.Sizeof (typ, _, _) -> + | Exp.Sizeof (typ, _, _) -> (match Tenv.expand_type tenv typ with | Typ.Tint _ | Typ.Tvoid | Typ.Tfun _ | Typ.Tptr _ | Typ.Tfloat _ -> [] | Typ.Tstruct { Typ.instance_fields } -> IList.map (fun (x, _, _) -> x) (IList.filter (filter typ) instance_fields) | Typ.Tarray _ -> [] | Typ.Tvar _ -> assert false) - | Sil.Var _ -> [] (* type of |-> not known yet *) - | Sil.Const _ -> [] + | Exp.Var _ -> [] (* type of |-> not known yet *) + | Exp.Const _ -> [] | _ -> L.err "@.typ_get_recursive: unexpected type expr: %a@." (Sil.pp_exp pe_text) typ_exp; assert false @@ -597,7 +597,7 @@ let eqs_sub subst eqs = IList.map (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: (Sil.exp * Sil.exp) list) : Sil.subst option = + let rec solve (sub: Sil.subst) (eqs: (Exp.t * Exp.t) list) : Sil.subst option = let do_default id e eqs_rest = if not (IList.exists (fun id' -> Ident.equal id id') ids_in) then None else @@ -610,11 +610,11 @@ let eqs_solve ids_in eqs_in = | [] -> Some sub | (e1, e2) :: eqs_rest when Sil.exp_equal e1 e2 -> solve sub eqs_rest - | (Sil.Var id1, (Sil.Const _ as e2)) :: eqs_rest -> + | (Exp.Var id1, (Exp.Const _ as e2)) :: eqs_rest -> do_default id1 e2 eqs_rest - | ((Sil.Const _ as e1), (Sil.Var _ as e2)) :: eqs_rest -> + | ((Exp.Const _ as e1), (Exp.Var _ as e2)) :: eqs_rest -> solve sub ((e2, e1):: eqs_rest) - | ((Sil.Var id1 as e1), (Sil.Var id2 as e2)) :: eqs_rest -> + | ((Exp.Var id1 as e1), (Exp.Var id2 as e2)) :: eqs_rest -> let n = Ident.compare id1 id2 in begin if n = 0 then solve sub eqs_rest @@ -777,15 +777,15 @@ let abstract_pure_part p ~(from_abstract_footprint: bool) = (fun pi a -> match a with (* we only use Lt and Le because Gt and Ge are inserted in terms of Lt and Le. *) - | Sil.Aeq (Sil.Const (Const.Cint i), Sil.BinOp (Binop.Lt, _, _)) - | Sil.Aeq (Sil.BinOp (Binop.Lt, _, _), Sil.Const (Const.Cint i)) - | Sil.Aeq (Sil.Const (Const.Cint i), Sil.BinOp (Binop.Le, _, _)) - | Sil.Aeq (Sil.BinOp (Binop.Le, _, _), Sil.Const (Const.Cint i)) when IntLit.isone i -> + | Sil.Aeq (Exp.Const (Const.Cint i), Exp.BinOp (Binop.Lt, _, _)) + | Sil.Aeq (Exp.BinOp (Binop.Lt, _, _), Exp.Const (Const.Cint i)) + | Sil.Aeq (Exp.Const (Const.Cint i), Exp.BinOp (Binop.Le, _, _)) + | Sil.Aeq (Exp.BinOp (Binop.Le, _, _), Exp.Const (Const.Cint i)) when IntLit.isone i -> a :: pi - | Sil.Aeq (Sil.Var name, e) when not (Ident.is_primed name) -> + | Sil.Aeq (Exp.Var name, e) when not (Ident.is_primed name) -> (match e with - | Sil.Var _ - | Sil.Const _ -> a :: pi + | Exp.Var _ + | Exp.Const _ -> a :: pi | _ -> pi) | Sil.Aneq (Var _, _) | Sil.Apred (_, Var _ :: _) | Anpred (_, Var _ :: _) -> a :: pi @@ -855,7 +855,7 @@ let sigma_reachable root_fav sigma = IList.iter add_entry (hpred_entries hpred) in IList.iter do_hpred sigma; let edge_fires (e, _) = match e with - | Sil.Var id -> + | Exp.Var id -> if (Ident.is_primed id || Ident.is_footprint id) then Ident.IdentSet.mem id !reach_set else true | _ -> true in @@ -873,7 +873,7 @@ let sigma_reachable root_fav sigma = if modified then find_fixpoint edges_to_revisit in find_fixpoint !edges; (* L.d_str "reachable: "; - Ident.IdentSet.iter (fun id -> Sil.d_exp (Sil.Var id); L.d_str " ") !reach_set; + Ident.IdentSet.iter (fun id -> Sil.d_exp (Exp.Var id); L.d_str " ") !reach_set; L.d_ln (); *) !reach_set @@ -912,14 +912,14 @@ let get_cycle root prop = let visited' = (fst et_src):: visited in let res = (match get_points_to e with | None -> path, false - | Some (Sil.Hpointsto (_, Sil.Estruct (fl, _), Sil.Sizeof (te, _, _))) -> + | Some (Sil.Hpointsto (_, Sil.Estruct (fl, _), Exp.Sizeof (te, _, _))) -> dfs e_root (e, te) ((et_src, f, e):: path) fl visited' | _ -> path, false (* check for lists *)) in if snd res then res else dfs e_root et_src path el' visited') in L.d_strln "Looking for cycle with root expression: "; Sil.d_hpred root; L.d_strln ""; match root with - | Sil.Hpointsto (e_root, Sil.Estruct (fl, _), Sil.Sizeof (te, _, _)) -> + | Sil.Hpointsto (e_root, Sil.Estruct (fl, _), Exp.Sizeof (te, _, _)) -> let se_root = Sil.Eexp(e_root, Sil.Inone) in (* start dfs with empty path and expr pointing to root *) let (pot_cycle, res) = dfs se_root (se_root, te) [] fl [] in @@ -937,8 +937,8 @@ let get_cycle root prop = returns the bucket *) let should_raise_objc_leak hpred = match hpred with - | Sil.Hpointsto(_, Sil.Estruct((fn, Sil.Eexp( (Sil.Const (Const.Cint i)), _)):: _, _), - Sil.Sizeof (typ, _, _)) + | Sil.Hpointsto(_, Sil.Estruct((fn, Sil.Eexp( (Exp.Const (Const.Cint i)), _)):: _, _), + Exp.Sizeof (typ, _, _)) when Ident.fieldname_is_hidden fn && IntLit.gt i IntLit.zero (* counter > 0 *) -> Mleak_buckets.should_raise_objc_leak typ | _ -> None @@ -954,11 +954,11 @@ let get_var_retain_cycle _prop = let sigma = Prop.get_sigma _prop in let is_pvar v h = match h with - | Sil.Hpointsto (Sil.Lvar _, v', _) when Sil.strexp_equal v v' -> true + | Sil.Hpointsto (Exp.Lvar _, v', _) when Sil.strexp_equal v v' -> true | _ -> false in let is_hpred_block v h = match h, v with - | Sil.Hpointsto (e, _, Sil.Sizeof (typ, _, _)), Sil.Eexp (e', _) + | Sil.Hpointsto (e, _, Exp.Sizeof (typ, _, _)), Sil.Eexp (e', _) when Sil.exp_equal e e' && Typ.is_block_type typ -> true | _, _ -> false in let find v = @@ -968,7 +968,7 @@ let get_var_retain_cycle _prop = with Not_found -> None in let find_block v = if (IList.exists (is_hpred_block v) sigma) then - Some (Sil.Lvar Sil.block_pvar) + Some (Exp.Lvar Sil.block_pvar) else None in let sexp e = Sil.Eexp (e, Sil.Inone) in let find_or_block ((e, t), f, e') = @@ -976,7 +976,7 @@ let get_var_retain_cycle _prop = | Some pvar -> [((sexp pvar, t), f, e')] | _ -> (match find_block e with | Some blk -> [((sexp blk, t), f, e')] - | _ -> [((sexp (Sil.Sizeof (t, None, Subtype.exact)), t), f, e')]) in + | _ -> [((sexp (Exp.Sizeof (t, None, Subtype.exact)), t), f, e')]) in (* returns the pvars of the first cycle we find in sigma. This is an heuristic that works if there is one cycle. In case there are more than one cycle we may return not necessarily @@ -1056,7 +1056,7 @@ let check_junk ?original_prop pname tenv prop = fun id -> Ident.IdentSet.mem id reach_set in let should_remove_hpred entries = let predicate = function - | Sil.Var id -> + | Exp.Var id -> (Ident.is_primed id || Ident.is_footprint id) && not (Sil.fav_mem fav_root id) && not (id_considered_reachable id) | _ -> false in @@ -1070,10 +1070,10 @@ let check_junk ?original_prop pname tenv prop = Ident.IdentSet.mem id set3 in let entries = hpred_entries hpred in let predicate = function - | Sil.Var id -> id_in_cycle id + | Exp.Var id -> id_in_cycle id | _ -> false in let hpred_is_loop = match hpred with (* true if hpred has a self loop, ie one field points to id *) - | Sil.Hpointsto (Sil.Var id, se, _) -> + | Sil.Hpointsto (Exp.Var id, se, _) -> let fav = Sil.fav_new () in Sil.strexp_fav_add fav se; Sil.fav_mem fav id @@ -1226,13 +1226,13 @@ let abstract_prop pname tenv ~(rename_primed: bool) ~(from_abstract_footprint: b let get_local_stack cur_sigma init_sigma = let filter_stack = function - | Sil.Hpointsto (Sil.Lvar _, _, _) -> true + | Sil.Hpointsto (Exp.Lvar _, _, _) -> true | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> false in let get_stack_var = function - | Sil.Hpointsto (Sil.Lvar pvar, _, _) -> pvar + | Sil.Hpointsto (Exp.Lvar pvar, _, _) -> pvar | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> assert false in let filter_local_stack olds = function - | Sil.Hpointsto (Sil.Lvar pvar, _, _) -> not (IList.exists (Pvar.equal pvar) olds) + | Sil.Hpointsto (Exp.Lvar pvar, _, _) -> not (IList.exists (Pvar.equal pvar) olds) | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> false in let init_stack = IList.filter filter_stack init_sigma in let init_stack_pvars = IList.map get_stack_var init_stack in @@ -1252,7 +1252,7 @@ let extract_footprint_for_abs (p : 'a Prop.t) : Prop.exposed Prop.t * Pvar.t lis let remove_local_stack sigma pvars = let filter_non_stack = function - | Sil.Hpointsto (Sil.Lvar pvar, _, _) -> not (IList.exists (Pvar.equal pvar) pvars) + | Sil.Hpointsto (Exp.Lvar pvar, _, _) -> not (IList.exists (Pvar.equal pvar) pvars) | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> true in IList.filter filter_non_stack sigma diff --git a/infer/src/backend/absarray.ml b/infer/src/backend/absarray.ml index 4e40e02de..3c7d7b382 100644 --- a/infer/src/backend/absarray.ml +++ b/infer/src/backend/absarray.ml @@ -23,10 +23,10 @@ module StrexpMatch : sig type path (** convert a path into a list of expressions *) - val path_to_exps : path -> Sil.exp list + val path_to_exps : path -> Exp.t list (** create a path from a root and a list of offsets *) - val path_from_exp_offsets : Sil.exp -> Sil.offset list -> path + val path_from_exp_offsets : Exp.t -> Sil.offset list -> path (** path to the root, length, elements and type of a new_array *) type strexp_data = path * Sil.strexp * Typ.t @@ -47,7 +47,7 @@ module StrexpMatch : sig val replace_strexp : bool -> t -> Sil.strexp -> sigma (** Replace the index in the array at a given position with the new index *) - val replace_index : bool -> t -> Sil.exp -> Sil.exp -> sigma + val replace_index : bool -> t -> Exp.t -> Exp.t -> sigma (* (** Get the partition of the sigma: the unmatched part of the sigma and the matched hpred *) val get_sigma_partition : t -> sigma * Sil.hpred @@ -58,10 +58,10 @@ module StrexpMatch : sig end = struct (** syntactic offset *) - type syn_offset = Field of Ident.fieldname * Typ.t | Index of Sil.exp + type syn_offset = Field of Ident.fieldname * Typ.t | Index of Exp.t (** path through an Estruct *) - type path = Sil.exp * (syn_offset list) + type path = Exp.t * (syn_offset list) (** Find a strexp and a type at the given syntactic offset list *) let rec get_strexp_at_syn_offsets se t syn_offs = @@ -110,10 +110,10 @@ end = struct let rec convert acc = function | [] -> acc | Field (f, t) :: syn_offs' -> - let acc' = IList.map (fun e -> Sil.Lfield (e, f, t)) acc in + let acc' = IList.map (fun e -> Exp.Lfield (e, f, t)) acc in convert acc' syn_offs' | Index idx :: syn_offs' -> - let acc' = IList.map (fun e -> Sil.Lindex (e, idx)) acc in + let acc' = IList.map (fun e -> Exp.Lindex (e, idx)) acc in convert acc' syn_offs' in begin convert [root] syn_offs_in @@ -232,7 +232,7 @@ end = struct replace_hpred (sigma, hpred, syn_offs) hpred' (** Replace the index in the array at a given position with the new index *) - let replace_index footprint_part ((sigma, hpred, syn_offs) : t) (index: Sil.exp) (index': Sil.exp) = + let replace_index footprint_part ((sigma, hpred, syn_offs) : t) (index: Exp.t) (index': Exp.t) = let update se' = match se' with | Sil.Earray (len, esel, inst) -> @@ -260,14 +260,14 @@ end let prop_replace_path_index (p: Prop.exposed Prop.t) (path: StrexpMatch.path) - (map : (Sil.exp * Sil.exp) list) : Prop.exposed Prop.t + (map : (Exp.t * Exp.t) list) : Prop.exposed Prop.t = let elist_path = StrexpMatch.path_to_exps path in let expmap_list = IList.fold_left (fun acc_outer e_path -> IList.fold_left (fun acc_inner (old_index, new_index) -> - let old_e_path_index = Prop.exp_normalize_prop p (Sil.Lindex(e_path, old_index)) in - let new_e_path_index = Prop.exp_normalize_prop p (Sil.Lindex(e_path, new_index)) in + let old_e_path_index = Prop.exp_normalize_prop p (Exp.Lindex(e_path, old_index)) in + let new_e_path_index = Prop.exp_normalize_prop p (Exp.Lindex(e_path, new_index)) in (old_e_path_index, new_e_path_index) :: acc_inner ) acc_outer map ) [] elist_path in @@ -348,13 +348,13 @@ let generic_strexp_abstract (** Return [true] if there's a pointer to the index *) -let index_is_pointed_to (p: Prop.normal Prop.t) (path: StrexpMatch.path) (index: Sil.exp) : bool = +let index_is_pointed_to (p: Prop.normal Prop.t) (path: StrexpMatch.path) (index: Exp.t) : bool = let indices = - let index_plus_one = Sil.BinOp(Binop.PlusA, index, Sil.exp_one) in + let index_plus_one = Exp.BinOp(Binop.PlusA, index, Sil.exp_one) in [index; index_plus_one] in let add_index_to_paths = let elist_path = StrexpMatch.path_to_exps path in - let add_index i e = Prop.exp_normalize_prop p (Sil.Lindex(e, i)) in + let add_index i e = Prop.exp_normalize_prop p (Exp.Lindex(e, i)) in fun i -> IList.map (add_index i) elist_path in let pointers = IList.flatten (IList.map add_index_to_paths indices) in let filter = function @@ -367,10 +367,12 @@ let index_is_pointed_to (p: Prop.normal Prop.t) (path: StrexpMatch.path) (index: let blur_array_index (p: Prop.normal Prop.t) (path: StrexpMatch.path) - (index: Sil.exp) : Prop.normal Prop.t + (index: Exp.t) : Prop.normal Prop.t = try - let fresh_index = Sil.Var (Ident.create_fresh (if !Config.footprint then Ident.kfootprint else Ident.kprimed)) in + let fresh_index = + Exp.Var + (Ident.create_fresh (if !Config.footprint then Ident.kfootprint else Ident.kprimed)) in let p2 = try if !Config.footprint then @@ -387,8 +389,8 @@ let blur_array_index let sigma' = StrexpMatch.replace_index false matched index fresh_index in Prop.replace_sigma sigma' p2 in let p4 = - let index_next = Sil.BinOp(Binop.PlusA, index, Sil.exp_one) in - let fresh_index_next = Sil.BinOp (Binop.PlusA, fresh_index, Sil.exp_one) in + let index_next = Exp.BinOp(Binop.PlusA, index, Sil.exp_one) in + let fresh_index_next = Exp.BinOp (Binop.PlusA, fresh_index, Sil.exp_one) in let map = [(index, fresh_index); (index_next, fresh_index_next)] in prop_replace_path_index p3 path map in Prop.normalize p4 @@ -399,7 +401,7 @@ let blur_array_index let blur_array_indices (p: Prop.normal Prop.t) (root: StrexpMatch.path) - (indices: Sil.exp list) : Prop.normal Prop.t * bool + (indices: Exp.t list) : Prop.normal Prop.t * bool = let f prop index = blur_array_index prop root index in (IList.fold_left f p indices, IList.length indices > 0) @@ -409,7 +411,7 @@ let blur_array_indices let keep_only_indices (p: Prop.normal Prop.t) (path: StrexpMatch.path) - (indices: Sil.exp list) : Prop.normal Prop.t * bool + (indices: Exp.t list) : Prop.normal Prop.t * bool = let prune_sigma footprint_part sigma = try @@ -496,8 +498,8 @@ let strexp_do_abstract (* array case re-execution: remove and blur constant and primed indices *) let is_pointed index = index_is_pointed_to p path index in let should_keep (index, _) = match index with - | Sil.Const _ -> is_pointed index - | Sil.Var id -> Ident.is_normal id || is_pointed index + | Exp.Const _ -> is_pointed index + | Exp.Var id -> Ident.is_normal id || is_pointed index | _ -> false in let abstract = prune_and_blur_indices path in filter_abstract Sil.d_exp_list should_keep abstract esel [] in @@ -567,8 +569,8 @@ let remove_redundant_elements 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; - (* L.d_str "favl_curr "; IList.iter (fun id -> Sil.d_exp (Sil.Var id)) favl_curr; L.d_ln(); - L.d_str "favl_foot "; IList.iter (fun id -> Sil.d_exp (Sil.Var id)) favl_foot; L.d_ln(); *) + (* L.d_str "favl_curr "; IList.iter (fun id -> Sil.d_exp (Exp.Var id)) favl_curr; L.d_ln(); + L.d_str "favl_foot "; IList.iter (fun id -> Sil.d_exp (Exp.Var id)) favl_foot; L.d_ln(); *) let num_occur l id = IList.length (IList.filter (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 @@ -581,10 +583,10 @@ let remove_redundant_elements prop = modified := true; false in match e, se with - | Sil.Const (Const.Cint i), Sil.Eexp (Sil.Var id, _) + | Exp.Const (Const.Cint i), Sil.Eexp (Exp.Var id, _) when (not fp_part || IntLit.iszero i) && not (Ident.is_normal id) && occurs_at_most_once id -> remove () (* unknown value can be removed in re-execution mode or if the index is zero *) - | Sil.Var id, Sil.Eexp _ when Ident.is_normal id = false && occurs_at_most_once id -> + | Exp.Var id, Sil.Eexp _ when Ident.is_normal id = false && occurs_at_most_once id -> remove () (* index unknown can be removed *) | _ -> true in let remove_redundant_se fp_part = function diff --git a/infer/src/backend/buckets.ml b/infer/src/backend/buckets.ml index 1ba036043..c3957d445 100644 --- a/infer/src/backend/buckets.ml +++ b/infer/src/backend/buckets.ml @@ -62,7 +62,7 @@ let check_access access_opt de_opt = IList.exists (Mangled.equal name) formal_names in let formal_ids = ref [] in let process_formal_letref = function - | Sil.Letderef (id, Sil.Lvar pvar, _, _) -> + | Sil.Letderef (id, Exp.Lvar pvar, _, _) -> let is_java_this = !Config.curr_language = Config.Java && Pvar.is_this pvar in if not is_java_this && is_formal pvar then formal_ids := id :: !formal_ids @@ -72,10 +72,10 @@ let check_access access_opt de_opt = let formal_param_used_in_call = ref false in let has_call_or_sets_null node = let rec exp_is_null exp = match exp with - | Sil.Const (Const.Cint n) -> IntLit.iszero n - | Sil.Cast (_, e) -> exp_is_null e - | Sil.Var _ - | Sil.Lvar _ -> + | Exp.Const (Const.Cint n) -> IntLit.iszero n + | Exp.Cast (_, e) -> exp_is_null e + | Exp.Var _ + | Exp.Lvar _ -> begin match State.get_const_map () node exp with | Some (Const.Cint n) -> @@ -87,7 +87,7 @@ let check_access access_opt de_opt = | Sil.Call (_, _, etl, _, _) -> let formal_ids = find_formal_ids node in let arg_is_formal_param (e, _) = match e with - | Sil.Var id -> IList.exists (Ident.equal id) formal_ids + | Exp.Var id -> IList.exists (Ident.equal id) formal_ids | _ -> false in if IList.exists arg_is_formal_param etl then formal_param_used_in_call := true; true diff --git a/infer/src/backend/builtin.ml b/infer/src/backend/builtin.ml index d6da76731..037cae452 100644 --- a/infer/src/backend/builtin.ml +++ b/infer/src/backend/builtin.ml @@ -18,7 +18,7 @@ type args = { prop_ : Prop.normal Prop.t; path : Paths.Path.t; ret_ids : Ident.t list; - args : (Sil.exp * Typ.t) list; + args : (Exp.t * Typ.t) list; proc_name : Procname.t; loc : Location.t; } diff --git a/infer/src/backend/builtin.mli b/infer/src/backend/builtin.mli index 9e407b9e6..4272bc9b3 100644 --- a/infer/src/backend/builtin.mli +++ b/infer/src/backend/builtin.mli @@ -18,7 +18,7 @@ type args = { prop_ : Prop.normal Prop.t; path : Paths.Path.t; ret_ids : Ident.t list; - args : (Sil.exp * Typ.t) list; + args : (Exp.t * Typ.t) list; proc_name : Procname.t; loc : Location.t; } diff --git a/infer/src/backend/dom.ml b/infer/src/backend/dom.ml index 8bfeebd91..f69b178c5 100644 --- a/infer/src/backend/dom.ml +++ b/infer/src/backend/dom.ml @@ -67,7 +67,7 @@ let do_side side f e1 e2 = module EPset = Set.Make (struct - type t = Sil.exp * Sil.exp + type t = Exp.t * Exp.t let compare (e1, e1') (e2, e2') = match (Sil.exp_compare e1 e2) with | i when i <> 0 -> i @@ -80,8 +80,8 @@ module NonInj : sig val init : unit -> unit val final : unit -> unit - val add : side -> Sil.exp -> Sil.exp -> unit - val check : side -> Sil.exp list -> bool + val add : side -> Exp.t -> Exp.t -> unit + val check : side -> Exp.t list -> bool end = struct @@ -104,7 +104,7 @@ end = struct let lookup' tbl e default = match e with - | Sil.Var _ -> + | Exp.Var _ -> begin try Hashtbl.find tbl e with Not_found -> (Hashtbl.replace tbl e default; default) @@ -119,7 +119,7 @@ end = struct let rec find' tbl e = let e' = lookup_equiv' tbl e in match e' with - | Sil.Var _ -> + | Exp.Var _ -> if Sil.exp_equal e e' then e else begin @@ -156,7 +156,7 @@ end = struct | Rhs -> equiv_tbl2, const_tbl2 in match e, e' with - | Sil.Var id, Sil.Var id' -> + | Exp.Var id, Exp.Var id' -> begin match can_rename id, can_rename id' with | true, true -> union' tbl const_tbl e e' @@ -164,17 +164,17 @@ end = struct | false, true -> replace_const' tbl const_tbl e' e | _ -> L.d_strln "failure reason 5"; raise IList.Fail end - | Sil.Var id, Sil.Const _ | Sil.Var id, Sil.Lvar _ -> + | 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) - | Sil.Const _, Sil.Var id' | Sil.Lvar _, Sil.Var id' -> + | 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) | _ -> if not (Sil.exp_equal e e') then (L.d_strln "failure reason 8"; raise IList.Fail) else () let check side es = - let f = function Sil.Var id -> can_rename id | _ -> false in + let f = function Exp.Var id -> can_rename id | _ -> false in let vars, nonvars = IList.partition f es in let tbl, const_tbl = match side with @@ -199,15 +199,15 @@ module type InfoLossCheckerSig = sig val init : Prop.sigma -> Prop.sigma -> unit val final : unit -> unit - val lost_little : side -> Sil.exp -> Sil.exp list -> bool - val add : side -> Sil.exp -> Sil.exp -> unit + val lost_little : side -> Exp.t -> Exp.t list -> bool + val add : side -> Exp.t -> Exp.t -> unit end module Dangling : sig val init : Prop.sigma -> Prop.sigma -> unit val final : unit -> unit - val check : side -> Sil.exp -> bool + val check : side -> Exp.t -> bool end = struct @@ -232,9 +232,9 @@ end = struct | Rhs -> !lexps2 in match e with - | Sil.Var id -> can_rename id && not (Sil.ExpSet.mem e lexps) - | Sil.Const _ -> not (Sil.ExpSet.mem e lexps) - | Sil.BinOp _ -> not (Sil.ExpSet.mem e lexps) + | Exp.Var id -> can_rename id && not (Sil.ExpSet.mem e lexps) + | Exp.Const _ -> not (Sil.ExpSet.mem e lexps) + | Exp.BinOp _ -> not (Sil.ExpSet.mem e lexps) | _ -> false end @@ -251,9 +251,9 @@ module CheckJoinPre : InfoLossCheckerSig = struct let fail_case side e es = let side_op = opposite side in match e with - | Sil.Lvar _ -> false - | Sil.Var id when Ident.is_normal id -> IList.length es >= 1 - | Sil.Var _ -> + | Exp.Lvar _ -> false + | Exp.Var id when Ident.is_normal id -> IList.length es >= 1 + | Exp.Var _ -> if Config.join_cond = 0 then IList.exists (Sil.exp_equal Sil.exp_zero) es else if Dangling.check side e then @@ -280,7 +280,7 @@ module CheckJoinPre : InfoLossCheckerSig = struct let lost_little side e es = let side_op = opposite side in - let es = match e with Sil.Const _ -> [] | _ -> es in + let es = match e with Exp.Const _ -> [] | _ -> es in if (fail_case side e es) then false else match es with @@ -300,14 +300,14 @@ module CheckJoinPost : InfoLossCheckerSig = struct let fail_case _ e es = match e with - | Sil.Lvar _ -> false - | Sil.Var id when Ident.is_normal id -> IList.length es >= 1 - | Sil.Var _ -> false + | Exp.Lvar _ -> false + | Exp.Var id when Ident.is_normal id -> IList.length es >= 1 + | Exp.Var _ -> false | _ -> false let lost_little side e es = let side_op = opposite side in - let es = match e with Sil.Const _ -> [] | _ -> es in + let es = match e with Exp.Const _ -> [] | _ -> es in if (fail_case side e es) then false else match es with @@ -321,8 +321,8 @@ module CheckJoin : sig val init : JoinState.mode -> Prop.sigma -> Prop.sigma -> unit val final : unit -> unit - val lost_little : side -> Sil.exp -> Sil.exp list -> bool - val add : side -> Sil.exp -> Sil.exp -> unit + val lost_little : side -> Exp.t -> Exp.t list -> bool + val add : side -> Exp.t -> Exp.t -> unit end = struct @@ -373,19 +373,19 @@ module CheckMeet : InfoLossCheckerSig = struct match es, e with | [], _ -> true - | [Sil.Const _], Sil.Lvar _ -> + | [Exp.Const _], Exp.Lvar _ -> false - | [Sil.Const _], Sil.Var _ -> + | [Exp.Const _], Exp.Var _ -> not (Sil.ExpSet.mem e lexps) - | [Sil.Const _], _ -> + | [Exp.Const _], _ -> assert false - | [_], Sil.Lvar _ | [_], Sil.Var _ -> + | [_], Exp.Lvar _ | [_], Exp.Var _ -> true | [_], _ -> assert false - | _, Sil.Lvar _ | _, Sil.Var _ -> + | _, Exp.Lvar _ | _, Exp.Var _ -> false - | _, Sil.Const _ -> + | _, Exp.Const _ -> assert false | _ -> assert false @@ -400,16 +400,16 @@ module Todo : sig type t val init : unit -> unit val final : unit -> unit - val reset : (Sil.exp * Sil.exp * Sil.exp) list -> unit - val push : (Sil.exp * Sil.exp * Sil.exp) -> unit - val pop : unit -> (Sil.exp * Sil.exp * Sil.exp) + val reset : (Exp.t * Exp.t * Exp.t) list -> unit + val push : (Exp.t * Exp.t * Exp.t) -> unit + val pop : unit -> (Exp.t * Exp.t * Exp.t) val set : t -> unit val take : unit -> t end = struct exception Empty - type t = (Sil.exp * Sil.exp * Sil.exp) list + type t = (Exp.t * Exp.t * Exp.t) list let tbl = ref [] @@ -434,12 +434,12 @@ end module FreshVarExp : sig val init : unit -> unit - val get_fresh_exp : Sil.exp -> Sil.exp -> Sil.exp + val get_fresh_exp : Exp.t -> Exp.t -> Exp.t val get_induced_pi : unit -> Prop.pi val final : unit -> unit (* - val lookup : side -> Sil.exp -> (Sil.exp * Sil.exp) option + val lookup : side -> Exp.t -> (Exp.t * Exp.t) option *) end = struct @@ -462,8 +462,8 @@ end = struct e let get_induced_atom acc strict_lower upper e = - let ineq_lower = Prop.mk_inequality (Sil.BinOp(Binop.Lt, strict_lower, e)) in - let ineq_upper = Prop.mk_inequality (Sil.BinOp(Binop.Le, e, upper)) in + let ineq_lower = Prop.mk_inequality (Exp.BinOp(Binop.Lt, strict_lower, e)) in + let ineq_upper = Prop.mk_inequality (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] @@ -473,10 +473,10 @@ end = struct let add_and_chk_eq e1 e1' n = match e1, e1' with - | Sil.Const (Const.Cint n1), Sil.Const (Const.Cint n1') -> IntLit.eq (n1 ++ n) n1' + | Exp.Const (Const.Cint n1), Exp.Const (Const.Cint n1') -> IntLit.eq (n1 ++ n) n1' | _ -> false in let add_and_gen_eq e e' n = - let e_plus_n = Sil.BinOp(Binop.PlusA, e, Sil.exp_int n) in + let e_plus_n = Exp.BinOp(Binop.PlusA, e, Sil.exp_int n) in Prop.mk_eq e_plus_n e' in let rec f_eqs_entry ((e1, e2, e) as entry) eqs_acc t_seen = function | [] -> eqs_acc, t_seen @@ -499,7 +499,7 @@ end = struct let f_ineqs acc (e1, e2, e) = match e1, e2 with - | Sil.Const (Const.Cint n1), Sil.Const (Const.Cint n2) -> + | Exp.Const (Const.Cint n1), Exp.Const (Const.Cint n2) -> let strict_lower1, upper1 = if IntLit.leq n1 n2 then (n1 -- IntLit.one, n2) else (n2 -- IntLit.one, n1) in let e_strict_lower1 = Sil.exp_int strict_lower1 in @@ -523,31 +523,31 @@ end module Rename : sig - type data_opt = ExtFresh | ExtDefault of Sil.exp + type data_opt = ExtFresh | ExtDefault of Exp.t val init : unit -> unit val final : unit -> unit - val reset : unit -> (Sil.exp * Sil.exp * Sil.exp) list + val reset : unit -> (Exp.t * Exp.t * Exp.t) list - val extend : Sil.exp -> Sil.exp -> data_opt -> Sil.exp - val check : (side -> Sil.exp -> Sil.exp list -> bool) -> bool + val extend : Exp.t -> Exp.t -> data_opt -> Exp.t + val check : (side -> Exp.t -> Exp.t list -> bool) -> bool - val get_others : side -> Sil.exp -> (Sil.exp * Sil.exp) option + val get_others : side -> Exp.t -> (Exp.t * Exp.t) option val get_other_atoms : side -> Sil.atom -> (Sil.atom * Sil.atom) option - val lookup : side -> Sil.exp -> Sil.exp - val lookup_list : side -> Sil.exp list -> Sil.exp list - val lookup_list_todo : side -> Sil.exp list -> Sil.exp list + val lookup : side -> Exp.t -> Exp.t + val lookup_list : side -> Exp.t list -> Exp.t list + val lookup_list_todo : side -> Exp.t list -> Exp.t list val to_subst_proj : side -> Sil.fav -> Sil.subst val to_subst_emb : side -> Sil.subst (* - val get : Sil.exp -> Sil.exp -> Sil.exp option - val pp : printenv -> Format.formatter -> (Sil.exp * Sil.exp * Sil.exp) list -> unit + val get : Exp.t -> Exp.t -> Exp.t option + val pp : printenv -> Format.formatter -> (Exp.t * Exp.t * Exp.t) list -> unit *) end = struct - type t = (Sil.exp * Sil.exp * Sil.exp) list + type t = (Exp.t * Exp.t * Exp.t) list let tbl : t ref = ref [] @@ -555,7 +555,7 @@ end = struct let final () = tbl := [] let reset () = let f = function - | Sil.Var id, e, _ | e, Sil.Var id, _ -> + | Exp.Var id, e, _ | e, Exp.Var id, _ -> (Ident.is_footprint id) && (Sil.fav_for_all (Sil.exp_fav e) (fun id -> not (Ident.is_primed id))) | _ -> false in @@ -570,9 +570,9 @@ end = struct let side_op = opposite side in let assoc_es = match e with - | Sil.Const _ -> [] - | Sil.Lvar _ | Sil.Var _ - | Sil.BinOp (Binop.PlusA, Sil.Var _, _) -> + | Exp.Const _ -> [] + | Exp.Lvar _ | Exp.Var _ + | Exp.BinOp (Binop.PlusA, Exp.Var _, _) -> let is_same_e (e1, e2, _) = Sil.exp_equal e (select side e1 e2) in let assoc = IList.filter is_same_e !tbl in IList.map (fun (e1, e2, _) -> select side_op e1 e2) assoc @@ -591,15 +591,15 @@ end = struct let lookup_side_induced' side e = let res = ref [] in let f v = match v, side with - | (Sil.BinOp (Binop.PlusA, e1', Sil.Const (Const.Cint i)), e2, e'), Lhs + | (Exp.BinOp (Binop.PlusA, e1', Exp.Const (Const.Cint i)), e2, e'), Lhs when Sil.exp_equal e e1' -> let c' = Sil.exp_int (IntLit.neg i) in - let v' = (e1', Sil.BinOp(Binop.PlusA, e2, c'), Sil.BinOp (Binop.PlusA, e', c')) in + let v' = (e1', Exp.BinOp(Binop.PlusA, e2, c'), Exp.BinOp (Binop.PlusA, e', c')) in res := v'::!res - | (e1, Sil.BinOp (Binop.PlusA, e2', Sil.Const (Const.Cint i)), e'), Rhs + | (e1, Exp.BinOp (Binop.PlusA, e2', Exp.Const (Const.Cint i)), e'), Rhs when Sil.exp_equal e e2' -> let c' = Sil.exp_int (IntLit.neg i) in - let v' = (Sil.BinOp(Binop.PlusA, e1, c'), e2', Sil.BinOp (Binop.PlusA, e', c')) in + let v' = (Exp.BinOp(Binop.PlusA, e1, c'), e2', Exp.BinOp (Binop.PlusA, e', c')) in res := v'::!res | _ -> () in begin @@ -608,16 +608,16 @@ end = struct end (* Return the triple whose side is [e], if it exists unique *) - let lookup' todo side e : Sil.exp = + let lookup' todo side e : Exp.t = match e with - | Sil.Var id when can_rename id -> + | Exp.Var id when can_rename id -> begin 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 end - | Sil.Var _ | Sil.Const _ | Sil.Lvar _ -> if todo then Todo.push (e, e, e); e + | Exp.Var _ | Exp.Const _ | Exp.Lvar _ -> if todo then Todo.push (e, e, e); e | _ -> L.d_strln "failure reason 10"; raise IList.Fail let lookup side e = lookup' false side e @@ -627,10 +627,10 @@ end = struct let to_subst_proj (side: side) vars = let renaming_restricted = - IList.filter (function (_, _, Sil.Var i) -> Sil.fav_mem vars i | _ -> assert false) !tbl in + IList.filter (function (_, _, Exp.Var i) -> Sil.fav_mem vars i | _ -> assert false) !tbl in let sub_list_side = IList.map - (function (e1, e2, Sil.Var i) -> (i, select side e1 e2) | _ -> assert false) + (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') -> Sil.exp_compare e e') sub_list_side in @@ -645,13 +645,13 @@ end = struct let renaming_restricted = let pick_id_case (e1, e2, _) = match select side e1 e2 with - | Sil.Var i -> can_rename i + | Exp.Var i -> can_rename i | _ -> false in IList.filter pick_id_case !tbl in let sub_list = let project (e1, e2, e) = match select side e1 e2 with - | Sil.Var i -> (i, e) + | Exp.Var i -> (i, e) | _ -> assert false in IList.map project renaming_restricted in let sub_list_sorted = @@ -677,14 +677,14 @@ end = struct | None -> get_others' lookup_side_induced' side e | Some _ -> others let get_others_deep side = function - | Sil.BinOp(op, e, e') -> + | Exp.BinOp(op, e, e') -> let others = get_others_direct_or_induced side e in let others' = get_others_direct_or_induced side e' in (match others, others' with | None, _ | _, None -> None | Some (e_res, e_op), Some(e_res', e_op') -> - let e_res'' = Sil.BinOp(op, e_res, e_res') in - let e_op'' = Sil.BinOp(op, e_op, e_op') in + let e_res'' = Exp.BinOp(op, e_res, e_res') in + let e_op'' = Exp.BinOp(op, e_op, e_op') in Some (e_res'', e_op'')) | _ -> None @@ -714,7 +714,7 @@ end = struct else begin match atom_in with - | Sil.Aneq((Sil.Var id as e), e') | Sil.Aneq(e', (Sil.Var id as e)) + | Sil.Aneq((Exp.Var id as e), e') | Sil.Aneq(e', (Exp.Var id as e)) when (exp_contains_only_normal_ids e' && not (Ident.is_normal id)) -> build_other_atoms (fun e0 -> Prop.mk_neq e0 e') side e @@ -726,26 +726,26 @@ end = struct when not (Ident.is_normal id) && IList.for_all exp_contains_only_normal_ids es -> build_other_atoms (fun e0 -> Prop.mk_npred a (e0 :: es)) side e - | Sil.Aeq((Sil.Var id as e), e') | Sil.Aeq(e', (Sil.Var id as e)) + | Sil.Aeq((Exp.Var id as e), e') | Sil.Aeq(e', (Exp.Var id as e)) when (exp_contains_only_normal_ids e' && not (Ident.is_normal id)) -> build_other_atoms (fun e0 -> Prop.mk_eq e0 e') side e - | Sil.Aeq(Sil.BinOp(Binop.Le, e, e'), Sil.Const (Const.Cint i)) - | Sil.Aeq(Sil.Const (Const.Cint i), Sil.BinOp(Binop.Le, e, e')) + | Sil.Aeq(Exp.BinOp(Binop.Le, e, e'), Exp.Const (Const.Cint i)) + | Sil.Aeq(Exp.Const (Const.Cint i), Exp.BinOp(Binop.Le, e, e')) when IntLit.isone i && (exp_contains_only_normal_ids e') -> - let construct e0 = Prop.mk_inequality (Sil.BinOp(Binop.Le, e0, e')) in + let construct e0 = Prop.mk_inequality (Exp.BinOp(Binop.Le, e0, e')) in build_other_atoms construct side e - | Sil.Aeq(Sil.BinOp(Binop.Lt, e', e), Sil.Const (Const.Cint i)) - | Sil.Aeq(Sil.Const (Const.Cint i), Sil.BinOp(Binop.Lt, e', e)) + | Sil.Aeq(Exp.BinOp(Binop.Lt, e', e), Exp.Const (Const.Cint i)) + | Sil.Aeq(Exp.Const (Const.Cint i), Exp.BinOp(Binop.Lt, e', e)) when IntLit.isone i && (exp_contains_only_normal_ids e') -> - let construct e0 = Prop.mk_inequality (Sil.BinOp(Binop.Lt, e', e0)) in + let construct e0 = Prop.mk_inequality (Exp.BinOp(Binop.Lt, e', e0)) in build_other_atoms construct side e | Sil.Aeq _ | Aneq _ | Apred _ | Anpred _ -> None end - type data_opt = ExtFresh | ExtDefault of Sil.exp + type data_opt = ExtFresh | ExtDefault of Exp.t (* Extend the renaming relation. At least one of e1 and e2 * should be a primed or footprint variable *) @@ -768,7 +768,7 @@ end = struct | ExtDefault e -> e | ExtFresh -> let kind = if JoinState.get_footprint () && not (some_primed ()) then Ident.kfootprint else Ident.kprimed in - Sil.Var (Ident.create_fresh kind) in + Exp.Var (Ident.create_fresh kind) in let entry = e1, e2, e in push entry; Todo.push entry; @@ -792,8 +792,8 @@ end let extend_side' kind side e = match Rename.get_others side e with | None -> - let e_op = Sil.Var (Ident.create_fresh kind) in - let e_new = Sil.Var (Ident.create_fresh kind) in + let e_op = Exp.Var (Ident.create_fresh kind) in + let e_new = Exp.Var (Ident.create_fresh kind) in let e1, e2 = match side with | Lhs -> e, e_op @@ -803,39 +803,39 @@ let extend_side' kind side e = let rec exp_construct_fresh side e = match e with - | Sil.Var id -> + | Exp.Var id -> if Ident.is_normal id then (Todo.push (e, e, e); e) else if Ident.is_footprint id then extend_side' Ident.kfootprint side e else extend_side' Ident.kprimed side e - | Sil.Const _ -> e - | Sil.Cast (t, e1) -> + | Exp.Const _ -> e + | Exp.Cast (t, e1) -> let e1' = exp_construct_fresh side e1 in - Sil.Cast (t, e1') - | Sil.UnOp(unop, e1, topt) -> + Exp.Cast (t, e1') + | Exp.UnOp(unop, e1, topt) -> let e1' = exp_construct_fresh side e1 in - Sil.UnOp(unop, e1', topt) - | Sil.BinOp(binop, e1, e2) -> + Exp.UnOp(unop, e1', topt) + | Exp.BinOp(binop, e1, e2) -> let e1' = exp_construct_fresh side e1 in let e2' = exp_construct_fresh side e2 in - Sil.BinOp(binop, e1', e2') - | Sil.Exn _ -> e - | Sil.Closure _ -> e - | Sil.Lvar _ -> + Exp.BinOp(binop, e1', e2') + | Exp.Exn _ -> e + | Exp.Closure _ -> e + | Exp.Lvar _ -> e - | Sil.Lfield(e1, fld, typ) -> + | Exp.Lfield(e1, fld, typ) -> let e1' = exp_construct_fresh side e1 in - Sil.Lfield(e1', fld, typ) - | Sil.Lindex(e1, e2) -> + Exp.Lfield(e1', fld, typ) + | Exp.Lindex(e1, e2) -> let e1' = exp_construct_fresh side e1 in let e2' = exp_construct_fresh side e2 in - Sil.Lindex(e1', e2') - | Sil.Sizeof (_, None, _) -> + Exp.Lindex(e1', e2') + | Exp.Sizeof (_, None, _) -> e - | Sil.Sizeof (typ, Some len, st) -> - Sil.Sizeof (typ, Some (exp_construct_fresh side len), st) + | Exp.Sizeof (typ, Some len, st) -> + Exp.Sizeof (typ, Some (exp_construct_fresh side len), st) let strexp_construct_fresh side = let f (e, inst_opt) = (exp_construct_fresh side e, inst_opt) in @@ -854,35 +854,35 @@ 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 Sil.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 IList.Fail) | true, _ | _, true -> - Rename.extend (Sil.Var id1) (Sil.Var id2) Rename.ExtFresh + 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) else - let e1 = Sil.Var id1 in - let e2 = Sil.Var id2 in + let e1 = Exp.Var id1 in + let e2 = Exp.Var id2 in Rename.extend e1 e2 Rename.ExtFresh end 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 Sil.Var id1 + if Ident.equal id1 id2 then Exp.Var id1 else (L.d_strln "failure reason 16"; raise IList.Fail) | true, _ -> - let e1, e2 = Sil.Var id1, Sil.Var id2 in + let e1, e2 = Exp.Var id1, Exp.Var id2 in Rename.extend e1 e2 (Rename.ExtDefault(e1)) | _, true -> - let e1, e2 = Sil.Var id1, Sil.Var id2 in + let e1, e2 = Exp.Var id1, Exp.Var id2 in Rename.extend e1 e2 (Rename.ExtDefault(e2)) | _ -> if Ident.is_primed id1 && Ident.is_primed id2 then - Rename.extend (Sil.Var id1) (Sil.Var id2) Rename.ExtFresh + Rename.extend (Exp.Var id1) (Exp.Var id2) Rename.ExtFresh else if Ident.is_footprint id1 && Ident.equal id1 id2 then - let e = Sil.Var id1 in Rename.extend e e (Rename.ExtDefault(e)) + let e = Exp.Var id1 in Rename.extend e e (Rename.ExtDefault(e)) else (L.d_strln "failure reason 17"; raise IList.Fail) @@ -896,92 +896,92 @@ let option_partial_join partial_join o1 o2 = let const_partial_join c1 c2 = let is_int = function Const.Cint _ -> true | _ -> false in - if Const.equal c1 c2 then Sil.Const c1 + 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) else if !Config.abs_val >= 2 then - FreshVarExp.get_fresh_exp (Sil.Const c1) (Sil.Const c2) + FreshVarExp.get_fresh_exp (Exp.Const c1) (Exp.Const c2) else (L.d_strln "failure reason 19"; raise IList.Fail) -let rec exp_partial_join (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = +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 (); *) match e1, e2 with - | Sil.Var id1, Sil.Var id2 -> + | Exp.Var id1, Exp.Var id2 -> ident_partial_join id1 id2 - | Sil.Var id, Sil.Const _ - | Sil.Const _, Sil.Var id -> + | 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) else Rename.extend e1 e2 Rename.ExtFresh - | Sil.Const c1, Sil.Const c2 -> + | Exp.Const c1, Exp.Const c2 -> const_partial_join c1 c2 - | Sil.Var id, Sil.Lvar _ - | Sil.Lvar _, Sil.Var id -> + | 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) else Rename.extend e1 e2 Rename.ExtFresh - | Sil.BinOp(Binop.PlusA, Sil.Var id1, Sil.Const _), Sil.Var id2 - | Sil.Var id1, Sil.BinOp(Binop.PlusA, Sil.Var id2, Sil.Const _) + | Exp.BinOp(Binop.PlusA, Exp.Var id1, Exp.Const _), Exp.Var id2 + | Exp.Var id1, Exp.BinOp(Binop.PlusA, Exp.Var id2, Exp.Const _) when ident_same_kind_primed_footprint id1 id2 -> Rename.extend e1 e2 Rename.ExtFresh - | Sil.BinOp(Binop.PlusA, Sil.Var id1, Sil.Const (Const.Cint c1)), Sil.Const (Const.Cint c2) + | Exp.BinOp(Binop.PlusA, Exp.Var id1, Exp.Const (Const.Cint c1)), Exp.Const (Const.Cint c2) when can_rename id1 -> let c2' = c2 -- c1 in - let e_res = Rename.extend (Sil.Var id1) (Sil.exp_int c2') Rename.ExtFresh in - Sil.BinOp(Binop.PlusA, e_res, Sil.exp_int c1) - | Sil.Const (Const.Cint c1), Sil.BinOp(Binop.PlusA, Sil.Var id2, Sil.Const (Const.Cint c2)) + let e_res = Rename.extend (Exp.Var id1) (Sil.exp_int c2') Rename.ExtFresh in + Exp.BinOp(Binop.PlusA, e_res, Sil.exp_int c1) + | Exp.Const (Const.Cint c1), Exp.BinOp(Binop.PlusA, Exp.Var id2, Exp.Const (Const.Cint c2)) when can_rename id2 -> let c1' = c1 -- c2 in - let e_res = Rename.extend (Sil.exp_int c1') (Sil.Var id2) Rename.ExtFresh in - Sil.BinOp(Binop.PlusA, e_res, Sil.exp_int c2) - | Sil.Cast(t1, e1), Sil.Cast(t2, e2) -> + let e_res = Rename.extend (Sil.exp_int c1') (Exp.Var id2) Rename.ExtFresh in + Exp.BinOp(Binop.PlusA, e_res, Sil.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) else let e1'' = exp_partial_join e1 e2 in - Sil.Cast (t1, e1'') - | Sil.UnOp(unop1, e1, topt1), Sil.UnOp(unop2, e2, _) -> + 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) - else Sil.UnOp (unop1, exp_partial_join e1 e2, topt1) (* should be topt1 = topt2 *) - | Sil.BinOp(Binop.PlusPI, e1, e1'), Sil.BinOp(Binop.PlusPI, e2, e2') -> + 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 let e2'' = match e1', e2' with - | Sil.Const _, Sil.Const _ -> exp_partial_join e1' e2' + | Exp.Const _, Exp.Const _ -> exp_partial_join e1' e2' | _ -> FreshVarExp.get_fresh_exp e1 e2 in - Sil.BinOp(Binop.PlusPI, e1'', e2'') - | Sil.BinOp(binop1, e1, e1'), Sil.BinOp(binop2, e2, e2') -> + 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) else let e1'' = exp_partial_join e1 e2 in let e2'' = exp_partial_join e1' e2' in - Sil.BinOp(binop1, e1'', e2'') - | Sil.Lvar(pvar1), Sil.Lvar(pvar2) -> + 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) else e1 - | Sil.Lfield(e1, f1, t1), Sil.Lfield(e2, f2, _) -> + | Exp.Lfield(e1, f1, t1), Exp.Lfield(e2, f2, _) -> if not (Ident.fieldname_equal f1 f2) then (L.d_strln "failure reason 26"; raise IList.Fail) - else Sil.Lfield(exp_partial_join e1 e2, f1, t1) (* should be t1 = t2 *) - | Sil.Lindex(e1, e1'), Sil.Lindex(e2, e2') -> + 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 let e2'' = exp_partial_join e1' e2' in - Sil.Lindex(e1'', e2'') - | Sil.Sizeof (t1, len1, st1), Sil.Sizeof (t2, len2, st2) -> - Sil.Sizeof + Exp.Lindex(e1'', e2'') + | Exp.Sizeof (t1, len1, st1), Exp.Sizeof (t2, len2, st2) -> + Exp.Sizeof (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 and length_partial_join len1 len2 = match len1, len2 with - | Sil.BinOp(Binop.PlusA, e1, Sil.Const c1), Sil.BinOp(Binop.PlusA, e2, Sil.Const c2) -> + | Exp.BinOp(Binop.PlusA, e1, Exp.Const c1), Exp.BinOp(Binop.PlusA, e2, Exp.Const c2) -> let e' = exp_partial_join e1 e2 in - let c' = exp_partial_join (Sil.Const c1) (Sil.Const c2) in - Sil.BinOp (Binop.PlusA, e', c') - | Sil.BinOp(Binop.PlusA, _, _), Sil.BinOp(Binop.PlusA, _, _) -> + let c' = exp_partial_join (Exp.Const c1) (Exp.Const c2) in + Exp.BinOp (Binop.PlusA, e', c') + | Exp.BinOp(Binop.PlusA, _, _), Exp.BinOp(Binop.PlusA, _, _) -> Rename.extend len1 len2 Rename.ExtFresh - | Sil.Var id1, Sil.Var id2 when Ident.equal id1 id2 -> + | Exp.Var id1, Exp.Var id2 when Ident.equal id1 id2 -> len1 | _ -> exp_partial_join len1 len2 @@ -1004,52 +1004,52 @@ and typ_partial_join t1 t2 = match t1, t2 with Typ.d_full t1; L.d_str " "; Typ.d_full t2; L.d_ln (); raise IList.Fail -let rec exp_partial_meet (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = +let rec exp_partial_meet (e1: Exp.t) (e2: Exp.t) : Exp.t = match e1, e2 with - | Sil.Var id1, Sil.Var id2 -> + | Exp.Var id1, Exp.Var id2 -> ident_partial_meet id1 id2 - | Sil.Var id, Sil.Const _ -> + | 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) - | Sil.Const _, Sil.Var id -> + | 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) - | Sil.Const c1, Sil.Const c2 -> + | Exp.Const c1, Exp.Const c2 -> if (Const.equal c1 c2) then e1 else (L.d_strln "failure reason 29"; raise IList.Fail) - | Sil.Cast(t1, e1), Sil.Cast(t2, e2) -> + | Exp.Cast(t1, e1), Exp.Cast(t2, e2) -> if not (Typ.equal t1 t2) then (L.d_strln "failure reason 30"; raise IList.Fail) else let e1'' = exp_partial_meet e1 e2 in - Sil.Cast (t1, e1'') - | Sil.UnOp(unop1, e1, topt1), Sil.UnOp(unop2, e2, _) -> + 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) - else Sil.UnOp (unop1, exp_partial_meet e1 e2, topt1) (* should be topt1 = topt2 *) - | Sil.BinOp(binop1, e1, e1'), Sil.BinOp(binop2, e2, e2') -> + 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) else let e1'' = exp_partial_meet e1 e2 in let e2'' = exp_partial_meet e1' e2' in - Sil.BinOp(binop1, e1'', e2'') - | Sil.Var id, Sil.Lvar _ -> + Exp.BinOp(binop1, e1'', e2'') + | 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) - | Sil.Lvar _, Sil.Var id -> + | 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) - | Sil.Lvar(pvar1), Sil.Lvar(pvar2) -> + | Exp.Lvar(pvar1), Exp.Lvar(pvar2) -> if not (Pvar.equal pvar1 pvar2) then (L.d_strln "failure reason 35"; raise IList.Fail) else e1 - | Sil.Lfield(e1, f1, t1), Sil.Lfield(e2, f2, _) -> + | Exp.Lfield(e1, f1, t1), Exp.Lfield(e2, f2, _) -> if not (Ident.fieldname_equal f1 f2) then (L.d_strln "failure reason 36"; raise IList.Fail) - else Sil.Lfield(exp_partial_meet e1 e2, f1, t1) (* should be t1 = t2 *) - | Sil.Lindex(e1, e1'), Sil.Lindex(e2, e2') -> + 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 - Sil.Lindex(e1'', e2'') + Exp.Lindex(e1'', e2'') | _ -> (L.d_strln "failure reason 37"; raise IList.Fail) let exp_list_partial_join = IList.map2 exp_partial_join @@ -1221,7 +1221,8 @@ let hpara_dll_partial_meet (hpara1: Sil.hpara_dll) (hpara2: Sil.hpara_dll) : Sil (** {2 Join and Meet for hpred} *) -let hpred_partial_join mode (todo: Sil.exp * Sil.exp * Sil.exp) (hpred1: Sil.hpred) (hpred2: Sil.hpred) : Sil.hpred = +let hpred_partial_join mode (todo: Exp.t * Exp.t * Exp.t) (hpred1: Sil.hpred) (hpred2: Sil.hpred) + : Sil.hpred = let e1, e2, e = todo in match hpred1, hpred2 with | Sil.Hpointsto (_, se1, te1), Sil.Hpointsto (_, se2, te2) -> @@ -1248,7 +1249,8 @@ let hpred_partial_join mode (todo: Sil.exp * Sil.exp * Sil.exp) (hpred1: Sil.hpr | _ -> assert false -let hpred_partial_meet (todo: Sil.exp * Sil.exp * Sil.exp) (hpred1: Sil.hpred) (hpred2: Sil.hpred) : Sil.hpred = +let hpred_partial_meet (todo: Exp.t * Exp.t * Exp.t) (hpred1: Sil.hpred) (hpred2: Sil.hpred) + : Sil.hpred = let e1, e2, e = todo in match hpred1, hpred2 with | Sil.Hpointsto (_, se1, te1), Sil.Hpointsto (_, se2, te2) when Sil.exp_equal te1 te2 -> @@ -1278,7 +1280,7 @@ let hpred_partial_meet (todo: Sil.exp * Sil.exp * Sil.exp) (hpred1: Sil.hpred) ( (** {2 Join and Meet for Sigma} *) -let find_hpred_by_address (e: Sil.exp) (sigma: Prop.sigma) : Sil.hpred option * Prop.sigma = +let find_hpred_by_address (e: Exp.t) (sigma: Prop.sigma) : Sil.hpred option * Prop.sigma = let is_root_for_e e' = match (Prover.is_root Prop.prop_emp e' e) with | None -> false @@ -1573,15 +1575,15 @@ let pi_partial_join mode (pi1: Prop.pi) (pi2: Prop.pi) : Prop.pi = let exp_is_const = function - (* | Sil.Var id -> is_normal id *) - | Sil.Const _ -> true - (* | Sil.Lvar _ -> true *) + (* | Exp.Var id -> is_normal id *) + | Exp.Const _ -> true + (* | Exp.Lvar _ -> true *) | _ -> false in let get_array_len prop = (* find some array length in the prop, to be used as heuritic for upper bound in widening *) let len_list = ref [] in let do_hpred = function - | Sil.Hpointsto (_, Sil.Earray (Sil.Const (Const.Cint n), _, _), _) -> + | Sil.Hpointsto (_, Sil.Earray (Exp.Const (Const.Cint n), _, _), _) -> (if IntLit.geq n IntLit.one then len_list := n :: !len_list) | _ -> () in IList.iter do_hpred (Prop.get_sigma prop); @@ -1601,11 +1603,11 @@ let pi_partial_join mode if IntLit.leq n first_try then if IntLit.leq n second_try then second_try else first_try else widening_top in - let a' = Prop.mk_inequality (Sil.BinOp(Binop.Le, e, Sil.exp_int bound)) in + let a' = Prop.mk_inequality (Exp.BinOp(Binop.Le, e, Sil.exp_int bound)) in Some a' | Some (e, _), [] -> let bound = widening_top in - let a' = Prop.mk_inequality (Sil.BinOp(Binop.Le, e, Sil.exp_int bound)) in + let a' = Prop.mk_inequality (Exp.BinOp(Binop.Le, e, Sil.exp_int bound)) in Some a' | _ -> begin @@ -1614,7 +1616,7 @@ let pi_partial_join mode | Some (n, e) -> let bound = if IntLit.leq IntLit.minus_one n then IntLit.minus_one else widening_bottom in - let a' = Prop.mk_inequality (Sil.BinOp(Binop.Lt, Sil.exp_int bound, e)) in + let a' = Prop.mk_inequality (Exp.BinOp(Binop.Lt, Sil.exp_int bound, e)) in Some a' end in let is_stronger_le e n a = @@ -1668,8 +1670,8 @@ let pi_partial_join mode | Sil.Aneq(e, e') | Sil.Aeq(e, e') when (exp_is_const e && exp_is_const e') -> true - | Sil.Aneq(Sil.Var _, e') | Sil.Aneq(e', Sil.Var _) - | Sil.Aeq(Sil.Var _, e') | Sil.Aeq(e', Sil.Var _) + | Sil.Aneq(Exp.Var _, e') | Sil.Aneq(e', Exp.Var _) + | Sil.Aeq(Exp.Var _, e') | Sil.Aeq(e', Exp.Var _) when (exp_is_const e') -> true | Sil.Aneq _ -> false @@ -1792,7 +1794,8 @@ let eprop_partial_join' mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed Prop. let f e = Sil.fav_for_all (Sil.exp_fav e) Ident.is_normal in Sil.sub_range_partition f sub_common in let eqs1, eqs2 = - let sub_to_eqs sub = IList.map (fun (id, e) -> Sil.Aeq(Sil.Var id, e)) (Sil.sub_to_list sub) in + let sub_to_eqs sub = + IList.map (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 diff --git a/infer/src/backend/dotty.ml b/infer/src/backend/dotty.ml index 9168c52be..df9419d16 100644 --- a/infer/src/backend/dotty.ml +++ b/infer/src/backend/dotty.ml @@ -59,18 +59,19 @@ type link = { type dotty_node = | Dotnil of coordinate (* nil box *) (* Dotdangling(coo,e,c): dangling box for expression e at coordinate coo and color c *) - | Dotdangling of coordinate * Sil.exp * string + | Dotdangling of coordinate * Exp.t * string (* Dotpointsto(coo,e,c): basic memory cell box for expression e at coordinate coo and color c *) - | Dotpointsto of coordinate * Sil.exp * string + | Dotpointsto of coordinate * Exp.t * string (* Dotstruct(coo,e,l,c): struct box for expression e with field list l at coordinate coo and color c *) - | Dotstruct of coordinate * Sil.exp * (Ident.fieldname * Sil.strexp) list * string * Sil.exp + | Dotstruct of coordinate * Exp.t * (Ident.fieldname * Sil.strexp) list * string * Exp.t (* Dotarray(coo,e1,e2,l,t,c): array box for expression e1 with field list l at coordinate coo and color c*) (* e2 is the len and t is the type *) - | Dotarray of coordinate * Sil.exp * Sil.exp * (Sil.exp * Sil.strexp) list * Typ.t * string + | Dotarray of coordinate * Exp.t * Exp.t * (Exp.t * Sil.strexp) list * Typ.t * string (* Dotlseg(coo,e1,e2,k,h,c): list box from e1 to e2 at coordinate coo and color c*) - | Dotlseg of coordinate * Sil.exp * Sil.exp * Sil.lseg_kind * Sil.hpred list * string + | Dotlseg of coordinate * Exp.t * Exp.t * Sil.lseg_kind * Sil.hpred list * string (* Dotlseg(coo,e1,e2,e3,e4,k,h,c): doubly linked-list box from with parameters (e1,e2,e3,e4) at coordinate coo and color c*) - | Dotdllseg of coordinate * Sil.exp * Sil.exp * Sil.exp * Sil.exp * Sil.lseg_kind * Sil.hpred list * string + | Dotdllseg of + coordinate * Exp.t * Exp.t * Exp.t * Exp.t * Sil.lseg_kind * Sil.hpred list * string let mk_coordinate i l = { id = i; lambda = l } @@ -127,8 +128,8 @@ let strip_special_chars s = let rec strexp_to_string pe coo f se = match se with - | Sil.Eexp (Sil.Lvar pvar, _) -> F.fprintf f "%a" (Pvar.pp pe) pvar - | Sil.Eexp (Sil.Var id, _) -> + | Sil.Eexp (Exp.Lvar pvar, _) -> F.fprintf f "%a" (Pvar.pp pe) pvar + | Sil.Eexp (Exp.Var id, _) -> if !print_full_prop then F.fprintf f "%a" (Ident.pp pe) id else () @@ -235,7 +236,7 @@ let color_to_str c = | Red -> "red" let make_dangling_boxes pe allocated_nodes (sigma_lambda: (Sil.hpred * int) list) = - let exp_color hpred (exp : Sil.exp) = + let exp_color hpred (exp : Exp.t) = if pe.pe_cmap_norm (Obj.repr hpred) == Red then Red else pe.pe_cmap_norm (Obj.repr exp) in let get_rhs_predicate (hpred, lambda) = @@ -294,7 +295,7 @@ let rec dotty_mk_node pe sigma = let n = !dotty_state_count in incr dotty_state_count; let do_hpred_lambda exp_color = function - | (Sil.Hpointsto (e, Sil.Earray (e', l, _), Sil.Sizeof (Typ.Tarray (t, _), _, _)), lambda) -> + | (Sil.Hpointsto (e, Sil.Earray (e', l, _), Exp.Sizeof (Typ.Tarray (t, _), _, _)), lambda) -> incr dotty_state_count; (* increment once more n+1 is the box for the array *) let e_color_str = color_to_str (exp_color e) in let e_color_str'= color_to_str (exp_color e') in @@ -320,14 +321,14 @@ let rec dotty_mk_node pe sigma = match sigma with | [] -> [] | (hpred, lambda) :: sigma' -> - let exp_color (exp : Sil.exp) = + let exp_color (exp : Exp.t) = if pe.pe_cmap_norm (Obj.repr hpred) == Red then Red else pe.pe_cmap_norm (Obj.repr exp) in do_hpred_lambda exp_color (hpred, lambda) @ dotty_mk_node pe sigma' let set_exps_neq_zero pi = let f = function - | Sil.Aneq (e, Sil.Const (Const.Cint i)) when IntLit.iszero i -> + | Sil.Aneq (e, Exp.Const (Const.Cint i)) when IntLit.iszero i -> exps_neq_zero := e :: !exps_neq_zero | _ -> () in exps_neq_zero := []; @@ -650,7 +651,7 @@ let filter_useless_spec_dollar_box (nodes: dotty_node list) (links: link list) = l:: boxes_pointing_at n ln' ) else boxes_pointing_at n ln' in let is_spec_variable = function - | Sil.Var id -> + | Exp.Var id -> Ident.is_normal id && Ident.name_equal (Ident.get_name id) Ident.name_spec | _ -> false in let handle_one_node node = @@ -674,7 +675,7 @@ let filter_useless_spec_dollar_box (nodes: dotty_node list) (links: link list) = (* print a struct node *) let rec print_struct f pe e te l coo c = let print_type = match te with - | Sil.Sizeof (t, _, _) -> + | Exp.Sizeof (t, _, _) -> let str_t = Typ.to_string t in (match Str.split_delim (Str.regexp_string Config.anonymous_block_prefix) str_t with | [_; _] -> "BLOCK object" @@ -1076,11 +1077,11 @@ let pp_speclist_dotty_file (filename : DB.filename) spec_list = (* each node has an unique integer identifier *) type visual_heap_node = - | VH_dangling of int * Sil.exp - | VH_pointsto of int * Sil.exp * Sil.strexp * Sil.exp (* VH_pointsto(id,address,content,type) *) - | VH_lseg of int * Sil.exp * Sil.exp * Sil.lseg_kind (*VH_lseg(id,address,content last cell, kind) *) + | VH_dangling of int * Exp.t + | VH_pointsto of int * Exp.t * Sil.strexp * Exp.t (* VH_pointsto(id,address,content,type) *) + | VH_lseg of int * Exp.t * Exp.t * Sil.lseg_kind (*VH_lseg(id,address,content last cell, kind) *) (*VH_dllseg(id, address, content first cell, content last cell, address last cell, kind) *) - | VH_dllseg of int * Sil.exp * Sil.exp * Sil.exp * Sil.exp * Sil.lseg_kind + | VH_dllseg of int * Exp.t * Exp.t * Exp.t * Exp.t * Sil.lseg_kind (* an edge is a pair of node identifiers*) type visual_heap_edge = { @@ -1321,7 +1322,7 @@ let xml_pure_info prop = (** Return a string describing the kind of a pointsto address *) let pointsto_addr_kind = function - | Sil.Lvar pv -> + | Exp.Lvar pv -> if Pvar.is_global pv then "global" else if Pvar.is_local pv && Mangled.equal (Pvar.get_name pv) Ident.name_return diff --git a/infer/src/backend/errdesc.ml b/infer/src/backend/errdesc.ml index b7a3e23dd..54e1ea12e 100644 --- a/infer/src/backend/errdesc.ml +++ b/infer/src/backend/errdesc.ml @@ -74,7 +74,7 @@ let explain_deallocate_stack_var pvar ra = let explain_deallocate_constant_string s ra = let const_str = let pp fmt () = - Sil.pp_exp pe_text fmt (Sil.Const (Const.Cstr s)) in + Sil.pp_exp pe_text fmt (Exp.Const (Const.Cstr s)) in pp_to_string pp () in Localise.desc_deallocate_static_memory const_str ra.Sil.ra_pname ra.Sil.ra_loc @@ -97,7 +97,7 @@ let find_in_node_or_preds start_node f_node_instr = (** Find the Set instruction used to assign [id] to a program variable, if any *) let find_variable_assigment node id : Sil.instr option = let find_set _ instr = match instr with - | Sil.Set (Sil.Lvar _, _, e, _) when Sil.exp_equal (Sil.Var id) e -> Some instr + | Sil.Set (Exp.Lvar _, _, e, _) when Sil.exp_equal (Exp.Var id) e -> Some instr | _ -> None in find_in_node_or_preds node find_set @@ -126,7 +126,7 @@ let find_other_prune_node node = (** Return true if [id] is assigned to a program variable which is then nullified *) let id_is_assigned_then_dead node id = match find_variable_assigment node id with - | Some (Sil.Set (Sil.Lvar pvar, _, _, _) as instr) + | Some (Sil.Set (Exp.Lvar pvar, _, _, _) as instr) when Pvar.is_local pvar || Pvar.is_callee pvar -> let is_prune = match Cfg.Node.get_kind node with | Cfg.Node.Prune_node _ -> true @@ -146,7 +146,7 @@ let id_is_assigned_then_dead node id = and return the function name and arguments *) let find_normal_variable_funcall (node: Cfg.Node.t) - (id: Ident.t): (Sil.exp * (Sil.exp list) * Location.t * CallFlags.t) option = + (id: Ident.t): (Exp.t * (Exp.t list) * Location.t * CallFlags.t) option = let find_declaration _ = function | Sil.Call ([id0], fun_exp, args, loc, call_flags) when Ident.equal id id0 -> Some (fun_exp, IList.map fst args, loc, call_flags) @@ -165,7 +165,7 @@ let find_normal_variable_funcall (** Find a program variable assignment in the current node or predecessors. *) let find_program_variable_assignment node pvar : (Cfg.Node.t * Ident.t) option = let find_instr node = function - | Sil.Set (Sil.Lvar _pvar, _, Sil.Var id, _) when Pvar.equal pvar _pvar && Ident.is_normal id -> + | Sil.Set (Exp.Lvar _pvar, _, Exp.Var id, _) when Pvar.equal pvar _pvar && Ident.is_normal id -> Some (node, id) | _ -> None in @@ -182,7 +182,7 @@ let find_struct_by_value_assignment node pvar = | Sil.Call (_, Const (Cfun pname), args, loc, cf) -> begin match IList.last args with - | Some (Sil.Lvar last_arg, _) when Pvar.equal pvar last_arg -> + | Some (Exp.Lvar last_arg, _) when Pvar.equal pvar last_arg -> Some (node, pname, loc, cf) | _ -> None @@ -193,7 +193,7 @@ let find_struct_by_value_assignment node pvar = else None (** Find a program variable assignment to id in the current node or predecessors. *) -let find_ident_assignment node id : (Cfg.Node.t * Sil.exp) option = +let find_ident_assignment node id : (Cfg.Node.t * Exp.t) option = let find_instr node = function | Sil.Letderef(_id, e, _, _) when Ident.equal _id id -> Some (node, e) | _ -> None in @@ -204,7 +204,7 @@ let find_ident_assignment node id : (Cfg.Node.t * Sil.exp) option = let rec find_boolean_assignment node pvar true_branch : Cfg.Node.t option = let find_instr n = let filter = function - | Sil.Set (Sil.Lvar _pvar, _, Sil.Const (Const.Cint i), _) when Pvar.equal pvar _pvar -> + | Sil.Set (Exp.Lvar _pvar, _, Exp.Const (Const.Cint i), _) when Pvar.equal pvar _pvar -> IntLit.iszero i <> true_branch | _ -> false in IList.exists filter (Cfg.Node.get_instrs n) in @@ -227,14 +227,14 @@ let rec _find_normal_variable_letderef (seen : Sil.ExpSet.t) node id : DExp.t op (L.d_str "find_normal_variable_letderef defining "; Sil.d_exp e; L.d_ln ()); _exp_lv_dexp seen node e - | Sil.Call ([id0], Sil.Const (Const.Cfun pn), (e, _):: _, _, _) + | Sil.Call ([id0], Exp.Const (Const.Cfun pn), (e, _):: _, _, _) when Ident.equal id id0 && Procname.equal pn (Procname.from_string_c_fun "__cast") -> if verbose then (L.d_str "find_normal_variable_letderef cast on "; Sil.d_exp e; L.d_ln ()); _exp_rv_dexp seen node e - | Sil.Call ([id0], (Sil.Const (Const.Cfun pname) as fun_exp), args, loc, call_flags) + | Sil.Call ([id0], (Exp.Const (Const.Cfun pname) as fun_exp), args, loc, call_flags) when Ident.equal id id0 -> if verbose then @@ -250,7 +250,7 @@ let rec _find_normal_variable_letderef (seen : Sil.ExpSet.t) node id : DExp.t op let unNone = function Some x -> x | None -> assert false in IList.map unNone args_dexpo in Some (DExp.Dretcall (fun_dexp, args_dexp, loc, call_flags)) - | Sil.Set (Sil.Lvar pvar, _, Sil.Var id0, _) + | Sil.Set (Exp.Lvar pvar, _, Exp.Var id0, _) when is_infer && Ident.equal id id0 && not (Pvar.is_frontend_tmp pvar) -> (* this case is a hack to make bucketing continue to work in the presence of copy propagation. previously, we would have code like: @@ -277,20 +277,20 @@ and _exp_lv_dexp (_seen : Sil.ExpSet.t) node e : DExp.t option = else let seen = Sil.ExpSet.add e _seen in match Prop.exp_normalize_noabs Sil.sub_empty e with - | Sil.Const c -> + | Exp.Const c -> if verbose then (L.d_str "exp_lv_dexp: constant "; Sil.d_exp e; L.d_ln ()); Some (DExp.Dderef (DExp.Dconst c)) - | Sil.BinOp(Binop.PlusPI, e1, e2) -> + | Exp.BinOp(Binop.PlusPI, e1, e2) -> if verbose then (L.d_str "exp_lv_dexp: (e1 +PI e2) "; Sil.d_exp e; L.d_ln ()); (match _exp_lv_dexp seen node e1, _exp_rv_dexp seen node e2 with | Some de1, Some de2 -> Some (DExp.Dbinop(Binop.PlusPI, de1, de2)) | _ -> None) - | Sil.Var id when Ident.is_normal id -> + | Exp.Var id when Ident.is_normal id -> if verbose then (L.d_str "exp_lv_dexp: normal var "; Sil.d_exp e; L.d_ln ()); (match _find_normal_variable_letderef seen node id with | None -> None | Some de -> Some (DExp.Dderef de)) - | Sil.Lvar pvar -> + | Exp.Lvar pvar -> if verbose then (L.d_str "exp_lv_dexp: program var "; Sil.d_exp e; L.d_ln ()); if Pvar.is_frontend_tmp pvar then begin @@ -315,22 +315,22 @@ and _exp_lv_dexp (_seen : Sil.ExpSet.t) node e : DExp.t option = let args = IList.map unNone blame_args in Some (DExp.Dfcall (unNone fun_dexpo, args, loc, call_flags)) | None -> - _exp_rv_dexp seen node' (Sil.Var id) + _exp_rv_dexp seen node' (Exp.Var id) end end else Some (DExp.Dpvar pvar) - | Sil.Lfield (Sil.Var id, f, _) when Ident.is_normal id -> + | Exp.Lfield (Exp.Var id, f, _) when Ident.is_normal id -> if verbose then begin L.d_str "exp_lv_dexp: Lfield with var "; - Sil.d_exp (Sil.Var id); + Sil.d_exp (Exp.Var id); L.d_str (" " ^ Ident.fieldname_to_string f); L.d_ln () end; (match _find_normal_variable_letderef seen node id with | None -> None | Some de -> Some (DExp.Darrow (de, f))) - | Sil.Lfield (e1, f, _) -> + | Exp.Lfield (e1, f, _) -> if verbose then begin L.d_str "exp_lv_dexp: Lfield "; @@ -341,7 +341,7 @@ and _exp_lv_dexp (_seen : Sil.ExpSet.t) node e : DExp.t option = (match _exp_lv_dexp seen node e1 with | None -> None | Some de -> Some (DExp.Ddot (de, f))) - | Sil.Lindex (e1, e2) -> + | Exp.Lindex (e1, e2) -> if verbose then begin L.d_str "exp_lv_dexp: Lindex "; @@ -367,18 +367,18 @@ and _exp_rv_dexp (_seen : Sil.ExpSet.t) node e : DExp.t option = else let seen = Sil.ExpSet.add e _seen in match e with - | Sil.Const c -> + | Exp.Const c -> if verbose then (L.d_str "exp_rv_dexp: constant "; Sil.d_exp e; L.d_ln ()); Some (DExp.Dconst c) - | Sil.Lvar pv -> + | Exp.Lvar pv -> if verbose then (L.d_str "exp_rv_dexp: program var "; Sil.d_exp e; L.d_ln ()); if Pvar.is_frontend_tmp pv then _exp_lv_dexp _seen (* avoid spurious cycle detection *) node e else Some (DExp.Dpvaraddr pv) - | Sil.Var id when Ident.is_normal id -> + | Exp.Var id when Ident.is_normal id -> if verbose then (L.d_str "exp_rv_dexp: normal var "; Sil.d_exp e; L.d_ln ()); _find_normal_variable_letderef seen node id - | Sil.Lfield (e1, f, _) -> + | Exp.Lfield (e1, f, _) -> if verbose then begin L.d_str "exp_rv_dexp: Lfield "; @@ -389,7 +389,7 @@ and _exp_rv_dexp (_seen : Sil.ExpSet.t) node e : DExp.t option = (match _exp_rv_dexp seen node e1 with | None -> None | Some de -> Some (DExp.Ddot(de, f))) - | Sil.Lindex (e1, e2) -> + | Exp.Lindex (e1, e2) -> if verbose then begin L.d_str "exp_rv_dexp: Lindex "; @@ -401,20 +401,20 @@ and _exp_rv_dexp (_seen : Sil.ExpSet.t) node e : DExp.t option = (match _exp_rv_dexp seen node e1, _exp_rv_dexp seen node e2 with | None, _ | _, None -> None | Some de1, Some de2 -> Some (DExp.Darray(de1, de2))) - | Sil.BinOp (op, e1, e2) -> + | Exp.BinOp (op, e1, e2) -> if verbose then (L.d_str "exp_rv_dexp: BinOp "; Sil.d_exp e; L.d_ln ()); (match _exp_rv_dexp seen node e1, _exp_rv_dexp seen node e2 with | None, _ | _, None -> None | Some de1, Some de2 -> Some (DExp.Dbinop (op, de1, de2))) - | Sil.UnOp (op, e1, _) -> + | Exp.UnOp (op, e1, _) -> if verbose then (L.d_str "exp_rv_dexp: UnOp "; Sil.d_exp e; L.d_ln ()); (match _exp_rv_dexp seen node e1 with | None -> None | Some de1 -> Some (DExp.Dunop (op, de1))) - | Sil.Cast (_, e1) -> + | Exp.Cast (_, e1) -> if verbose then (L.d_str "exp_rv_dexp: Cast "; Sil.d_exp e; L.d_ln ()); _exp_rv_dexp seen node e1 - | Sil.Sizeof (typ, len, sub) -> + | Exp.Sizeof (typ, len, sub) -> if verbose then (L.d_str "exp_rv_dexp: type "; Sil.d_exp e; L.d_ln ()); Some (DExp.Dsizeof (typ, Option.map_default (_exp_rv_dexp seen node) None len, sub)) | _ -> @@ -479,7 +479,7 @@ let find_hpred_typ hpred = match hpred with let find_typ_without_ptr prop pvar = let res = ref None in let do_hpred = function - | Sil.Hpointsto (e, _, te) when Sil.exp_equal e (Sil.Lvar pvar) -> + | Sil.Hpointsto (e, _, te) when Sil.exp_equal e (Exp.Lvar pvar) -> res := Some te | _ -> () in IList.iter do_hpred (Prop.get_sigma prop); @@ -518,12 +518,12 @@ let explain_leak tenv hpred prop alloc_att_opt bucket = (Pvar.is_local pvar || Pvar.is_global pvar) && not (Pvar.is_frontend_tmp pvar) && match hpred_typ_opt, find_typ_without_ptr prop pvar with - | Some (Sil.Sizeof (t1, _, _)), Some (Sil.Sizeof (Typ.Tptr (t2_, _), _, _)) -> + | Some (Exp.Sizeof (t1, _, _)), Some (Exp.Sizeof (Typ.Tptr (t2_, _), _, _)) -> (try let t2 = Tenv.expand_type tenv t2_ in Typ.equal t1 t2 with exn when SymOp.exn_not_failure exn -> false) - | Some (Sil.Sizeof (Typ.Tint _, _, _)), Some (Sil.Sizeof (Typ.Tint _, _, _)) + | Some (Exp.Sizeof (Typ.Tint _, _, _)), Some (Exp.Sizeof (Typ.Tint _, _, _)) when is_file -> (* must be a file opened with "open" *) true | _ -> false in @@ -536,7 +536,7 @@ let explain_leak tenv hpred prop alloc_att_opt bucket = then (L.d_str "explain_leak: current instruction is Nullify for pvar "; Pvar.d pvar; L.d_ln ()); - (match exp_lv_dexp (State.get_node ()) (Sil.Lvar pvar) with + (match exp_lv_dexp (State.get_node ()) (Exp.Lvar pvar) with | Some de when not (DExp.has_tmp_var de)-> Some (DExp.to_string de) | _ -> None) | Some (Sil.Abstract _) -> @@ -589,9 +589,9 @@ let vpath_find prop _exp : DExp.t option * Typ.t option = | Sil.Eexp (e, _) when Sil.exp_equal exp e -> let sigma' = (IList.rev_append sigma_acc' sigma_todo') in (match lexp with - | Sil.Lvar pv -> + | Exp.Lvar pv -> let typo = match texp with - | Sil.Sizeof (Typ.Tstruct struct_typ, _, _) -> + | Exp.Sizeof (Typ.Tstruct struct_typ, _, _) -> (try let _, t, _ = IList.find (fun (f', _, _) -> @@ -601,8 +601,8 @@ let vpath_find prop _exp : DExp.t option * Typ.t option = with Not_found -> None) | _ -> None in res := Some (DExp.Ddot (DExp.Dpvar pv, f)), typo - | Sil.Var id -> - (match find [] sigma' (Sil.Var id) with + | Exp.Var id -> + (match find [] sigma' (Exp.Var id) with | None, _ -> () | Some de, typo -> res := Some (DExp.Darrow (de, f)), typo) | lexp -> @@ -615,13 +615,13 @@ let vpath_find prop _exp : DExp.t option * Typ.t option = | Sil.Eexp (e, _) when Sil.exp_equal exp e -> let sigma' = (IList.rev_append sigma_acc' sigma_todo') in (match lexp with - | Sil.Lvar pv when not (Pvar.is_frontend_tmp pv) -> + | Exp.Lvar pv when not (Pvar.is_frontend_tmp pv) -> let typo = match texp with - | Sil.Sizeof (typ, _, _) -> Some typ + | Exp.Sizeof (typ, _, _) -> Some typ | _ -> None in Some (DExp.Dpvar pv), typo - | Sil.Var id -> - (match find [] sigma' (Sil.Var id) with + | Exp.Var id -> + (match find [] sigma' (Exp.Var id) with | None, typo -> None, typo | Some de, typo -> Some (DExp.Dderef de), typo) | lexp -> @@ -639,16 +639,16 @@ let vpath_find prop _exp : DExp.t option * Typ.t option = let do_hpred sigma_acc' sigma_todo' = let substituted_from_normal id = let filter = function - | (ni, Sil.Var id') -> Ident.is_normal ni && Ident.equal id' id + | (ni, Exp.Var id') -> Ident.is_normal ni && Ident.equal id' id | _ -> false in IList.exists filter (Sil.sub_to_list (Prop.get_sub prop)) in function - | Sil.Hpointsto (Sil.Lvar pv, sexp, texp) + | Sil.Hpointsto (Exp.Lvar pv, sexp, texp) when (Pvar.is_local pv || Pvar.is_global pv || Pvar.is_seed pv) -> - do_sexp sigma_acc' sigma_todo' (Sil.Lvar pv) sexp texp - | Sil.Hpointsto (Sil.Var id, sexp, texp) + do_sexp sigma_acc' sigma_todo' (Exp.Lvar pv) sexp texp + | Sil.Hpointsto (Exp.Var id, sexp, texp) when Ident.is_normal id || (Ident.is_footprint id && substituted_from_normal id) -> - do_sexp sigma_acc' sigma_todo' (Sil.Var id) sexp texp + do_sexp sigma_acc' sigma_todo' (Exp.Var id) sexp texp | _ -> None, None in match sigma_todo with @@ -679,7 +679,7 @@ let explain_dexp_access prop dexp is_nullable = | Some se -> if verbose then (L.d_str "sexpo_to_inst: can't find inst "; Sil.d_sexp se; L.d_ln()); None in - let find_ptsto (e : Sil.exp) : Sil.strexp option = + let find_ptsto (e : Exp.t) : Sil.strexp option = let res = ref None in let do_hpred = function | Sil.Hpointsto (e', se, _) when Sil.exp_equal e e' -> @@ -705,7 +705,7 @@ let explain_dexp_access prop dexp is_nullable = else lookup_esel esel' e in let rec lookup : DExp.t -> Sil.strexp option = function | DExp.Dconst c -> - Some (Sil.Eexp (Sil.Const c, Sil.inst_none)) + Some (Sil.Eexp (Exp.Const c, Sil.inst_none)) | DExp.Darray (de1, de2) -> (match lookup de1, lookup de2 with | None, _ | _, None -> None @@ -745,7 +745,7 @@ let explain_dexp_access prop dexp is_nullable = None) | DExp.Dpvar pvar -> if verbose then (L.d_str "lookup: found Dpvar "; L.d_ln ()); - (find_ptsto (Sil.Lvar pvar)) + (find_ptsto (Exp.Lvar pvar)) | DExp.Dderef de -> (match lookup de with | None -> None @@ -758,15 +758,15 @@ let explain_dexp_access prop dexp is_nullable = if verbose then (L.d_strln "lookup: found Dfcall "); (match c with | Const.Cfun _ -> (* Treat function as an update *) - Some (Sil.Eexp (Sil.Const c, Sil.Ireturn_from_call loc.Location.line)) + Some (Sil.Eexp (Exp.Const c, Sil.Ireturn_from_call loc.Location.line)) | _ -> None) | DExp.Dretcall (DExp.Dconst (Const.Cfun pname as c ) , _, loc, _ ) when method_of_pointer_wrapper pname -> if verbose then (L.d_strln "lookup: found Dretcall "); - Some (Sil.Eexp (Sil.Const c, Sil.Ireturn_from_pointer_wrapper_call loc.Location.line)) + Some (Sil.Eexp (Exp.Const c, Sil.Ireturn_from_pointer_wrapper_call loc.Location.line)) | DExp.Dpvaraddr pvar -> (L.d_strln ("lookup: found Dvaraddr " ^ DExp.to_string (DExp.Dpvaraddr pvar))); - find_ptsto (Sil.Lvar pvar) + find_ptsto (Exp.Lvar pvar) | de -> if verbose then (L.d_strln ("lookup: unknown case not matched " ^ DExp.to_string de)); None in @@ -847,7 +847,7 @@ let create_dereference_desc match de_opt with | Some (DExp.Dpvar pvar) | Some (DExp.Dpvaraddr pvar) -> - (match Prop.get_objc_null_attribute prop (Sil.Lvar pvar) with + (match Prop.get_objc_null_attribute prop (Exp.Lvar pvar) with | Some (Apred (Aobjc_null, [_; vfs])) -> Localise.parameter_field_not_null_checked_desc desc vfs | _ -> @@ -875,34 +875,34 @@ let _explain_access ?(is_premature_nil = false) deref_str prop loc = let rec find_outermost_dereference node e = match e with - | Sil.Const _ -> + | Exp.Const _ -> if verbose then (L.d_str "find_outermost_dereference: constant "; Sil.d_exp e; L.d_ln ()); exp_lv_dexp node e - | Sil.Var id when Ident.is_normal id -> (* look up the normal variable declaration *) + | Exp.Var id when Ident.is_normal id -> (* look up the normal variable declaration *) if verbose then (L.d_str "find_outermost_dereference: normal var "; Sil.d_exp e; L.d_ln ()); find_normal_variable_letderef node id - | Sil.Lfield (e', _, _) -> + | Exp.Lfield (e', _, _) -> if verbose then (L.d_str "find_outermost_dereference: Lfield "; Sil.d_exp e; L.d_ln ()); find_outermost_dereference node e' - | Sil.Lindex(e', _) -> + | Exp.Lindex(e', _) -> if verbose then (L.d_str "find_outermost_dereference: Lindex "; Sil.d_exp e; L.d_ln ()); find_outermost_dereference node e' - | Sil.Lvar _ -> + | Exp.Lvar _ -> if verbose then (L.d_str "find_outermost_dereference: Lvar "; Sil.d_exp e; L.d_ln ()); exp_lv_dexp node e - | Sil.BinOp(Binop.PlusPI, Sil.Lvar _, _) -> + | Exp.BinOp(Binop.PlusPI, Exp.Lvar _, _) -> if verbose then (L.d_str "find_outermost_dereference: Lvar+index "; Sil.d_exp e; L.d_ln ()); exp_lv_dexp node e - | Sil.Cast (_, e') -> + | Exp.Cast (_, e') -> if verbose then (L.d_str "find_outermost_dereference: cast "; Sil.d_exp e; L.d_ln ()); find_outermost_dereference node e' - | Sil.BinOp(Binop.PtrFld, _, e') -> + | Exp.BinOp(Binop.PtrFld, _, e') -> if verbose then (L.d_str "find_outermost_dereference: PtrFld "; Sil.d_exp e; L.d_ln ()); find_outermost_dereference node e' | _ -> @@ -918,11 +918,11 @@ let _explain_access | Some Sil.Letderef (_, e, _, _) -> if verbose then (L.d_str "explain_dereference Binop.Leteref "; Sil.d_exp e; L.d_ln ()); Some e - | Some Sil.Call (_, Sil.Const (Const.Cfun fn), [(e, _)], _, _) + | Some Sil.Call (_, Exp.Const (Const.Cfun fn), [(e, _)], _, _) when Procname.to_string fn = "free" -> if verbose then (L.d_str "explain_dereference Sil.Call "; Sil.d_exp e; L.d_ln ()); Some e - | Some Sil.Call (_, (Sil.Var _ as e), _, _, _) -> + | Some Sil.Call (_, (Exp.Var _ as e), _, _, _) -> if verbose then (L.d_str "explain_dereference Sil.Call "; Sil.d_exp e; L.d_ln ()); Some e | _ -> None in @@ -1015,7 +1015,7 @@ let find_with_exp prop exp = if Sil.exp_equal e e1 then search_struct pv [] se | _ -> () in let do_hpred = function - | Sil.Hpointsto(Sil.Lvar pv, Sil.Eexp (e, _), _) -> + | Sil.Hpointsto(Exp.Lvar pv, Sil.Eexp (e, _), _) -> if Sil.exp_equal e exp then found_in_pvar pv else IList.iter (do_hpred_pointed_by_pvar pv e) (Prop.get_sigma prop) | _ -> () in @@ -1040,7 +1040,7 @@ let explain_dereference_as_caller_expression let pv_name = Pvar.get_name pv in if Pvar.is_global pv then - let dexp = exp_lv_dexp node (Sil.Lvar pv) in + let dexp = exp_lv_dexp node (Exp.Lvar pv) in create_dereference_desc ~use_buckets dexp deref_str actual_pre loc else if Pvar.is_callee pv then let position = find_formal_param_number pv_name in @@ -1092,7 +1092,7 @@ let explain_tainted_value_reaching_sensitive_function prop e { Sil.taint_source; taint_kind } sensitive_fun loc = let var_desc = match e with - | Sil.Lvar pv -> Pvar.to_string pv + | Exp.Lvar pv -> Pvar.to_string pv | _ -> begin match find_with_exp prop e with diff --git a/infer/src/backend/errdesc.mli b/infer/src/backend/errdesc.mli index af1655301..142a73671 100644 --- a/infer/src/backend/errdesc.mli +++ b/infer/src/backend/errdesc.mli @@ -14,7 +14,7 @@ open! Utils (** find the dexp, if any, where the given value is stored also return the type of the value if found *) -val vpath_find : 'a Prop.t -> Sil.exp -> DecompiledExp.vpath * Typ.t option +val vpath_find : 'a Prop.t -> Exp.t -> DecompiledExp.vpath * Typ.t option (** Return true if [id] is assigned to a program variable which is then nullified *) val id_is_assigned_then_dead : Cfg.Node.t -> Ident.t -> bool @@ -25,20 +25,20 @@ val hpred_is_open_resource : 'a Prop.t -> Sil.hpred -> Sil.resource option (** Find the function call instruction used to initialize normal variable [id], and return the function name and arguments *) val find_normal_variable_funcall : - Cfg.Node.t -> Ident.t -> (Sil.exp * (Sil.exp list) * Location.t * CallFlags.t) option + Cfg.Node.t -> Ident.t -> (Exp.t * (Exp.t list) * Location.t * CallFlags.t) option (** Find a program variable assignment in the current node or straightline predecessor. *) val find_program_variable_assignment : Cfg.Node.t -> Pvar.t -> (Cfg.Node.t * Ident.t) option (** Find a program variable assignment to id in the current node or predecessors. *) -val find_ident_assignment : Cfg.Node.t -> Ident.t -> (Cfg.Node.t * Sil.exp) option +val find_ident_assignment : Cfg.Node.t -> Ident.t -> (Cfg.Node.t * Exp.t) option (** Find a boolean assignment to a temporary variable holding a boolean condition. The boolean parameter indicates whether the true or false branch is required. *) val find_boolean_assignment : Cfg.Node.t -> Pvar.t -> bool -> Cfg.Node.t option (** describe rvalue [e] as a dexp *) -val exp_rv_dexp : Cfg.Node.t -> Sil.exp -> DecompiledExp.t option +val exp_rv_dexp : Cfg.Node.t -> Exp.t -> DecompiledExp.t option (** Produce a description of a persistent reference to an Android Context *) val explain_context_leak : Procname.t -> Typ.t -> Ident.fieldname -> @@ -52,7 +52,7 @@ val explain_array_access : Localise.deref_str -> 'a Prop.t -> Location.t -> Loca (** explain a class cast exception *) val explain_class_cast_exception : - Procname.t option -> Sil.exp -> Sil.exp -> Sil.exp -> + Procname.t option -> Exp.t -> Exp.t -> Exp.t -> Cfg.Node.t -> Location.t -> Localise.error_desc (** Explain a deallocate stack variable error *) @@ -70,11 +70,11 @@ val explain_dereference : using the formal parameters of the call *) val explain_dereference_as_caller_expression : ?use_buckets:bool -> - Localise.deref_str -> 'a Prop.t -> 'b Prop.t -> Sil.exp -> + Localise.deref_str -> 'a Prop.t -> 'b Prop.t -> Exp.t -> Cfg.Node.t -> Location.t -> Pvar.t list -> Localise.error_desc (** explain a division by zero *) -val explain_divide_by_zero : Sil.exp -> Cfg.Node.t -> Location.t -> Localise.error_desc +val explain_divide_by_zero : Exp.t -> Cfg.Node.t -> Location.t -> Localise.error_desc (** explain a return expression required *) val explain_return_expression_required : Location.t -> Typ.t -> Localise.error_desc @@ -87,7 +87,7 @@ val explain_condition_is_assignment : Location.t -> Localise.error_desc (** explain a condition which is always true or false *) val explain_condition_always_true_false : - IntLit.t -> Sil.exp -> Cfg.Node.t -> Location.t -> Localise.error_desc + IntLit.t -> Exp.t -> Cfg.Node.t -> Location.t -> Localise.error_desc (** explain the escape of a stack variable address from its scope *) val explain_stack_variable_address_escape : @@ -106,11 +106,11 @@ val explain_retain_cycle : (** explain unary minus applied to unsigned expression *) val explain_unary_minus_applied_to_unsigned_expression : - Sil.exp -> Typ.t -> Cfg.Node.t -> Location.t -> Localise.error_desc + Exp.t -> Typ.t -> Cfg.Node.t -> Location.t -> Localise.error_desc (** Explain a tainted value error *) val explain_tainted_value_reaching_sensitive_function : - Prop.normal Prop.t -> Sil.exp -> Sil.taint_info -> Procname.t -> Location.t -> Localise.error_desc + Prop.normal Prop.t -> Exp.t -> Sil.taint_info -> Procname.t -> Location.t -> Localise.error_desc (** Produce a description of a leak by looking at the current state. If the current instruction is a variable nullify, blame the variable. @@ -125,7 +125,7 @@ val explain_memory_access : Localise.deref_str -> 'a Prop.t -> Location.t -> Loc (** explain a test for NULL of a dereferenced pointer *) val explain_null_test_after_dereference : - Sil.exp -> Cfg.Node.t -> int -> Location.t -> Localise.error_desc + Exp.t -> Cfg.Node.t -> int -> Location.t -> Localise.error_desc (** Print a warning to the err stream at the given location (note: only prints in developer mode) *) val warning_err : Location.t -> ('a, Format.formatter, unit) format -> 'a @@ -136,4 +136,4 @@ type pvar_off = | Fstruct of Ident.fieldname list (* value obtained by dereferencing the pvar and following a sequence of fields *) (** Find a program variable whose value is [exp] or pointing to a struct containing [exp] *) -val find_with_exp : 'a Prop.t -> Sil.exp -> (Pvar.t * pvar_off) option +val find_with_exp : 'a Prop.t -> Exp.t -> (Pvar.t * pvar_off) option diff --git a/infer/src/backend/interproc.ml b/infer/src/backend/interproc.ml index bc1d1ece0..05ac35bbc 100644 --- a/infer/src/backend/interproc.ml +++ b/infer/src/backend/interproc.ml @@ -386,7 +386,7 @@ let check_assignement_guard node = | _ -> false in let is_frontend_tmp e = match e with - | Sil.Lvar pv -> + | Exp.Lvar pv -> Pvar.is_frontend_tmp pv | _ -> false in let succs = Cfg.Node.get_succs node in @@ -399,8 +399,8 @@ let check_assignement_guard node = let pi = IList.filter is_prune_instr ins in let leti = IList.filter is_letderef_instr ins in match pi, leti with - | [Sil.Prune (Sil.Var(e1), _, _, _)], [Sil.Letderef(e2, e', _, _)] - | [Sil.Prune (Sil.UnOp(Unop.LNot, Sil.Var(e1), _), _, _, _)], + | [Sil.Prune (Exp.Var(e1), _, _, _)], [Sil.Letderef(e2, e', _, _)] + | [Sil.Prune (Exp.UnOp(Unop.LNot, Exp.Var(e1), _), _, _, _)], [Sil.Letderef(e2, e', _, _)] when (Ident.equal e1 e2) -> if verbose @@ -429,8 +429,8 @@ let check_assignement_guard node = (* check that the guards of the succs are a var or its negation *) let succs_have_simple_guards () = let check_instr = function - | Sil.Prune (Sil.Var _, _, _, _) -> true - | Sil.Prune (Sil.UnOp(Unop.LNot, Sil.Var _, _), _, _, _) -> true + | Sil.Prune (Exp.Var _, _, _, _) -> true + | Sil.Prune (Exp.UnOp(Unop.LNot, Exp.Var _, _), _, _, _) -> true | Sil.Prune _ -> false | _ -> true in let check_guard n = @@ -649,7 +649,7 @@ let report_context_leaks pname sigma tenv = sigma in IList.iter (function - | Sil.Hpointsto (Sil.Lvar pv, Sil.Estruct (static_flds, _), _) + | Sil.Hpointsto (Exp.Lvar pv, Sil.Estruct (static_flds, _), _) when Pvar.is_global pv -> IList.iter (fun (f_name, f_strexp) -> @@ -665,7 +665,7 @@ let remove_locals_formals_and_check pdesc p = let pvars, p' = Cfg.remove_locals_formals pdesc p in let check_pvar pvar = let loc = Cfg.Node.get_loc (Cfg.Procdesc.get_exit_node pdesc) in - let dexp_opt, _ = Errdesc.vpath_find p (Sil.Lvar pvar) in + let dexp_opt, _ = Errdesc.vpath_find p (Exp.Lvar pvar) in let desc = Errdesc.explain_stack_variable_address_escape loc pvar dexp_opt in let exn = Exceptions.Stack_variable_address_escape (desc, __POS__) in Reporting.log_warning pname exn in @@ -716,7 +716,7 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list = pathset; let sub_list = IList.map - (fun id -> (id, Sil.Var (Ident.create_fresh (Ident.knormal)))) + (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 = @@ -807,8 +807,8 @@ let collect_postconditions wl tenv pdesc : Paths.PathSet.t * Specs.Visitedset.t let create_seed_vars sigma = let hpred_add_seed sigma = function - | Sil.Hpointsto (Sil.Lvar pv, se, typ) when not (Pvar.is_abducted pv) -> - Sil.Hpointsto(Sil.Lvar (Pvar.to_seed pv), se, typ) :: sigma + | Sil.Hpointsto (Exp.Lvar pv, se, typ) when not (Pvar.is_abducted pv) -> + Sil.Hpointsto(Exp.Lvar (Pvar.to_seed pv), se, typ) :: sigma | _ -> sigma in IList.fold_left hpred_add_seed [] sigma @@ -820,8 +820,8 @@ let prop_init_formals_seed tenv new_formals (prop : 'a Prop.t) : Prop.exposed Pr let sigma_new_formals = let do_formal (pv, typ) = let texp = match !Config.curr_language with - | Config.Clang -> Sil.Sizeof (typ, None, Subtype.exact) - | Config.Java -> Sil.Sizeof (typ, None, Subtype.subtypes) in + | Config.Clang -> Exp.Sizeof (typ, None, Subtype.exact) + | Config.Java -> Exp.Sizeof (typ, None, Subtype.subtypes) in Prop.mk_ptsto_lvar (Some tenv) Prop.Fld_init Sil.inst_formal (pv, texp, None) in IList.map do_formal new_formals in let sigma_seed = @@ -866,7 +866,7 @@ let initial_prop_from_pre tenv curr_f pre = let vars = Sil.fav_to_list (Prop.prop_fav pre) in let sub_list = IList.map - (fun id -> (id, Sil.Var (Ident.create_fresh (Ident.kfootprint)))) + (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 @@ -1114,12 +1114,12 @@ let custom_error_preconditions summary = (* Remove the constrain of the form this != null which is true for all Java virtual calls *) let remove_this_not_null prop = let collect_hpred (var_option, hpreds) = function - | Sil.Hpointsto (Sil.Lvar pvar, Sil.Eexp (Sil.Var var, _), _) + | Sil.Hpointsto (Exp.Lvar pvar, Sil.Eexp (Exp.Var var, _), _) when !Config.curr_language = Config.Java && Pvar.is_this pvar -> (Some var, hpreds) | hpred -> (var_option, hpred:: hpreds) in let collect_atom var atoms = function - | Sil.Aneq (Sil.Var v, e) + | Sil.Aneq (Exp.Var v, e) when Ident.equal v var && Sil.exp_equal e Sil.exp_null -> atoms | a -> a:: atoms in match IList.fold_left collect_hpred (None, []) (Prop.get_sigma prop) with diff --git a/infer/src/backend/localise.ml b/infer/src/backend/localise.ml index accd6c9d6..47f4a6ad2 100644 --- a/infer/src/backend/localise.ml +++ b/infer/src/backend/localise.ml @@ -536,8 +536,8 @@ let parameter_field_not_null_checked_desc (desc : error_desc) exp = let field_not_nullable_desc exp = let rec exp_to_string exp = match exp with - | Sil.Lfield (exp', field, _) -> (exp_to_string exp')^" -> "^(Ident.fieldname_to_string field) - | Sil.Lvar pvar -> Mangled.to_string (Pvar.get_name pvar) + | Exp.Lfield (exp', field, _) -> (exp_to_string exp')^" -> "^(Ident.fieldname_to_string field) + | Exp.Lvar pvar -> Mangled.to_string (Pvar.get_name pvar) | _ -> "" in let var_s = exp_to_string exp in let field_not_null_desc = @@ -545,8 +545,8 @@ let parameter_field_not_null_checked_desc (desc : error_desc) exp = { desc with descriptions = field_not_null_desc :: desc.descriptions; tags = (Tags.field_not_null_checked, var_s) :: desc.tags; } in match exp with - | Sil.Lvar var -> parameter_not_nullable_desc var - | Sil.Lfield _ -> field_not_nullable_desc exp + | Exp.Lvar var -> parameter_not_nullable_desc var + | Exp.Lfield _ -> field_not_nullable_desc exp | _ -> desc let has_tag (desc : error_desc) tag = @@ -688,7 +688,7 @@ let desc_leak hpred_type_opt value_str_opt resource_opt resource_action_opt loc s, " to ", " on " in let typ_str = match hpred_type_opt with - | Some (Sil.Sizeof (Typ.Tstruct + | Some (Exp.Sizeof (Typ.Tstruct { Typ.csu = Csu.Class _; Typ.struct_name = Some classname; }, _, _)) -> @@ -766,17 +766,17 @@ let desc_retain_cycle prop cycle loc cycle_dotty = | _ -> s in let do_edge ((se, _), f, _) = match se with - | Sil.Eexp(Sil.Lvar pvar, _) when Pvar.equal pvar Sil.block_pvar -> + | Sil.Eexp(Exp.Lvar pvar, _) when Pvar.equal pvar Sil.block_pvar -> str_cycle:=!str_cycle^" ("^(string_of_int !ct)^") a block capturing "^(Ident.fieldname_to_string f)^"; "; ct:=!ct +1; - | Sil.Eexp(Sil.Lvar pvar as e, _) -> + | Sil.Eexp(Exp.Lvar pvar as e, _) -> let e_str = Sil.exp_to_string e in let e_str = if Pvar.is_seed pvar then remove_old e_str else e_str in str_cycle:=!str_cycle^" ("^(string_of_int !ct)^") object "^e_str^" retaining "^e_str^"."^(Ident.fieldname_to_string f)^", "; ct:=!ct +1 - | Sil.Eexp (Sil.Sizeof (typ, _, _), _) -> + | Sil.Eexp (Exp.Sizeof (typ, _, _), _) -> let step = " (" ^ (string_of_int !ct) ^ ") an object of " ^ (Typ.to_string typ) ^ " retaining another object via instance variable " diff --git a/infer/src/backend/localise.mli b/infer/src/backend/localise.mli index 8a41d9d28..1dec2baa8 100644 --- a/infer/src/backend/localise.mli +++ b/infer/src/backend/localise.mli @@ -180,7 +180,7 @@ type access = val dereference_string : deref_str -> string -> access option -> Location.t -> error_desc -val parameter_field_not_null_checked_desc : error_desc -> Sil.exp -> error_desc +val parameter_field_not_null_checked_desc : error_desc -> Exp.t -> error_desc val is_parameter_not_null_checked_desc : error_desc -> bool @@ -213,7 +213,7 @@ val is_empty_vector_access_desc : error_desc -> bool val desc_frontend_warning : string -> string option -> Location.t -> error_desc val desc_leak : - Sil.exp option -> string option -> Sil.resource option -> Sil.res_action option -> + Exp.t option -> string option -> Sil.resource option -> Sil.res_action option -> Location.t -> string option -> error_desc val desc_null_test_after_dereference : string -> int -> Location.t -> error_desc diff --git a/infer/src/backend/match.ml b/infer/src/backend/match.ml index 86fbec627..71058ccd8 100644 --- a/infer/src/backend/match.ml +++ b/infer/src/backend/match.ml @@ -40,45 +40,45 @@ let rec exp_match e1 sub vars e2 : (Sil.subst * Ident.t list) option = let e2_inst = Sil.exp_sub sub e2 in if (Sil.exp_equal e1 e2_inst) then Some(sub, vars) else None in match e1, e2 with - | _, Sil.Var id2 when (Ident.is_primed id2 && mem_idlist id2 vars) -> + | _, Exp.Var id2 when (Ident.is_primed id2 && mem_idlist id2 vars) -> let vars_new = IList.filter (fun id -> not (Ident.equal id id2)) vars in let sub_new = match (Sil.extend_sub sub id2 e1) with | None -> assert false (* happens when vars contains the same variable twice. *) | Some sub_new -> sub_new in Some (sub_new, vars_new) - | _, Sil.Var _ -> + | _, Exp.Var _ -> check_equal sub vars e1 e2 - | Sil.Var _, _ -> + | Exp.Var _, _ -> None - | Sil.Const _, _ | _, Sil.Const _ -> + | Exp.Const _, _ | _, Exp.Const _ -> check_equal sub vars e1 e2 - | Sil.Sizeof _, _ | _, Sil.Sizeof _ -> + | Exp.Sizeof _, _ | _, Exp.Sizeof _ -> check_equal sub vars e1 e2 - | Sil.Cast (_, e1'), Sil.Cast (_, e2') -> (* we are currently ignoring cast *) + | Exp.Cast (_, e1'), Exp.Cast (_, e2') -> (* we are currently ignoring cast *) exp_match e1' sub vars e2' - | Sil.Cast _, _ | _, Sil.Cast _ -> + | Exp.Cast _, _ | _, Exp.Cast _ -> None - | Sil.UnOp(o1, e1', _), Sil.UnOp(o2, e2', _) when Unop.equal o1 o2 -> + | Exp.UnOp(o1, e1', _), Exp.UnOp(o2, e2', _) when Unop.equal o1 o2 -> exp_match e1' sub vars e2' - | Sil.UnOp _, _ | _, Sil.UnOp _ -> + | Exp.UnOp _, _ | _, Exp.UnOp _ -> None (* Naive *) - | Sil.BinOp(b1, e1', e1''), Sil.BinOp(b2, e2', e2'') when Binop.equal b1 b2 -> + | Exp.BinOp(b1, e1', e1''), Exp.BinOp(b2, e2', e2'') when Binop.equal b1 b2 -> (match exp_match e1' sub vars e2' with | None -> None | Some (sub', vars') -> exp_match e1'' sub' vars' e2'') - | Sil.BinOp _, _ | _, Sil.BinOp _ -> + | Exp.BinOp _, _ | _, Exp.BinOp _ -> None (* Naive *) - | Sil.Exn _, _ | _, Sil.Exn _ -> + | Exp.Exn _, _ | _, Exp.Exn _ -> check_equal sub vars e1 e2 - | Sil.Closure _, _ | _, Sil.Closure _ -> + | Exp.Closure _, _ | _, Exp.Closure _ -> check_equal sub vars e1 e2 - | Sil.Lvar _, _ | _, Sil.Lvar _ -> + | Exp.Lvar _, _ | _, Exp.Lvar _ -> check_equal sub vars e1 e2 - | Sil.Lfield(e1', fld1, _), Sil.Lfield(e2', fld2, _) when (Ident.fieldname_equal fld1 fld2) -> + | Exp.Lfield(e1', fld1, _), Exp.Lfield(e2', fld2, _) when (Ident.fieldname_equal fld1 fld2) -> exp_match e1' sub vars e2' - | Sil.Lfield _, _ | _, Sil.Lfield _ -> + | Exp.Lfield _, _ | _, Exp.Lfield _ -> None - | Sil.Lindex(base1, idx1), Sil.Lindex(base2, idx2) -> + | Exp.Lindex(base1, idx1), Exp.Lindex(base2, idx2) -> (match exp_match base1 sub vars base2 with | None -> None | Some (sub', vars') -> exp_match idx1 sub' vars' idx2) @@ -165,7 +165,7 @@ let sub_extend_with_ren (sub: Sil.subst) vars = if overlap then assert false in check_precondition (); *) - let f id = (id, Sil.Var (Ident.create_fresh Ident.kprimed)) in + let f id = (id, Exp.Var (Ident.create_fresh Ident.kprimed)) in let renaming_for_vars = Sil.sub_of_list (IList.map f vars) in Sil.sub_join sub renaming_for_vars @@ -414,13 +414,13 @@ and hpara_common_match_with_impl impl_ok ids1 sigma1 eids2 ids2 sigma2 = try let sub_ids = let ren_ids = IList.combine ids2 ids1 in - let f (id2, id1) = (id2, Sil.Var id1) in + let f (id2, id1) = (id2, Exp.Var id1) in IList.map 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, Sil.Var id1)) ren_eids in + let sub_eids = IList.map (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 @@ -717,7 +717,7 @@ let sigma_lift_to_pe sigma = let generic_para_create corres sigma1 elist1 = let corres_ids = let not_same_consts = function - | Sil.Const c1, Sil.Const c2 -> not (Const.equal c1 c2) + | Exp.Const c1, Exp.Const c2 -> not (Const.equal c1 c2) | _ -> true in let new_corres' = IList.filter not_same_consts corres in let add_fresh_id pair = (pair, Ident.create_fresh Ident.kprimed) in @@ -732,7 +732,7 @@ let generic_para_create corres sigma1 elist1 = let renaming = IList.map (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, Sil.Var id)) renaming in + let renaming_exp = IList.map (fun (e1, id) -> (e1, Exp.Var id)) renaming in Prop.sigma_replace_exp renaming_exp sigma1' in (renaming, body, ids_exists, ids_shared, es_shared) diff --git a/infer/src/backend/match.mli b/infer/src/backend/match.mli index 4606c2365..b3b909326 100644 --- a/infer/src/backend/match.mli +++ b/infer/src/backend/match.mli @@ -46,11 +46,11 @@ val prop_match_with_impl : Prop.normal Prop.t -> sidecondition -> Ident.t list - and it uses expressions in the range of the isomorphism. The third is the unused part of the input sigma. *) val find_partial_iso : - (Sil.exp -> Sil.exp -> bool) -> - (Sil.exp * Sil.exp) list -> - (Sil.exp * Sil.exp) list -> + (Exp.t -> Exp.t -> bool) -> + (Exp.t * Exp.t) list -> + (Exp.t * Exp.t) list -> Sil.hpred list -> - ((Sil.exp * Sil.exp) list * Sil.hpred list * Sil.hpred list * Sil.hpred list) option + ((Exp.t * Exp.t) list * Sil.hpred list * Sil.hpred list * Sil.hpred list) option (** This mode expresses the flexibility allowed during the isomorphism check *) type iso_mode = Exact | LFieldForget | RFieldForget @@ -64,12 +64,13 @@ type iso_mode = Exact | LFieldForget | RFieldForget are the unused parts of the two input sigmas. *) val find_partial_iso_from_two_sigmas : iso_mode -> - (Sil.exp -> Sil.exp -> bool) -> - (Sil.exp * Sil.exp) list -> - (Sil.exp * Sil.exp) list -> + (Exp.t -> Exp.t -> bool) -> + (Exp.t * Exp.t) list -> + (Exp.t * Exp.t) list -> Sil.hpred list -> Sil.hpred list -> - ((Sil.exp * Sil.exp) list * Sil.hpred list * Sil.hpred list * (Sil.hpred list * Sil.hpred list)) option + ((Exp.t * Exp.t) list * Sil.hpred list * Sil.hpred list * (Sil.hpred list * Sil.hpred list)) + option (** [hpara_iso] soundly checks whether two hparas are isomorphic. *) val hpara_iso : Sil.hpara -> Sil.hpara -> bool @@ -83,20 +84,20 @@ val hpara_dll_iso : Sil.hpara_dll -> Sil.hpara_dll -> bool hpara and discovers a list of shared expressions that are passed as arguments to hpara. Both of them are returned as a result. *) val hpara_create : - (Sil.exp * Sil.exp) list -> + (Exp.t * Exp.t) list -> Sil.hpred list -> - Sil.exp -> - Sil.exp -> - Sil.hpara * Sil.exp list + Exp.t -> + Exp.t -> + Sil.hpara * Exp.t list (** [hpara_dll_create] takes a correspondence, and a sigma, a root, a blink and a flink for the first part of this correspondence. Then, it creates a hpara_dll and discovers a list of shared expressions that are passed as arguments to hpara. Both of them are returned as a result. *) val hpara_dll_create : - (Sil.exp * Sil.exp) list -> + (Exp.t * Exp.t) list -> Sil.hpred list -> - Sil.exp -> - Sil.exp -> - Sil.exp -> - Sil.hpara_dll * Sil.exp list + Exp.t -> + Exp.t -> + Exp.t -> + Sil.hpara_dll * Exp.t list diff --git a/infer/src/backend/modelBuiltins.ml b/infer/src/backend/modelBuiltins.ml index 7355fd08a..903dd51ff 100644 --- a/infer/src/backend/modelBuiltins.ml +++ b/infer/src/backend/modelBuiltins.ml @@ -51,7 +51,7 @@ let extract_array_type typ = (** Return a result from a procedure call. *) let return_result e prop ret_ids = match ret_ids with - | [ret_id] -> Prop.conjoin_eq e (Sil.Var ret_id) prop + | [ret_id] -> Prop.conjoin_eq e (Exp.Var ret_id) prop | _ -> prop (* Add an array of typ pointed to by lexp to prop_ if it doesn't already exist *) @@ -72,9 +72,9 @@ let add_array_to_prop pdesc prop_ lexp typ = with Not_found -> (* e is not allocated, so we can add the array *) match extract_array_type typ with | Some arr_typ -> - let len = Sil.Var (Ident.create_fresh Ident.kfootprint) in + let len = Exp.Var (Ident.create_fresh Ident.kfootprint) in let s = mk_empty_array_rearranged len in - let hpred = Prop.mk_ptsto n_lexp s (Sil.Sizeof (arr_typ, Some len, Subtype.exact)) in + let hpred = Prop.mk_ptsto n_lexp s (Exp.Sizeof (arr_typ, Some len, Subtype.exact)) in let sigma = Prop.get_sigma prop in let sigma_fp = Prop.get_sigma_footprint prop in let prop'= Prop.replace_sigma (hpred:: sigma) prop in @@ -155,13 +155,13 @@ let create_type tenv n_lexp typ prop = | Typ.Tptr (typ', _) -> let sexp = Sil.Estruct ([], Sil.inst_none) in let typ'' = Tenv.expand_type tenv typ' in - let texp = Sil.Sizeof (typ'', None, Subtype.subtypes) in + let texp = Exp.Sizeof (typ'', None, Subtype.subtypes) in let hpred = Prop.mk_ptsto n_lexp sexp texp in Some hpred | Typ.Tarray _ -> - let len = Sil.Var (Ident.create_fresh Ident.kfootprint) in + let len = Exp.Var (Ident.create_fresh Ident.kfootprint) in let sexp = mk_empty_array len in - let texp = Sil.Sizeof (typ, None, Subtype.subtypes) in + let texp = Exp.Sizeof (typ, None, Subtype.subtypes) in let hpred = Prop.mk_ptsto n_lexp sexp texp in Some hpred | _ -> None in @@ -179,8 +179,8 @@ let create_type tenv n_lexp typ prop = let prop''= Prop.normalize prop'' in prop'' | None -> prop in - let sil_is_null = Sil.BinOp (Binop.Eq, n_lexp, Sil.exp_zero) in - let sil_is_nonnull = Sil.UnOp (Unop.LNot, sil_is_null, None) in + let sil_is_null = Exp.BinOp (Binop.Eq, n_lexp, Sil.exp_zero) in + let sil_is_nonnull = Exp.UnOp (Unop.LNot, sil_is_null, None) in let null_case = Propset.to_proplist (prune ~positive:true sil_is_null prop) in let non_null_case = Propset.to_proplist (prune ~positive:true sil_is_nonnull prop_type) in if ((IList.length non_null_case) > 0) && (!Config.footprint) then @@ -390,7 +390,7 @@ let execute___get_hidden_field { Builtin.pdesc; prop_; path; ret_ids; args; } let return_val p = match !ret_val with | Some e -> return_result e p ret_ids | None -> p in - let foot_var = lazy (Sil.Var (Ident.create_fresh Ident.kfootprint)) in + let foot_var = lazy (Exp.Var (Ident.create_fresh Ident.kfootprint)) in let filter_fld_hidden (f, _ ) = Ident.fieldname_is_hidden f in let has_fld_hidden fsel = IList.exists filter_fld_hidden fsel in let do_hpred in_foot hpred = match hpred with @@ -426,7 +426,7 @@ let execute___set_hidden_field { Builtin.pdesc; prop_; path; args; } let pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp1, prop__ = check_arith_norm_exp pname lexp1 prop_ in let n_lexp2, prop = check_arith_norm_exp pname lexp2 prop__ in - let foot_var = lazy (Sil.Var (Ident.create_fresh Ident.kfootprint)) in + let foot_var = lazy (Exp.Var (Ident.create_fresh Ident.kfootprint)) in let filter_fld_hidden (f, _ ) = Ident.fieldname_is_hidden f in let has_fld_hidden fsel = IList.exists filter_fld_hidden fsel in let do_hpred in_foot hpred = match hpred with @@ -471,14 +471,14 @@ let execute___objc_counter_update (* This is the case as a call f(o) it's translates as n$1=*&o; f(n$1) *) (* n$2 = *n$1.hidden *) let tmp = Ident.create_fresh Ident.knormal in - let hidden_field = Sil.Lfield(lexp, Ident.fieldname_hidden, typ') in + let hidden_field = Exp.Lfield(lexp, Ident.fieldname_hidden, typ') in let counter_to_tmp = Sil.Letderef(tmp, hidden_field, typ', loc) in (* *n$1.hidden = (n$2 +/- delta) *) let update_counter = Sil.Set (hidden_field, typ', - Sil.BinOp(op, Sil.Var tmp, Sil.Const (Const.Cint delta)), + Exp.BinOp(op, Exp.Var tmp, Exp.Const (Const.Cint delta)), loc) in let update_counter_instrs = [ counter_to_tmp; update_counter; Sil.Remove_temps([tmp], loc) ] in @@ -490,7 +490,7 @@ let execute___objc_counter_update removed from the list of args. *) let get_suppress_npe_flag args = match args with - | (Sil.Const (Const.Cint i), Typ.Tint Typ.IBool):: args' when IntLit.isone i -> + | (Exp.Const (Const.Cint i), Typ.Tint Typ.IBool):: args' when IntLit.isone i -> false, args' (* this is a CFRelease/CFRetain *) | _ -> true, args @@ -565,7 +565,7 @@ let execute___release_autorelease_pool | Sil.Hpointsto(e1, _, _) -> Sil.exp_equal e1 exp | _ -> false) (Prop.get_sigma prop_) in match hpred with - | Sil.Hpointsto (_, _, Sil.Sizeof (typ, _, _)) -> + | Sil.Hpointsto (_, _, Exp.Sizeof (typ, _, _)) -> let res1 = execute___objc_release { builtin_args with @@ -629,7 +629,7 @@ let execute___set_taint_attribute ({ Builtin.pdesc; args; prop_; path; }) : Builtin.ret_typ = match args with - | (exp, _) :: [(Sil.Const (Const.Cstr taint_kind_str), _)] -> + | (exp, _) :: [(Exp.Const (Const.Cstr taint_kind_str), _)] -> let taint_source = Cfg.Procdesc.get_proc_name pdesc in let taint_kind = match taint_kind_str with | "UnverifiedSSLSocket" -> Sil.Tk_unverified_SSL_socket @@ -664,7 +664,7 @@ let execute___objc_cast { Builtin.pdesc; prop_; path; ret_ids; args; } | Sil.Hpointsto(e1, _, _) -> Sil.exp_equal e1 val1 | _ -> false) (Prop.get_sigma prop) in match hpred, texp2 with - | Sil.Hpointsto (val1, _, _), Sil.Sizeof _ -> + | Sil.Hpointsto (val1, _, _), Exp.Sizeof _ -> let prop' = replace_ptsto_texp prop val1 texp2 in [(return_result val1 prop' ret_ids, path)] | _ -> [(return_result val1 prop ret_ids, path)] @@ -747,30 +747,30 @@ let execute_alloc mk can_return_null : Builtin.ret_typ = let pname = Cfg.Procdesc.get_proc_name pdesc in let rec evaluate_char_sizeof e = match e with - | Sil.Var _ -> e - | Sil.UnOp (uop, e', typ) -> - Sil.UnOp (uop, evaluate_char_sizeof e', typ) - | Sil.BinOp (bop, e1', e2') -> - Sil.BinOp (bop, evaluate_char_sizeof e1', evaluate_char_sizeof e2') - | Sil.Exn _ | Sil.Closure _ | Sil.Const _ | Sil.Cast _ | Sil.Lvar _ | Sil.Lfield _ - | Sil.Lindex _ -> e - | Sil.Sizeof (Typ.Tarray (Typ.Tint ik, _), Some len, _) when Typ.ikind_is_char ik -> + | Exp.Var _ -> e + | Exp.UnOp (uop, e', typ) -> + Exp.UnOp (uop, evaluate_char_sizeof e', typ) + | Exp.BinOp (bop, e1', e2') -> + Exp.BinOp (bop, evaluate_char_sizeof e1', evaluate_char_sizeof e2') + | Exp.Exn _ | Exp.Closure _ | Exp.Const _ | Exp.Cast _ | Exp.Lvar _ | Exp.Lfield _ + | Exp.Lindex _ -> e + | Exp.Sizeof (Typ.Tarray (Typ.Tint ik, _), Some len, _) when Typ.ikind_is_char ik -> evaluate_char_sizeof len - | Sil.Sizeof (Typ.Tarray (Typ.Tint ik, Some len), None, _) when Typ.ikind_is_char ik -> - evaluate_char_sizeof (Sil.Const (Const.Cint len)) - | Sil.Sizeof _ -> e in + | Exp.Sizeof (Typ.Tarray (Typ.Tint ik, Some len), None, _) when Typ.ikind_is_char ik -> + evaluate_char_sizeof (Exp.Const (Const.Cint len)) + | Exp.Sizeof _ -> e in let size_exp, procname = match args with - | [(Sil.Sizeof + | [(Exp.Sizeof (Typ.Tstruct { Typ.csu = Csu.Class Csu.Objc; struct_name = Some c } as s, len, subt), _)] -> let struct_type = match AttributesTable.get_correct_type_from_objc_class_name c with | Some struct_type -> struct_type | None -> s in - Sil.Sizeof (struct_type, len, subt), pname + Exp.Sizeof (struct_type, len, subt), pname | [(size_exp, _)] -> (* for malloc and __new *) size_exp, Sil.mem_alloc_pname mk - | [(size_exp, _); (Sil.Const (Const.Cfun pname), _)] -> + | [(size_exp, _); (Exp.Const (Const.Cfun pname), _)] -> size_exp, pname | _ -> raise (Exceptions.Wrong_argument_number __POS__) in @@ -782,9 +782,9 @@ let execute_alloc mk can_return_null let n_size_exp' = evaluate_char_sizeof n_size_exp in Prop.exp_normalize_prop prop n_size_exp', prop in let cnt_te = - Sil.Sizeof (Typ.Tarray (Typ.Tint Typ.IChar, None), Some size_exp', Subtype.exact) in + Exp.Sizeof (Typ.Tarray (Typ.Tint Typ.IChar, None), Some size_exp', Subtype.exact) in let id_new = Ident.create_fresh Ident.kprimed in - let exp_new = Sil.Var id_new in + let exp_new = Exp.Var id_new in let ptsto_new = Prop.mk_ptsto_exp (Some tenv) Prop.Fld_init (exp_new, cnt_te, None) Sil.Ialloc in let prop_plus_ptsto = @@ -797,9 +797,9 @@ let execute_alloc mk can_return_null Sil.ra_vpath = None } in (* mark value as allocated *) Prop.add_or_replace_attribute prop' (Apred (Aresource ra, [exp_new])) in - let prop_alloc = Prop.conjoin_eq (Sil.Var ret_id) exp_new prop_plus_ptsto in + let prop_alloc = Prop.conjoin_eq (Exp.Var ret_id) exp_new prop_plus_ptsto in if can_return_null then - let prop_null = Prop.conjoin_eq (Sil.Var ret_id) Sil.exp_zero prop in + let prop_null = Prop.conjoin_eq (Exp.Var ret_id) Sil.exp_zero prop in [(prop_alloc, path); (prop_null, path)] else [(prop_alloc, path)] @@ -818,11 +818,11 @@ let execute___cxx_typeid ({ Builtin.pdesc; tenv; prop_; args; loc} as r) | Sil.Hpointsto (e, _, _) -> Sil.exp_equal e n_lexp | _ -> false) (Prop.get_sigma prop) in match hpred with - | Sil.Hpointsto (_, _, Sil.Sizeof (dynamic_type, _, _)) -> dynamic_type + | Sil.Hpointsto (_, _, Exp.Sizeof (dynamic_type, _, _)) -> dynamic_type | _ -> typ with Not_found -> typ in let typ_string = Typ.to_string typ in - let set_instr = Sil.Set (field_exp, Typ.Tvoid, Sil.Const (Const.Cstr typ_string), loc) in + let set_instr = Sil.Set (field_exp, Typ.Tvoid, Exp.Const (Const.Cstr typ_string), loc) in SymExec.instrs ~mask_errors:true tenv pdesc [set_instr] res | _ -> res) | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -834,7 +834,7 @@ let execute_pthread_create ({ Builtin.prop_; path; args; } as builtin_args) let routine_name = Prop.exp_normalize_prop prop_ (fst start_routine) in let routine_arg = Prop.exp_normalize_prop prop_ (fst arg) in (match routine_name, (snd start_routine) with - | Sil.Lvar pvar, _ -> + | Exp.Lvar pvar, _ -> let fun_name = Pvar.get_name pvar in let fun_string = Mangled.to_string fun_name in L.d_strln ("pthread_create: calling function " ^ fun_string); @@ -875,7 +875,7 @@ let execute__unwrap_exception { Builtin.pdesc; prop_; path; ret_ids; args; } let pname = Cfg.Procdesc.get_proc_name pdesc in let n_ret_exn, prop = check_arith_norm_exp pname ret_exn prop_ in match n_ret_exn with - | Sil.Exn exp -> + | Exp.Exn exp -> let prop_with_exn = return_result exp prop ret_ids in [(prop_with_exn, path)] | _ -> assert false @@ -901,12 +901,12 @@ let execute___split_get_nth { Builtin.pdesc; prop_; path; ret_ids; args; } let n_lexp2, prop___ = check_arith_norm_exp pname lexp2 prop__ in let n_lexp3, prop = check_arith_norm_exp pname lexp3 prop___ in (match n_lexp1, n_lexp2, n_lexp3 with - | Sil.Const (Const.Cstr str1), Sil.Const (Const.Cstr str2), Sil.Const (Const.Cint n_sil) -> + | Exp.Const (Const.Cstr str1), Exp.Const (Const.Cstr str2), Exp.Const (Const.Cint n_sil) -> (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 res = Sil.Const (Const.Cstr n_part) in + let res = Exp.Const (Const.Cstr n_part) in [(return_result res prop ret_ids, path)] with Not_found -> assert false) | _ -> [(prop, path)]) @@ -932,13 +932,13 @@ let execute___infer_fail { Builtin.pdesc; tenv; prop_; path; args; loc; } | [(lexp_msg, _)] -> begin match Prop.exp_normalize_prop prop_ lexp_msg with - | Sil.Const (Const.Cstr str) -> str + | Exp.Const (Const.Cstr str) -> str | _ -> assert false end | _ -> raise (Exceptions.Wrong_argument_number __POS__) in let set_instr = - Sil.Set (Sil.Lvar Sil.custom_error, Typ.Tvoid, Sil.Const (Const.Cstr error_str), loc) in + Sil.Set (Exp.Lvar Sil.custom_error, Typ.Tvoid, Exp.Const (Const.Cstr error_str), loc) in SymExec.instrs ~mask_errors:true tenv pdesc [set_instr] [(prop_, path)] (* translate builtin assertion failure *) @@ -951,7 +951,7 @@ let execute___assert_fail { Builtin.pdesc; tenv; prop_; path; args; loc; } | _ -> raise (Exceptions.Wrong_argument_number __POS__) in let set_instr = - Sil.Set (Sil.Lvar Sil.custom_error, Typ.Tvoid, Sil.Const (Const.Cstr error_str), loc) in + Sil.Set (Exp.Lvar Sil.custom_error, Typ.Tvoid, Exp.Const (Const.Cstr error_str), loc) in SymExec.instrs ~mask_errors:true tenv pdesc [set_instr] [(prop_, path)] let __assert_fail = Builtin.register @@ -1154,12 +1154,12 @@ let _ = Builtin.register let execute_objc_alloc_no_fail symb_state typ alloc_fun_opt { Builtin.pdesc; tenv; ret_ids; loc; } = - let alloc_fun = Sil.Const (Const.Cfun __objc_alloc_no_fail) in + let alloc_fun = Exp.Const (Const.Cfun __objc_alloc_no_fail) in let ptr_typ = Typ.Tptr (typ, Typ.Pk_pointer) in - let sizeof_typ = Sil.Sizeof (typ, None, Subtype.exact) in + let sizeof_typ = Exp.Sizeof (typ, None, Subtype.exact) in let alloc_fun_exp = match alloc_fun_opt with - | Some pname -> [Sil.Const (Const.Cfun pname), Typ.Tvoid] + | Some pname -> [Exp.Const (Const.Cfun pname), Typ.Tvoid] | None -> [] in let alloc_instr = Sil.Call diff --git a/infer/src/backend/preanal.ml b/infer/src/backend/preanal.ml index b515c1ae7..08ed25982 100644 --- a/infer/src/backend/preanal.ml +++ b/infer/src/backend/preanal.ml @@ -24,7 +24,7 @@ let add_dispatch_calls pdesc cg tenv = let has_dispatch_call instrs = IList.exists instr_is_dispatch_call instrs in let replace_dispatch_calls = function - | Sil.Call (ret_ids, (Sil.Const (Const.Cfun callee_pname) as call_exp), + | Sil.Call (ret_ids, (Exp.Const (Const.Cfun callee_pname) as call_exp), (((_, receiver_typ) :: _) as args), loc, call_flags) as instr when call_flags_is_dispatch call_flags -> (* the frontend should not populate the list of targets *) @@ -143,7 +143,7 @@ module NullifyTransferFunctions = struct active_defs lhs_ids in active_defs', to_nullify - | Sil.Set (Sil.Lvar lhs_pvar, _, _, _) -> + | Sil.Set (Exp.Lvar lhs_pvar, _, _, _) -> VarDomain.add (Var.of_pvar lhs_pvar) active_defs, to_nullify | Sil.Set _ | Prune _ | Declare_locals _ | Stackop _ | Remove_temps _ | Abstract _ -> @@ -218,9 +218,9 @@ let add_nullify_instrs pdesc tenv liveness_inv_map = Var.Set.fold (fun var (pvars_acc, ids_acc) -> match Var.to_exp var with (* we nullify all address taken variables at the end of the procedure *) - | Sil.Lvar pvar when not (AddressTaken.Domain.mem pvar address_taken_vars) -> + | Exp.Lvar pvar when not (AddressTaken.Domain.mem pvar address_taken_vars) -> pvar :: pvars_acc, ids_acc - | Sil.Var id -> + | Exp.Var id -> pvars_acc, id :: ids_acc | _ -> pvars_acc, ids_acc) to_nullify @@ -259,7 +259,7 @@ let do_copy_propagation pdesc tenv = | _ -> last_id in id_sub_inner var_map var' last_id' with Not_found -> - Sil.Var last_id in + Exp.Var last_id in id_sub_inner var_map (Var.of_id id) id in (* perform copy-propagation on each instruction in [node] *) diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index 9088464be..6ca9794ad 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -179,10 +179,10 @@ let force_delayed_print fmt = let (n: int) = Obj.obj n in for _ = 1 to n do F.fprintf fmt "@]" done | (L.PTexp, e) -> - let (e: Sil.exp) = Obj.obj e in + let (e: Exp.t) = Obj.obj e in Sil.pp_exp pe_default fmt e | (L.PTexp_list, el) -> - let (el: Sil.exp list) = Obj.obj el in + let (el: Exp.t list) = Obj.obj el in Sil.pp_exp_list pe_default fmt el | (L.PThpred, hpred) -> let (hpred: Sil.hpred) = Obj.obj hpred in @@ -306,7 +306,7 @@ let force_delayed_print fmt = let (sub: Sil.subst) = Obj.obj sub in Prop.pp_sub pe_default fmt sub | (L.PTtexp_full, te) -> - let (te: Sil.exp) = Obj.obj te in + let (te: Exp.t) = Obj.obj te in Sil.pp_texp_full pe_default fmt te | (L.PTtyp_full, t) -> let (t: Typ.t) = Obj.obj t in diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index 2abc19de0..a8fc57ec0 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -117,9 +117,9 @@ let pp_texp_simple pe = match pe.pe_opt with let pp_hpred_stackvar pe0 f hpred = let pe, changed = Sil.color_pre_wrapper pe0 f hpred in begin match hpred with - | Sil.Hpointsto (Sil.Lvar pvar, se, te) -> + | Sil.Hpointsto (Exp.Lvar pvar, se, te) -> let pe' = match se with - | Sil.Eexp (Sil.Var _, _) when not (Pvar.is_global pvar) -> + | Sil.Eexp (Exp.Var _, _) when not (Pvar.is_global pvar) -> { pe with pe_obj_sub = None } (* dont use obj sub on the var defining it *) | _ -> pe in (match pe'.pe_kind with @@ -134,7 +134,7 @@ let pp_hpred_stackvar pe0 f hpred = (** Pretty print a substitution. *) let pp_sub pe f sub = - let pi_sub = IList.map (fun (id, e) -> Sil.Aeq(Sil.Var id, e)) (Sil.sub_to_list sub) in + let pi_sub = IList.map (fun (id, e) -> Sil.Aeq(Exp.Var id, e)) (Sil.sub_to_list sub) in (pp_semicolon_seq_oneline pe (Sil.pp_atom pe)) f pi_sub (** Dump a substitution. *) @@ -173,7 +173,7 @@ let pp_sigma pe = The boolean indicates whether the stack should only include local variales. *) let sigma_get_stack_nonstack only_local_vars sigma = let hpred_is_stack_var = function - | Sil.Hpointsto (Sil.Lvar pvar, _, _) -> not only_local_vars || Pvar.is_local pvar + | Sil.Hpointsto (Exp.Lvar pvar, _, _) -> not only_local_vars || Pvar.is_local pvar | _ -> false in IList.partition hpred_is_stack_var sigma @@ -208,7 +208,7 @@ let get_sub (p: 'a t) : Sil.subst = p.sub let get_pi (p: 'a t) : pi = p.pi let pi_of_subst sub = - IList.map (fun (id1, e2) -> Sil.Aeq (Sil.Var id1, e2)) (Sil.sub_to_list sub) + IList.map (fun (id1, e2) -> Sil.Aeq (Exp.Var id1, e2)) (Sil.sub_to_list sub) (** Return the pure part of [prop]. *) let get_pure (p: 'a t) : pi = @@ -250,11 +250,11 @@ let pp_hpara_dll_simple _pe env n f pred = (pp_semicolon_seq pe (Sil.pp_hpred_env pe (Some env))) pred.Sil.body_dll (** Create an environment mapping (ident) expressions to the program variables containing them *) -let create_pvar_env (sigma: sigma) : (Sil.exp -> Sil.exp) = +let create_pvar_env (sigma: sigma) : (Exp.t -> Exp.t) = let env = ref [] in let filter = function - | Sil.Hpointsto (Sil.Lvar pvar, Sil.Eexp (Sil.Var v, _), _) -> - if not (Pvar.is_global pvar) then env := (Sil.Var v, Sil.Lvar pvar) :: !env + | Sil.Hpointsto (Exp.Lvar pvar, Sil.Eexp (Exp.Var v, _), _) -> + if not (Pvar.is_global pvar) then env := (Exp.Var v, Exp.Lvar pvar) :: !env | _ -> () in IList.iter filter sigma; let find e = @@ -390,7 +390,7 @@ let prop_fav_nonpure = Sil.fav_imperative_to_functional prop_fav_nonpure_add let hpred_fav_in_pvars_add fav = function - | Sil.Hpointsto (Sil.Lvar _, sexp, _) -> Sil.strexp_fav_add fav sexp + | Sil.Hpointsto (Exp.Lvar _, sexp, _) -> Sil.strexp_fav_add fav sexp | Sil.Hpointsto _ | Sil.Hlseg _ | Sil.Hdllseg _ -> () let sigma_fav_in_pvars_add fav sigma = @@ -421,7 +421,7 @@ let sigma_sub subst sigma = (** {2 Functions for normalization} *) -(** This function assumes that if (x,Sil.Var(y)) in sub, then compare x y = 1 *) +(** This function assumes that if (x,Exp.Var(y)) in sub, then compare x y = 1 *) let sub_normalize sub = let f (id, e) = (not (Ident.is_primed id)) && (not (Sil.ident_in_exp id e)) in let sub' = Sil.sub_filter_pair f sub in @@ -449,168 +449,168 @@ let sym_eval abs e = let rec eval e = (* L.d_str " ["; Sil.d_exp e; L.d_str"] "; *) match e with - | Sil.Var _ -> + | Exp.Var _ -> e - | Sil.Closure c -> + | Exp.Closure c -> let captured_vars = IList.map (fun (exp, pvar, typ) -> (eval exp, pvar, typ)) c.captured_vars in - Sil.Closure { c with captured_vars; } - | Sil.Const _ -> + Exp.Closure { c with captured_vars; } + | Exp.Const _ -> e - | Sil.Sizeof (Typ.Tarray (Typ.Tint ik, _), Some l, _) + | Exp.Sizeof (Typ.Tarray (Typ.Tint ik, _), Some l, _) when Typ.ikind_is_char ik && !Config.curr_language = Config.Clang -> eval l - | Sil.Sizeof (Typ.Tarray (Typ.Tint ik, Some l), _, _) + | Exp.Sizeof (Typ.Tarray (Typ.Tint ik, Some l), _, _) when Typ.ikind_is_char ik && !Config.curr_language = Config.Clang -> - Sil.Const (Const.Cint l) - | Sil.Sizeof _ -> + Exp.Const (Const.Cint l) + | Exp.Sizeof _ -> e - | Sil.Cast (_, e1) -> + | Exp.Cast (_, e1) -> eval e1 - | Sil.UnOp (Unop.LNot, e1, topt) -> + | Exp.UnOp (Unop.LNot, e1, topt) -> begin match eval e1 with - | Sil.Const (Const.Cint i) when IntLit.iszero i -> + | Exp.Const (Const.Cint i) when IntLit.iszero i -> Sil.exp_one - | Sil.Const (Const.Cint _) -> + | Exp.Const (Const.Cint _) -> Sil.exp_zero - | Sil.UnOp(Unop.LNot, e1', _) -> + | Exp.UnOp(Unop.LNot, e1', _) -> e1' | e1' -> - if abs then Sil.exp_get_undefined false else Sil.UnOp(Unop.LNot, e1', topt) + if abs then Sil.exp_get_undefined false else Exp.UnOp(Unop.LNot, e1', topt) end - | Sil.UnOp (Unop.Neg, e1, topt) -> + | Exp.UnOp (Unop.Neg, e1, topt) -> begin match eval e1 with - | Sil.UnOp (Unop.Neg, e2', _) -> + | Exp.UnOp (Unop.Neg, e2', _) -> e2' - | Sil.Const (Const.Cint i) -> + | Exp.Const (Const.Cint i) -> Sil.exp_int (IntLit.neg i) - | Sil.Const (Const.Cfloat v) -> + | Exp.Const (Const.Cfloat v) -> Sil.exp_float (-. v) - | Sil.Var id -> - Sil.UnOp (Unop.Neg, Sil.Var id, topt) + | Exp.Var id -> + Exp.UnOp (Unop.Neg, Exp.Var id, topt) | e1' -> - if abs then Sil.exp_get_undefined false else Sil.UnOp (Unop.Neg, e1', topt) + if abs then Sil.exp_get_undefined false else Exp.UnOp (Unop.Neg, e1', topt) end - | Sil.UnOp (Unop.BNot, e1, topt) -> + | Exp.UnOp (Unop.BNot, e1, topt) -> begin match eval e1 with - | Sil.UnOp(Unop.BNot, e2', _) -> + | Exp.UnOp(Unop.BNot, e2', _) -> e2' - | Sil.Const (Const.Cint i) -> + | Exp.Const (Const.Cint i) -> Sil.exp_int (IntLit.lognot i) | e1' -> - if abs then Sil.exp_get_undefined false else Sil.UnOp (Unop.BNot, e1', topt) + if abs then Sil.exp_get_undefined false else Exp.UnOp (Unop.BNot, e1', topt) end - | Sil.BinOp (Binop.Le, e1, e2) -> + | Exp.BinOp (Binop.Le, e1, e2) -> begin match eval e1, eval e2 with - | Sil.Const (Const.Cint n), Sil.Const (Const.Cint m) -> + | Exp.Const (Const.Cint n), Exp.Const (Const.Cint m) -> Sil.exp_bool (IntLit.leq n m) - | Sil.Const (Const.Cfloat v), Sil.Const (Const.Cfloat w) -> + | Exp.Const (Const.Cfloat v), Exp.Const (Const.Cfloat w) -> Sil.exp_bool (v <= w) - | Sil.BinOp (Binop.PlusA, e3, Sil.Const (Const.Cint n)), Sil.Const (Const.Cint m) -> - Sil.BinOp (Binop.Le, e3, Sil.exp_int (m -- n)) + | Exp.BinOp (Binop.PlusA, e3, Exp.Const (Const.Cint n)), Exp.Const (Const.Cint m) -> + Exp.BinOp (Binop.Le, e3, Sil.exp_int (m -- n)) | e1', e2' -> Sil.exp_le e1' e2' end - | Sil.BinOp (Binop.Lt, e1, e2) -> + | Exp.BinOp (Binop.Lt, e1, e2) -> begin match eval e1, eval e2 with - | Sil.Const (Const.Cint n), Sil.Const (Const.Cint m) -> + | Exp.Const (Const.Cint n), Exp.Const (Const.Cint m) -> Sil.exp_bool (IntLit.lt n m) - | Sil.Const (Const.Cfloat v), Sil.Const (Const.Cfloat w) -> + | Exp.Const (Const.Cfloat v), Exp.Const (Const.Cfloat w) -> Sil.exp_bool (v < w) - | Sil.Const (Const.Cint n), Sil.BinOp (Binop.MinusA, f1, f2) -> - Sil.BinOp - (Binop.Le, Sil.BinOp (Binop.MinusA, f2, f1), Sil.exp_int (IntLit.minus_one -- n)) - | Sil.BinOp(Binop.MinusA, f1 , f2), Sil.Const(Const.Cint n) -> - Sil.exp_le (Sil.BinOp(Binop.MinusA, f1 , f2)) (Sil.exp_int (n -- IntLit.one)) - | Sil.BinOp (Binop.PlusA, e3, Sil.Const (Const.Cint n)), Sil.Const (Const.Cint m) -> - Sil.BinOp (Binop.Lt, e3, Sil.exp_int (m -- n)) + | Exp.Const (Const.Cint n), Exp.BinOp (Binop.MinusA, f1, f2) -> + Exp.BinOp + (Binop.Le, Exp.BinOp (Binop.MinusA, f2, f1), Sil.exp_int (IntLit.minus_one -- n)) + | Exp.BinOp(Binop.MinusA, f1 , f2), Exp.Const(Const.Cint n) -> + Sil.exp_le (Exp.BinOp(Binop.MinusA, f1 , f2)) (Sil.exp_int (n -- IntLit.one)) + | Exp.BinOp (Binop.PlusA, e3, Exp.Const (Const.Cint n)), Exp.Const (Const.Cint m) -> + Exp.BinOp (Binop.Lt, e3, Sil.exp_int (m -- n)) | e1', e2' -> Sil.exp_lt e1' e2' end - | Sil.BinOp (Binop.Ge, e1, e2) -> + | Exp.BinOp (Binop.Ge, e1, e2) -> eval (Sil.exp_le e2 e1) - | Sil.BinOp (Binop.Gt, e1, e2) -> + | Exp.BinOp (Binop.Gt, e1, e2) -> eval (Sil.exp_lt e2 e1) - | Sil.BinOp (Binop.Eq, e1, e2) -> + | Exp.BinOp (Binop.Eq, e1, e2) -> begin match eval e1, eval e2 with - | Sil.Const (Const.Cint n), Sil.Const (Const.Cint m) -> + | Exp.Const (Const.Cint n), Exp.Const (Const.Cint m) -> Sil.exp_bool (IntLit.eq n m) - | Sil.Const (Const.Cfloat v), Sil.Const (Const.Cfloat w) -> + | Exp.Const (Const.Cfloat v), Exp.Const (Const.Cfloat w) -> Sil.exp_bool (v = w) | e1', e2' -> Sil.exp_eq e1' e2' end - | Sil.BinOp (Binop.Ne, e1, e2) -> + | Exp.BinOp (Binop.Ne, e1, e2) -> begin match eval e1, eval e2 with - | Sil.Const (Const.Cint n), Sil.Const (Const.Cint m) -> + | Exp.Const (Const.Cint n), Exp.Const (Const.Cint m) -> Sil.exp_bool (IntLit.neq n m) - | Sil.Const (Const.Cfloat v), Sil.Const (Const.Cfloat w) -> + | Exp.Const (Const.Cfloat v), Exp.Const (Const.Cfloat w) -> Sil.exp_bool (v <> w) | e1', e2' -> Sil.exp_ne e1' e2' end - | Sil.BinOp (Binop.LAnd, e1, e2) -> + | Exp.BinOp (Binop.LAnd, e1, e2) -> let e1' = eval e1 in let e2' = eval e2 in begin match e1', e2' with - | Sil.Const (Const.Cint i), _ when IntLit.iszero i -> + | Exp.Const (Const.Cint i), _ when IntLit.iszero i -> e1' - | Sil.Const (Const.Cint _), _ -> + | Exp.Const (Const.Cint _), _ -> e2' - | _, Sil.Const (Const.Cint i) when IntLit.iszero i -> + | _, Exp.Const (Const.Cint i) when IntLit.iszero i -> e2' - | _, Sil.Const (Const.Cint _) -> + | _, Exp.Const (Const.Cint _) -> e1' | _ -> - Sil.BinOp (Binop.LAnd, e1', e2') + Exp.BinOp (Binop.LAnd, e1', e2') end - | Sil.BinOp (Binop.LOr, e1, e2) -> + | Exp.BinOp (Binop.LOr, e1, e2) -> let e1' = eval e1 in let e2' = eval e2 in begin match e1', e2' with - | Sil.Const (Const.Cint i), _ when IntLit.iszero i -> + | Exp.Const (Const.Cint i), _ when IntLit.iszero i -> e2' - | Sil.Const (Const.Cint _), _ -> + | Exp.Const (Const.Cint _), _ -> e1' - | _, Sil.Const (Const.Cint i) when IntLit.iszero i -> + | _, Exp.Const (Const.Cint i) when IntLit.iszero i -> e1' - | _, Sil.Const (Const.Cint _) -> + | _, Exp.Const (Const.Cint _) -> e2' | _ -> - Sil.BinOp (Binop.LOr, e1', e2') + Exp.BinOp (Binop.LOr, e1', e2') end - | Sil.BinOp(Binop.PlusPI, Sil.Lindex (ep, e1), e2) -> (* array access with pointer arithmetic *) - let e' = Sil.BinOp (Binop.PlusA, e1, e2) in - eval (Sil.Lindex (ep, e')) - | Sil.BinOp (Binop.PlusPI, (Sil.BinOp (Binop.PlusPI, e11, e12)), e2) -> + | Exp.BinOp(Binop.PlusPI, Exp.Lindex (ep, e1), e2) -> (* array access with pointer arithmetic *) + let e' = Exp.BinOp (Binop.PlusA, e1, e2) in + eval (Exp.Lindex (ep, e')) + | Exp.BinOp (Binop.PlusPI, (Exp.BinOp (Binop.PlusPI, e11, e12)), e2) -> (* take care of pattern ((ptr + off1) + off2) *) (* progress: convert inner +I to +A *) - let e2' = Sil.BinOp (Binop.PlusA, e12, e2) in - eval (Sil.BinOp (Binop.PlusPI, e11, e2')) - | Sil.BinOp (Binop.PlusA as oplus, e1, e2) - | Sil.BinOp (Binop.PlusPI as oplus, e1, e2) -> + let e2' = Exp.BinOp (Binop.PlusA, e12, e2) in + eval (Exp.BinOp (Binop.PlusPI, e11, e2')) + | Exp.BinOp (Binop.PlusA as oplus, e1, e2) + | Exp.BinOp (Binop.PlusPI as oplus, e1, e2) -> let e1' = eval e1 in let e2' = eval e2 in let isPlusA = oplus = Binop.PlusA in let ominus = if isPlusA then Binop.MinusA else Binop.MinusPI in let (+++) x y = match x, y with - | _, Sil.Const (Const.Cint i) when IntLit.iszero i -> x - | Sil.Const (Const.Cint i), Sil.Const (Const.Cint j) -> - Sil.Const (Const.Cint (IntLit.add i j)) - | _ -> Sil.BinOp (oplus, x, y) in + | _, Exp.Const (Const.Cint i) when IntLit.iszero i -> x + | Exp.Const (Const.Cint i), Exp.Const (Const.Cint j) -> + Exp.Const (Const.Cint (IntLit.add i j)) + | _ -> Exp.BinOp (oplus, x, y) in let (---) x y = match x, y with - | _, Sil.Const (Const.Cint i) when IntLit.iszero i -> x - | Sil.Const (Const.Cint i), Sil.Const (Const.Cint j) -> - Sil.Const (Const.Cint (IntLit.sub i j)) - | _ -> Sil.BinOp (ominus, x, y) in + | _, Exp.Const (Const.Cint i) when IntLit.iszero i -> x + | Exp.Const (Const.Cint i), Exp.Const (Const.Cint j) -> + Exp.Const (Const.Cint (IntLit.sub i j)) + | _ -> Exp.BinOp (ominus, x, y) in (* test if the extensible array at the end of [typ] has elements of type [elt] *) let extensible_array_element_typ_equal elt typ = Option.map_default (Typ.equal elt) false (Typ.get_extensible_array_element_typ typ) in @@ -618,219 +618,219 @@ let sym_eval abs e = match e1', e2' with (* pattern for arrays and extensible structs: sizeof(struct s {... t[l]}) + k * sizeof(t)) = sizeof(struct s {... t[l + k]}) *) - | Sil.Sizeof (typ, len1_opt, st), Sil.BinOp (Binop.Mult, len2, Sil.Sizeof (elt, None, _)) + | Exp.Sizeof (typ, len1_opt, st), Exp.BinOp (Binop.Mult, len2, Exp.Sizeof (elt, None, _)) when isPlusA && (extensible_array_element_typ_equal elt typ) -> let len = match len1_opt with Some len1 -> len1 +++ len2 | None -> len2 in - Sil.Sizeof (typ, Some len, st) - | Sil.Const c, _ when iszero_int_float c -> + Exp.Sizeof (typ, Some len, st) + | Exp.Const c, _ when iszero_int_float c -> e2' - | _, Sil.Const c when iszero_int_float c -> + | _, Exp.Const c when iszero_int_float c -> e1' - | Sil.Const (Const.Cint n), Sil.Const (Const.Cint m) -> + | Exp.Const (Const.Cint n), Exp.Const (Const.Cint m) -> Sil.exp_int (n ++ m) - | Sil.Const (Const.Cfloat v), Sil.Const (Const.Cfloat w) -> + | Exp.Const (Const.Cfloat v), Exp.Const (Const.Cfloat w) -> Sil.exp_float (v +. w) - | Sil.UnOp(Unop.Neg, f1, _), f2 - | f2, Sil.UnOp(Unop.Neg, f1, _) -> - Sil.BinOp (ominus, f2, f1) - | Sil.BinOp (Binop.PlusA, e, Sil.Const (Const.Cint n1)), Sil.Const (Const.Cint n2) - | Sil.BinOp (Binop.PlusPI, e, Sil.Const (Const.Cint n1)), Sil.Const (Const.Cint n2) - | Sil.Const (Const.Cint n2), Sil.BinOp (Binop.PlusA, e, Sil.Const (Const.Cint n1)) - | Sil.Const (Const.Cint n2), Sil.BinOp (Binop.PlusPI, e, Sil.Const (Const.Cint n1)) -> + | Exp.UnOp(Unop.Neg, f1, _), f2 + | f2, Exp.UnOp(Unop.Neg, f1, _) -> + Exp.BinOp (ominus, f2, f1) + | Exp.BinOp (Binop.PlusA, e, Exp.Const (Const.Cint n1)), Exp.Const (Const.Cint n2) + | Exp.BinOp (Binop.PlusPI, e, Exp.Const (Const.Cint n1)), Exp.Const (Const.Cint n2) + | Exp.Const (Const.Cint n2), Exp.BinOp (Binop.PlusA, e, Exp.Const (Const.Cint n1)) + | Exp.Const (Const.Cint n2), Exp.BinOp (Binop.PlusPI, e, Exp.Const (Const.Cint n1)) -> e +++ (Sil.exp_int (n1 ++ n2)) - | Sil.BinOp (Binop.MinusA, Sil.Const (Const.Cint n1), e), Sil.Const (Const.Cint n2) - | Sil.Const (Const.Cint n2), Sil.BinOp (Binop.MinusA, Sil.Const (Const.Cint n1), e) -> + | Exp.BinOp (Binop.MinusA, Exp.Const (Const.Cint n1), e), Exp.Const (Const.Cint n2) + | Exp.Const (Const.Cint n2), Exp.BinOp (Binop.MinusA, Exp.Const (Const.Cint n1), e) -> Sil.exp_int (n1 ++ n2) --- e - | Sil.BinOp (Binop.MinusA, e1, e2), e3 -> (* (e1-e2)+e3 --> e1 + (e3-e2) *) + | Exp.BinOp (Binop.MinusA, e1, e2), e3 -> (* (e1-e2)+e3 --> e1 + (e3-e2) *) (* progress: brings + to the outside *) eval (e1 +++ (e3 --- e2)) - | _, Sil.Const _ -> + | _, Exp.Const _ -> e1' +++ e2' - | Sil.Const _, _ -> + | Exp.Const _, _ -> if isPlusA then e2' +++ e1' else e1' +++ e2' - | Sil.Var _, Sil.Var _ -> + | Exp.Var _, Exp.Var _ -> e1' +++ e2' | _ -> if abs && isPlusA then Sil.exp_get_undefined false else if abs && not isPlusA then e1' +++ (Sil.exp_get_undefined false) else e1' +++ e2' end - | Sil.BinOp (Binop.MinusA as ominus, e1, e2) - | Sil.BinOp (Binop.MinusPI as ominus, e1, e2) -> + | Exp.BinOp (Binop.MinusA as ominus, e1, e2) + | Exp.BinOp (Binop.MinusPI as ominus, e1, e2) -> let e1' = eval e1 in let e2' = eval e2 in let isMinusA = ominus = Binop.MinusA in let oplus = if isMinusA then Binop.PlusA else Binop.PlusPI in - let (+++) x y = Sil.BinOp (oplus, x, y) in - let (---) x y = Sil.BinOp (ominus, x, y) in + let (+++) x y = Exp.BinOp (oplus, x, y) in + let (---) x y = Exp.BinOp (ominus, x, y) in if Sil.exp_equal e1' e2' then Sil.exp_zero else begin match e1', e2' with - | Sil.Const c, _ when iszero_int_float c -> - eval (Sil.UnOp(Unop.Neg, e2', None)) - | _, Sil.Const c when iszero_int_float c -> + | Exp.Const c, _ when iszero_int_float c -> + eval (Exp.UnOp(Unop.Neg, e2', None)) + | _, Exp.Const c when iszero_int_float c -> e1' - | Sil.Const (Const.Cint n), Sil.Const (Const.Cint m) -> + | Exp.Const (Const.Cint n), Exp.Const (Const.Cint m) -> Sil.exp_int (n -- m) - | Sil.Const (Const.Cfloat v), Sil.Const (Const.Cfloat w) -> + | Exp.Const (Const.Cfloat v), Exp.Const (Const.Cfloat w) -> Sil.exp_float (v -. w) - | _, Sil.UnOp (Unop.Neg, f2, _) -> + | _, Exp.UnOp (Unop.Neg, f2, _) -> eval (e1 +++ f2) - | _ , Sil.Const(Const.Cint n) -> + | _ , Exp.Const(Const.Cint n) -> eval (e1' +++ (Sil.exp_int (IntLit.neg n))) - | Sil.Const _, _ -> + | Exp.Const _, _ -> e1' --- e2' - | Sil.Var _, Sil.Var _ -> + | Exp.Var _, Exp.Var _ -> e1' --- e2' | _, _ -> if abs then Sil.exp_get_undefined false else e1' --- e2' end - | Sil.BinOp (Binop.MinusPP, e1, e2) -> + | Exp.BinOp (Binop.MinusPP, e1, e2) -> if abs then Sil.exp_get_undefined false - else Sil.BinOp (Binop.MinusPP, eval e1, eval e2) - | Sil.BinOp (Binop.Mult, e1, e2) -> + else Exp.BinOp (Binop.MinusPP, eval e1, eval e2) + | Exp.BinOp (Binop.Mult, e1, e2) -> let e1' = eval e1 in let e2' = eval e2 in begin match e1', e2' with - | Sil.Const c, _ when iszero_int_float c -> + | Exp.Const c, _ when iszero_int_float c -> Sil.exp_zero - | Sil.Const c, _ when isone_int_float c -> + | Exp.Const c, _ when isone_int_float c -> e2' - | Sil.Const c, _ when isminusone_int_float c -> - eval (Sil.UnOp (Unop.Neg, e2', None)) - | _, Sil.Const c when iszero_int_float c -> + | Exp.Const c, _ when isminusone_int_float c -> + eval (Exp.UnOp (Unop.Neg, e2', None)) + | _, Exp.Const c when iszero_int_float c -> Sil.exp_zero - | _, Sil.Const c when isone_int_float c -> + | _, Exp.Const c when isone_int_float c -> e1' - | _, Sil.Const c when isminusone_int_float c -> - eval (Sil.UnOp (Unop.Neg, e1', None)) - | Sil.Const (Const.Cint n), Sil.Const (Const.Cint m) -> + | _, Exp.Const c when isminusone_int_float c -> + eval (Exp.UnOp (Unop.Neg, e1', None)) + | Exp.Const (Const.Cint n), Exp.Const (Const.Cint m) -> Sil.exp_int (IntLit.mul n m) - | Sil.Const (Const.Cfloat v), Sil.Const (Const.Cfloat w) -> + | Exp.Const (Const.Cfloat v), Exp.Const (Const.Cfloat w) -> Sil.exp_float (v *. w) - | Sil.Var _, Sil.Var _ -> - Sil.BinOp(Binop.Mult, e1', e2') - | _, Sil.Sizeof _ - | Sil.Sizeof _, _ -> - Sil.BinOp(Binop.Mult, e1', e2') + | Exp.Var _, Exp.Var _ -> + Exp.BinOp(Binop.Mult, e1', e2') + | _, Exp.Sizeof _ + | Exp.Sizeof _, _ -> + Exp.BinOp(Binop.Mult, e1', e2') | _, _ -> - if abs then Sil.exp_get_undefined false else Sil.BinOp(Binop.Mult, e1', e2') + if abs then Sil.exp_get_undefined false else Exp.BinOp(Binop.Mult, e1', e2') end - | Sil.BinOp (Binop.Div, e1, e2) -> + | Exp.BinOp (Binop.Div, e1, e2) -> let e1' = eval e1 in let e2' = eval e2 in begin match e1', e2' with - | _, Sil.Const c when iszero_int_float c -> + | _, Exp.Const c when iszero_int_float c -> Sil.exp_get_undefined false - | Sil.Const c, _ when iszero_int_float c -> + | Exp.Const c, _ when iszero_int_float c -> e1' - | _, Sil.Const c when isone_int_float c -> + | _, Exp.Const c when isone_int_float c -> e1' - | Sil.Const (Const.Cint n), Sil.Const (Const.Cint m) -> + | Exp.Const (Const.Cint n), Exp.Const (Const.Cint m) -> Sil.exp_int (IntLit.div n m) - | Sil.Const (Const.Cfloat v), Sil.Const (Const.Cfloat w) -> + | Exp.Const (Const.Cfloat v), Exp.Const (Const.Cfloat w) -> Sil.exp_float (v /.w) - | Sil.Sizeof (Typ.Tarray (elt, _), Some len, _), Sil.Sizeof (elt2, None, _) + | Exp.Sizeof (Typ.Tarray (elt, _), Some len, _), Exp.Sizeof (elt2, None, _) (* pattern: sizeof(elt[len]) / sizeof(elt) = len *) when Typ.equal elt elt2 -> len - | Sil.Sizeof (Typ.Tarray (elt, Some len), None, _), Sil.Sizeof (elt2, None, _) + | Exp.Sizeof (Typ.Tarray (elt, Some len), None, _), Exp.Sizeof (elt2, None, _) (* pattern: sizeof(elt[len]) / sizeof(elt) = len *) when Typ.equal elt elt2 -> - Sil.Const (Const.Cint len) + Exp.Const (Const.Cint len) | _ -> - if abs then Sil.exp_get_undefined false else Sil.BinOp (Binop.Div, e1', e2') + if abs then Sil.exp_get_undefined false else Exp.BinOp (Binop.Div, e1', e2') end - | Sil.BinOp (Binop.Mod, e1, e2) -> + | Exp.BinOp (Binop.Mod, e1, e2) -> let e1' = eval e1 in let e2' = eval e2 in begin match e1', e2' with - | _, Sil.Const (Const.Cint i) when IntLit.iszero i -> + | _, Exp.Const (Const.Cint i) when IntLit.iszero i -> Sil.exp_get_undefined false - | Sil.Const (Const.Cint i), _ when IntLit.iszero i -> + | Exp.Const (Const.Cint i), _ when IntLit.iszero i -> e1' - | _, Sil.Const (Const.Cint i) when IntLit.isone i -> + | _, Exp.Const (Const.Cint i) when IntLit.isone i -> Sil.exp_zero - | Sil.Const (Const.Cint n), Sil.Const (Const.Cint m) -> + | Exp.Const (Const.Cint n), Exp.Const (Const.Cint m) -> Sil.exp_int (IntLit.rem n m) | _ -> - if abs then Sil.exp_get_undefined false else Sil.BinOp (Binop.Mod, e1', e2') + if abs then Sil.exp_get_undefined false else Exp.BinOp (Binop.Mod, e1', e2') end - | Sil.BinOp (Binop.Shiftlt, e1, e2) -> - if abs then Sil.exp_get_undefined false else Sil.BinOp (Binop.Shiftlt, eval e1, eval e2) - | Sil.BinOp (Binop.Shiftrt, e1, e2) -> - if abs then Sil.exp_get_undefined false else Sil.BinOp (Binop.Shiftrt, eval e1, eval e2) - | Sil.BinOp (Binop.BAnd, e1, e2) -> + | Exp.BinOp (Binop.Shiftlt, e1, e2) -> + if abs then Sil.exp_get_undefined false else Exp.BinOp (Binop.Shiftlt, eval e1, eval e2) + | Exp.BinOp (Binop.Shiftrt, e1, e2) -> + if abs then Sil.exp_get_undefined false else Exp.BinOp (Binop.Shiftrt, eval e1, eval e2) + | Exp.BinOp (Binop.BAnd, e1, e2) -> let e1' = eval e1 in let e2' = eval e2 in begin match e1', e2' with - | Sil.Const (Const.Cint i), _ when IntLit.iszero i -> + | Exp.Const (Const.Cint i), _ when IntLit.iszero i -> e1' - | _, Sil.Const (Const.Cint i) when IntLit.iszero i -> + | _, Exp.Const (Const.Cint i) when IntLit.iszero i -> e2' - | Sil.Const (Const.Cint i1), Sil.Const(Const.Cint i2) -> + | Exp.Const (Const.Cint i1), Exp.Const(Const.Cint i2) -> Sil.exp_int (IntLit.logand i1 i2) | _ -> - if abs then Sil.exp_get_undefined false else Sil.BinOp (Binop.BAnd, e1', e2') + if abs then Sil.exp_get_undefined false else Exp.BinOp (Binop.BAnd, e1', e2') end - | Sil.BinOp (Binop.BOr, e1, e2) -> + | Exp.BinOp (Binop.BOr, e1, e2) -> let e1' = eval e1 in let e2' = eval e2 in begin match e1', e2' with - | Sil.Const (Const.Cint i), _ when IntLit.iszero i -> + | Exp.Const (Const.Cint i), _ when IntLit.iszero i -> e2' - | _, Sil.Const (Const.Cint i) when IntLit.iszero i -> + | _, Exp.Const (Const.Cint i) when IntLit.iszero i -> e1' - | Sil.Const (Const.Cint i1), Sil.Const(Const.Cint i2) -> + | Exp.Const (Const.Cint i1), Exp.Const(Const.Cint i2) -> Sil.exp_int (IntLit.logor i1 i2) | _ -> - if abs then Sil.exp_get_undefined false else Sil.BinOp (Binop.BOr, e1', e2') + if abs then Sil.exp_get_undefined false else Exp.BinOp (Binop.BOr, e1', e2') end - | Sil.BinOp (Binop.BXor, e1, e2) -> + | Exp.BinOp (Binop.BXor, e1, e2) -> let e1' = eval e1 in let e2' = eval e2 in begin match e1', e2' with - | Sil.Const (Const.Cint i), _ when IntLit.iszero i -> + | Exp.Const (Const.Cint i), _ when IntLit.iszero i -> e2' - | _, Sil.Const (Const.Cint i) when IntLit.iszero i -> + | _, Exp.Const (Const.Cint i) when IntLit.iszero i -> e1' - | Sil.Const (Const.Cint i1), Sil.Const(Const.Cint i2) -> + | Exp.Const (Const.Cint i1), Exp.Const(Const.Cint i2) -> Sil.exp_int (IntLit.logxor i1 i2) | _ -> - if abs then Sil.exp_get_undefined false else Sil.BinOp (Binop.BXor, e1', e2') + if abs then Sil.exp_get_undefined false else Exp.BinOp (Binop.BXor, e1', e2') end - | Sil.BinOp (Binop.PtrFld, e1, e2) -> + | Exp.BinOp (Binop.PtrFld, e1, e2) -> let e1' = eval e1 in let e2' = eval e2 in begin match e2' with - | Sil.Const (Const.Cptr_to_fld (fn, typ)) -> - eval (Sil.Lfield(e1', fn, typ)) - | Sil.Const (Const.Cint i) when IntLit.iszero i -> + | Exp.Const (Const.Cptr_to_fld (fn, typ)) -> + eval (Exp.Lfield(e1', fn, typ)) + | Exp.Const (Const.Cint i) when IntLit.iszero i -> Sil.exp_zero (* cause a NULL dereference *) - | _ -> Sil.BinOp (Binop.PtrFld, e1', e2') + | _ -> Exp.BinOp (Binop.PtrFld, e1', e2') end - | Sil.Exn _ -> + | Exp.Exn _ -> e - | Sil.Lvar _ -> + | Exp.Lvar _ -> e - | Sil.Lfield (e1, fld, typ) -> + | Exp.Lfield (e1, fld, typ) -> let e1' = eval e1 in - Sil.Lfield (e1', fld, typ) - | Sil.Lindex(Sil.Lvar pv, e2) when false + Exp.Lfield (e1', fld, typ) + | Exp.Lindex(Exp.Lvar pv, e2) when false (* removed: it interferes with re-arrangement and error messages *) -> (* &x[n] --> &x + n *) - eval (Sil.BinOp (Binop.PlusPI, Sil.Lvar pv, e2)) - | Sil.Lindex (Sil.BinOp(Binop.PlusPI, ep, e1), e2) -> (* array access with pointer arithmetic *) - let e' = Sil.BinOp (Binop.PlusA, e1, e2) in - eval (Sil.Lindex (ep, e')) - | Sil.Lindex (e1, e2) -> + eval (Exp.BinOp (Binop.PlusPI, Exp.Lvar pv, e2)) + | Exp.Lindex (Exp.BinOp(Binop.PlusPI, ep, e1), e2) -> (* array access with pointer arithmetic *) + let e' = Exp.BinOp (Binop.PlusA, e1, e2) in + eval (Exp.Lindex (ep, e')) + | Exp.Lindex (e1, e2) -> let e1' = eval e1 in let e2' = eval e2 in - Sil.Lindex(e1', e2') in + Exp.Lindex(e1', e2') in let e' = eval e in (* L.d_str "sym_eval "; Sil.d_exp e; L.d_str" --> "; Sil.d_exp e'; L.d_ln (); *) e' @@ -841,7 +841,7 @@ let exp_normalize sub exp = else sym_eval false exp' let texp_normalize sub exp = match exp with - | Sil.Sizeof (typ, len, st) -> Sil.Sizeof (typ, Option.map (exp_normalize sub) len, st) + | Exp.Sizeof (typ, len, st) -> Exp.Sizeof (typ, Option.map (exp_normalize sub) len, st) | _ -> exp_normalize sub exp let exp_normalize_noabs sub exp = @@ -849,20 +849,20 @@ let exp_normalize_noabs sub exp = (** Return [true] if the atom is an inequality *) let atom_is_inequality = function - | Sil.Aeq (Sil.BinOp (Binop.Le, _, _), Sil.Const (Const.Cint i)) when IntLit.isone i -> true - | Sil.Aeq (Sil.BinOp (Binop.Lt, _, _), Sil.Const (Const.Cint i)) when IntLit.isone i -> true + | Sil.Aeq (Exp.BinOp (Binop.Le, _, _), Exp.Const (Const.Cint i)) when IntLit.isone i -> true + | Sil.Aeq (Exp.BinOp (Binop.Lt, _, _), Exp.Const (Const.Cint i)) when IntLit.isone i -> true | _ -> false (** If the atom is [e<=n] return [e,n] *) let atom_exp_le_const = function - | Sil.Aeq(Sil.BinOp (Binop.Le, e1, Sil.Const (Const.Cint n)), Sil.Const (Const.Cint i)) + | Sil.Aeq(Exp.BinOp (Binop.Le, e1, Exp.Const (Const.Cint n)), Exp.Const (Const.Cint i)) when IntLit.isone i -> Some (e1, n) | _ -> None (** If the atom is [n Some (n, e1) | _ -> None @@ -870,56 +870,56 @@ let atom_const_lt_exp = function (** Turn an inequality expression into an atom *) let mk_inequality e = match e with - | Sil.BinOp (Binop.Le, base, Sil.Const (Const.Cint n)) -> + | Exp.BinOp (Binop.Le, base, Exp.Const (Const.Cint n)) -> (* base <= n case *) let nbase = exp_normalize_noabs Sil.sub_empty base in (match nbase with - | Sil.BinOp(Binop.PlusA, base', Sil.Const (Const.Cint n')) -> + | Exp.BinOp(Binop.PlusA, base', Exp.Const (Const.Cint n')) -> let new_offset = Sil.exp_int (n -- n') in - let new_e = Sil.BinOp (Binop.Le, base', new_offset) in + let new_e = Exp.BinOp (Binop.Le, base', new_offset) in Sil.Aeq (new_e, Sil.exp_one) - | Sil.BinOp(Binop.PlusA, Sil.Const (Const.Cint n'), base') -> + | Exp.BinOp(Binop.PlusA, Exp.Const (Const.Cint n'), base') -> let new_offset = Sil.exp_int (n -- n') in - let new_e = Sil.BinOp (Binop.Le, base', new_offset) in + let new_e = Exp.BinOp (Binop.Le, base', new_offset) in Sil.Aeq (new_e, Sil.exp_one) - | Sil.BinOp(Binop.MinusA, base', Sil.Const (Const.Cint n')) -> + | Exp.BinOp(Binop.MinusA, base', Exp.Const (Const.Cint n')) -> let new_offset = Sil.exp_int (n ++ n') in - let new_e = Sil.BinOp (Binop.Le, base', new_offset) in + let new_e = Exp.BinOp (Binop.Le, base', new_offset) in Sil.Aeq (new_e, Sil.exp_one) - | Sil.BinOp(Binop.MinusA, Sil.Const (Const.Cint n'), base') -> + | Exp.BinOp(Binop.MinusA, Exp.Const (Const.Cint n'), base') -> let new_offset = Sil.exp_int (n' -- n -- IntLit.one) in - let new_e = Sil.BinOp (Binop.Lt, new_offset, base') in + let new_e = Exp.BinOp (Binop.Lt, new_offset, base') in Sil.Aeq (new_e, Sil.exp_one) - | Sil.UnOp(Unop.Neg, new_base, _) -> + | Exp.UnOp(Unop.Neg, new_base, _) -> (* In this case, base = -new_base. Construct -n-1 < new_base. *) let new_offset = Sil.exp_int (IntLit.zero -- n -- IntLit.one) in - let new_e = Sil.BinOp (Binop.Lt, new_offset, new_base) in + let new_e = Exp.BinOp (Binop.Lt, new_offset, new_base) in Sil.Aeq (new_e, Sil.exp_one) | _ -> Sil.Aeq (e, Sil.exp_one)) - | Sil.BinOp (Binop.Lt, Sil.Const (Const.Cint n), base) -> + | Exp.BinOp (Binop.Lt, Exp.Const (Const.Cint n), base) -> (* n < base case *) let nbase = exp_normalize_noabs Sil.sub_empty base in (match nbase with - | Sil.BinOp(Binop.PlusA, base', Sil.Const (Const.Cint n')) -> + | Exp.BinOp(Binop.PlusA, base', Exp.Const (Const.Cint n')) -> let new_offset = Sil.exp_int (n -- n') in - let new_e = Sil.BinOp (Binop.Lt, new_offset, base') in + let new_e = Exp.BinOp (Binop.Lt, new_offset, base') in Sil.Aeq (new_e, Sil.exp_one) - | Sil.BinOp(Binop.PlusA, Sil.Const (Const.Cint n'), base') -> + | Exp.BinOp(Binop.PlusA, Exp.Const (Const.Cint n'), base') -> let new_offset = Sil.exp_int (n -- n') in - let new_e = Sil.BinOp (Binop.Lt, new_offset, base') in + let new_e = Exp.BinOp (Binop.Lt, new_offset, base') in Sil.Aeq (new_e, Sil.exp_one) - | Sil.BinOp(Binop.MinusA, base', Sil.Const (Const.Cint n')) -> + | Exp.BinOp(Binop.MinusA, base', Exp.Const (Const.Cint n')) -> let new_offset = Sil.exp_int (n ++ n') in - let new_e = Sil.BinOp (Binop.Lt, new_offset, base') in + let new_e = Exp.BinOp (Binop.Lt, new_offset, base') in Sil.Aeq (new_e, Sil.exp_one) - | Sil.BinOp(Binop.MinusA, Sil.Const (Const.Cint n'), base') -> + | Exp.BinOp(Binop.MinusA, Exp.Const (Const.Cint n'), base') -> let new_offset = Sil.exp_int (n' -- n -- IntLit.one) in - let new_e = Sil.BinOp (Binop.Le, base', new_offset) in + let new_e = Exp.BinOp (Binop.Le, base', new_offset) in Sil.Aeq (new_e, Sil.exp_one) - | Sil.UnOp(Unop.Neg, new_base, _) -> + | Exp.UnOp(Unop.Neg, new_base, _) -> (* In this case, base = -new_base. Construct new_base <= -n-1 *) let new_offset = Sil.exp_int (IntLit.zero -- n -- IntLit.one) in - let new_e = Sil.BinOp (Binop.Le, new_base, new_offset) in + let new_e = Exp.BinOp (Binop.Le, new_base, new_offset) in Sil.Aeq (new_e, Sil.exp_one) | _ -> Sil.Aeq (e, Sil.exp_one)) | _ -> Sil.Aeq (e, Sil.exp_one) @@ -929,18 +929,18 @@ let inequality_normalize a = (* turn an expression into a triple (pos,neg,off) of positive and negative occurrences, and integer offset representing inequality [sum(pos) - sum(neg) + off <= 0] *) let rec exp_to_posnegoff e = match e with - | Sil.Const (Const.Cint n) -> [],[], n - | Sil.BinOp(Binop.PlusA, e1, e2) | Sil.BinOp(Binop.PlusPI, e1, e2) -> + | Exp.Const (Const.Cint n) -> [],[], n + | Exp.BinOp(Binop.PlusA, e1, e2) | Exp.BinOp(Binop.PlusPI, e1, e2) -> let pos1, neg1, n1 = exp_to_posnegoff e1 in let pos2, neg2, n2 = exp_to_posnegoff e2 in (pos1@pos2, neg1@neg2, n1 ++ n2) - | Sil.BinOp(Binop.MinusA, e1, e2) - | Sil.BinOp(Binop.MinusPI, e1, e2) - | Sil.BinOp(Binop.MinusPP, e1, e2) -> + | Exp.BinOp(Binop.MinusA, e1, e2) + | Exp.BinOp(Binop.MinusPI, e1, e2) + | Exp.BinOp(Binop.MinusPP, e1, e2) -> let pos1, neg1, n1 = exp_to_posnegoff e1 in let pos2, neg2, n2 = exp_to_posnegoff e2 in (pos1@neg2, neg1@pos2, n1 -- n2) - | Sil.UnOp(Unop.Neg, e1, _) -> + | Exp.UnOp(Unop.Neg, e1, _) -> let pos1, neg1, n1 = exp_to_posnegoff e1 in (neg1, pos1, IntLit.zero -- n1) | _ -> [e],[], IntLit.zero in @@ -961,25 +961,25 @@ let inequality_normalize a = let rec exp_list_to_sum = function | [] -> assert false | [e] -> e - | e:: el -> Sil.BinOp(Binop.PlusA, e, exp_list_to_sum el) in + | e:: el -> Exp.BinOp(Binop.PlusA, e, exp_list_to_sum el) in let norm_from_exp e = match normalize_posnegoff (exp_to_posnegoff e) with - | [],[], n -> Sil.BinOp(Binop.Le, Sil.exp_int n, Sil.exp_zero) - | [], neg, n -> Sil.BinOp(Binop.Lt, Sil.exp_int (n -- IntLit.one), exp_list_to_sum neg) - | pos, [], n -> Sil.BinOp(Binop.Le, exp_list_to_sum pos, Sil.exp_int (IntLit.zero -- n)) + | [],[], n -> Exp.BinOp(Binop.Le, Sil.exp_int n, Sil.exp_zero) + | [], neg, n -> Exp.BinOp(Binop.Lt, Sil.exp_int (n -- IntLit.one), exp_list_to_sum neg) + | pos, [], n -> Exp.BinOp(Binop.Le, exp_list_to_sum pos, Sil.exp_int (IntLit.zero -- n)) | pos, neg, n -> - let lhs_e = Sil.BinOp(Binop.MinusA, exp_list_to_sum pos, exp_list_to_sum neg) in - Sil.BinOp(Binop.Le, lhs_e, Sil.exp_int (IntLit.zero -- n)) in + let lhs_e = Exp.BinOp(Binop.MinusA, exp_list_to_sum pos, exp_list_to_sum neg) in + Exp.BinOp(Binop.Le, lhs_e, Sil.exp_int (IntLit.zero -- n)) in let ineq = match a with - | Sil.Aeq (ineq, Sil.Const (Const.Cint i)) when IntLit.isone i -> + | Sil.Aeq (ineq, Exp.Const (Const.Cint i)) when IntLit.isone i -> ineq | _ -> assert false in match ineq with - | Sil.BinOp(Binop.Le, e1, e2) -> - let e = Sil.BinOp(Binop.MinusA, e1, e2) in + | Exp.BinOp(Binop.Le, e1, e2) -> + let e = Exp.BinOp(Binop.MinusA, e1, e2) in mk_inequality (norm_from_exp e) - | Sil.BinOp(Binop.Lt, e1, e2) -> - let e = Sil.BinOp(Binop.MinusA, Sil.BinOp(Binop.MinusA, e1, e2), Sil.exp_minus_one) in + | Exp.BinOp(Binop.Lt, e1, e2) -> + let e = Exp.BinOp(Binop.MinusA, Exp.BinOp(Binop.MinusA, e1, e2), Sil.exp_minus_one) in mk_inequality (norm_from_exp e) | _ -> a @@ -991,30 +991,30 @@ let exp_reorder e1 e2 = if Sil.exp_compare e1 e2 <= 0 then (e1, e2) else (e2, e1 let atom_normalize sub a0 = let a = Sil.atom_sub sub a0 in let rec normalize_eq eq = match eq with - | Sil.BinOp(Binop.PlusA, e1, Sil.Const (Const.Cint n1)), Sil.Const (Const.Cint n2) + | Exp.BinOp(Binop.PlusA, e1, Exp.Const (Const.Cint n1)), Exp.Const (Const.Cint n2) (* e1+n1==n2 ---> e1==n2-n1 *) - | Sil.BinOp(Binop.PlusPI, e1, Sil.Const (Const.Cint n1)), Sil.Const (Const.Cint n2) -> + | Exp.BinOp(Binop.PlusPI, e1, Exp.Const (Const.Cint n1)), Exp.Const (Const.Cint n2) -> (e1, Sil.exp_int (n2 -- n1)) - | Sil.BinOp(Binop.MinusA, e1, Sil.Const (Const.Cint n1)), Sil.Const (Const.Cint n2) + | Exp.BinOp(Binop.MinusA, e1, Exp.Const (Const.Cint n1)), Exp.Const (Const.Cint n2) (* e1-n1==n2 ---> e1==n1+n2 *) - | Sil.BinOp(Binop.MinusPI, e1, Sil.Const (Const.Cint n1)), Sil.Const (Const.Cint n2) -> + | Exp.BinOp(Binop.MinusPI, e1, Exp.Const (Const.Cint n1)), Exp.Const (Const.Cint n2) -> (e1, Sil.exp_int (n1 ++ n2)) - | Sil.BinOp(Binop.MinusA, Sil.Const (Const.Cint n1), e1), Sil.Const (Const.Cint n2) -> + | Exp.BinOp(Binop.MinusA, Exp.Const (Const.Cint n1), e1), Exp.Const (Const.Cint n2) -> (* n1-e1 == n2 -> e1==n1-n2 *) (e1, Sil.exp_int (n1 -- n2)) - | Sil.Lfield (e1', fld1, _), Sil.Lfield (e2', fld2, _) -> + | Exp.Lfield (e1', fld1, _), Exp.Lfield (e2', fld2, _) -> if Ident.fieldname_equal fld1 fld2 then normalize_eq (e1', e2') else eq - | Sil.Lindex (e1', idx1), Sil.Lindex (e2', idx2) -> + | Exp.Lindex (e1', idx1), Exp.Lindex (e2', idx2) -> if Sil.exp_equal idx1 idx2 then normalize_eq (e1', e2') else if Sil.exp_equal e1' e2' then normalize_eq (idx1, idx2) else eq | _ -> eq in let handle_unary_negation e1 e2 = match e1, e2 with - | Sil.UnOp (Unop.LNot, e1', _), Sil.Const (Const.Cint i) - | Sil.Const (Const.Cint i), Sil.UnOp (Unop.LNot, e1', _) when IntLit.iszero i -> + | Exp.UnOp (Unop.LNot, e1', _), Exp.Const (Const.Cint i) + | Exp.Const (Const.Cint i), Exp.UnOp (Unop.LNot, e1', _) when IntLit.iszero i -> (e1', Sil.exp_zero, true) | _ -> (e1, e2, false) in let handle_boolean_operation from_equality e1 e2 = @@ -1042,9 +1042,9 @@ let atom_normalize sub a0 = (** Negate an atom *) let atom_negate = function - | Sil.Aeq (Sil.BinOp (Binop.Le, e1, e2), Sil.Const (Const.Cint i)) when IntLit.isone i -> + | Sil.Aeq (Exp.BinOp (Binop.Le, e1, e2), Exp.Const (Const.Cint i)) when IntLit.isone i -> mk_inequality (Sil.exp_lt e2 e1) - | Sil.Aeq (Sil.BinOp (Binop.Lt, e1, e2), Sil.Const (Const.Cint i)) when IntLit.isone i -> + | Sil.Aeq (Exp.BinOp (Binop.Lt, e1, e2), Exp.Const (Const.Cint i)) when IntLit.isone i -> mk_inequality (Sil.exp_le e2 e1) | Sil.Aeq (e1, e2) -> Sil.Aneq (e1, e2) | Sil.Aneq (e1, e2) -> Sil.Aeq (e1, e2) @@ -1088,11 +1088,11 @@ let rec create_strexp_of_type tenvo struct_init_mode typ len inst = let create_fresh_var () = let fresh_id = (Ident.create_fresh (if !Config.footprint then Ident.kfootprint else Ident.kprimed)) in - Sil.Var fresh_id in + Exp.Var fresh_id in if !Config.curr_language = Config.Java && inst = Sil.Ialloc then match typ with - | Typ.Tfloat _ -> Sil.Const (Const.Cfloat 0.0) + | Typ.Tfloat _ -> Exp.Const (Const.Cfloat 0.0) | _ -> Sil.exp_zero else create_fresh_var () in @@ -1117,7 +1117,7 @@ let rec create_strexp_of_type tenvo struct_init_mode typ len inst = | Typ.Tarray (_, len_opt), None -> let len = match len_opt with | None -> Sil.exp_get_undefined false - | Some len -> Sil.Const (Const.Cint len) in + | Some len -> Exp.Const (Const.Cint len) in Sil.Earray (len, [], inst) | Typ.Tarray _, Some len -> Sil.Earray (len, [], inst) @@ -1125,7 +1125,7 @@ let rec create_strexp_of_type tenvo struct_init_mode typ len inst = | (Typ.Tint _ | Typ.Tfloat _ | Typ.Tvoid | Typ.Tfun _ | Typ.Tptr _), Some _ -> assert false -(** Sil.Construct a pointsto. *) +(** Exp.Construct a pointsto. *) let mk_ptsto lexp sexp te = let nsexp = strexp_normalize Sil.sub_empty sexp in Sil.Hpointsto(lexp, nsexp, te) @@ -1136,9 +1136,9 @@ let mk_ptsto lexp sexp te = initialize the fields of structs with fresh variables. *) let mk_ptsto_exp tenvo struct_init_mode (exp, te, expo) inst : Sil.hpred = let default_strexp () = match te with - | Sil.Sizeof (typ, len, _) -> + | Exp.Sizeof (typ, len, _) -> create_strexp_of_type tenvo struct_init_mode typ len inst - | Sil.Var _ -> + | Exp.Var _ -> Sil.Estruct ([], inst) | te -> L.err "trying to create ptsto with type: %a@\n@." (Sil.pp_texp_full pe_text) te; @@ -1165,24 +1165,24 @@ let rec hpred_normalize sub hpred = let normalized_cnt = strexp_normalize sub cnt in let normalized_te = texp_normalize sub te in begin match normalized_cnt, normalized_te with - | Sil.Earray (Sil.Sizeof _ as size, [], inst), Sil.Sizeof (Typ.Tarray _, _, _) -> + | Sil.Earray (Exp.Sizeof _ as size, [], inst), Exp.Sizeof (Typ.Tarray _, _, _) -> (* check for an empty array whose size expression is (Sizeof type), and turn the array into a strexp of the given type *) let hpred' = mk_ptsto_exp None Fld_init (root, size, None) inst in replace_hpred hpred' - | ( Sil.Earray (Sil.BinOp (Binop.Mult, Sil.Sizeof (t, None, st1), x), esel, inst) - | Sil.Earray (Sil.BinOp (Binop.Mult, x, Sil.Sizeof (t, None, st1)), esel, inst)), - Sil.Sizeof (Typ.Tarray (elt, _) as arr, _, _) + | ( Sil.Earray (Exp.BinOp (Binop.Mult, Exp.Sizeof (t, None, st1), x), esel, inst) + | Sil.Earray (Exp.BinOp (Binop.Mult, x, Exp.Sizeof (t, None, st1)), esel, inst)), + Exp.Sizeof (Typ.Tarray (elt, _) as arr, _, _) when Typ.equal t elt -> let len = Some x in - let hpred' = mk_ptsto_exp None Fld_init (root, Sil.Sizeof (arr, len, st1), None) inst in + let hpred' = mk_ptsto_exp None Fld_init (root, Exp.Sizeof (arr, len, st1), None) inst in replace_hpred (replace_array_contents hpred' esel) - | ( Sil.Earray (Sil.BinOp (Binop.Mult, Sil.Sizeof (t, Some len, st1), x), esel, inst) - | Sil.Earray (Sil.BinOp (Binop.Mult, x, Sil.Sizeof (t, Some len, st1)), esel, inst)), - Sil.Sizeof (Typ.Tarray (elt, _) as arr, _, _) + | ( Sil.Earray (Exp.BinOp (Binop.Mult, Exp.Sizeof (t, Some len, st1), x), esel, inst) + | Sil.Earray (Exp.BinOp (Binop.Mult, x, Exp.Sizeof (t, Some len, st1)), esel, inst)), + Exp.Sizeof (Typ.Tarray (elt, _) as arr, _, _) when Typ.equal t elt -> - let len = Some (Sil.BinOp(Binop.Mult, x, len)) in - let hpred' = mk_ptsto_exp None Fld_init (root, Sil.Sizeof (arr, len, st1), None) inst in + let len = Some (Exp.BinOp(Binop.Mult, x, len)) in + let hpred' = mk_ptsto_exp None Fld_init (root, Exp.Sizeof (arr, len, st1), None) inst in replace_hpred (replace_array_contents hpred' esel) | _ -> Sil.Hpointsto (normalized_root, normalized_cnt, normalized_te) end @@ -1215,8 +1215,8 @@ let pi_tighten_ineq pi = let ineq_list, nonineq_list = IList.partition atom_is_inequality pi in let diseq_list = let get_disequality_info acc = function - | Sil.Aneq(Sil.Const (Const.Cint n), e) - | Sil.Aneq(e, Sil.Const (Const.Cint n)) -> (e, n) :: acc + | Sil.Aneq(Exp.Const (Const.Cint n), e) + | Sil.Aneq(e, Exp.Const (Const.Cint n)) -> (e, n) :: acc | _ -> acc in IList.fold_left get_disequality_info [] nonineq_list in let is_neq e n = @@ -1249,18 +1249,18 @@ let pi_tighten_ineq pi = let ineq_list' = let le_ineq_list = IList.map - (fun (e, n) -> mk_inequality (Sil.BinOp(Binop.Le, e, Sil.exp_int n))) + (fun (e, n) -> mk_inequality (Exp.BinOp(Binop.Le, e, Sil.exp_int n))) le_list_tightened in let lt_ineq_list = IList.map - (fun (n, e) -> mk_inequality (Sil.BinOp(Binop.Lt, Sil.exp_int n, e))) + (fun (n, e) -> mk_inequality (Exp.BinOp(Binop.Lt, Sil.exp_int n, e))) lt_list_tightened in le_ineq_list @ lt_ineq_list in let nonineq_list' = IList.filter (function - | Sil.Aneq(Sil.Const (Const.Cint n), e) - | Sil.Aneq(e, Sil.Const (Const.Cint n)) -> + | Sil.Aneq(Exp.Const (Const.Cint n), e) + | Sil.Aneq(e, Exp.Const (Const.Cint n)) -> (not (IList.exists (fun (e', n') -> Sil.exp_equal e e' && IntLit.lt n' n) le_list_tightened)) && @@ -1273,15 +1273,15 @@ let pi_tighten_ineq pi = (** remove duplicate atoms and redundant inequalities from a sorted pi *) let rec pi_sorted_remove_redundant = function - | (Sil.Aeq (Sil.BinOp (Binop.Le, e1, Sil.Const (Const.Cint n1)), - Sil.Const (Const.Cint i1)) as a1) :: - Sil.Aeq (Sil.BinOp (Binop.Le, e2, Sil.Const (Const.Cint n2)), - Sil.Const (Const.Cint i2)) :: rest + | (Sil.Aeq (Exp.BinOp (Binop.Le, e1, Exp.Const (Const.Cint n1)), + Exp.Const (Const.Cint i1)) as a1) :: + Sil.Aeq (Exp.BinOp (Binop.Le, e2, Exp.Const (Const.Cint n2)), + Exp.Const (Const.Cint i2)) :: rest when IntLit.isone i1 && IntLit.isone i2 && Sil.exp_equal e1 e2 && IntLit.lt n1 n2 -> (* second inequality redundant *) pi_sorted_remove_redundant (a1 :: rest) - | Sil.Aeq (Sil.BinOp (Binop.Lt, Sil.Const (Const.Cint n1), e1), Sil.Const (Const.Cint i1)) :: - (Sil.Aeq (Sil.BinOp (Binop.Lt, Sil.Const (Const.Cint n2), e2), Sil.Const (Const.Cint i2)) as a2) + | Sil.Aeq (Exp.BinOp (Binop.Lt, Exp.Const (Const.Cint n1), e1), Exp.Const (Const.Cint i1)) :: + (Sil.Aeq (Exp.BinOp (Binop.Lt, Exp.Const (Const.Cint n2), e2), Exp.Const (Const.Cint i2)) as a2) :: rest when IntLit.isone i1 && IntLit.isone i2 && Sil.exp_equal e1 e2 && IntLit.lt n1 n2 -> (* first inequality redundant *) @@ -1296,7 +1296,7 @@ let rec pi_sorted_remove_redundant = function let sigma_get_unsigned_exps sigma = let uexps = ref [] in let do_hpred = function - | Sil.Hpointsto (_, Sil.Eexp (e, _), Sil.Sizeof (Typ.Tint ik, _, _)) + | Sil.Hpointsto (_, Sil.Eexp (e, _), Exp.Sizeof (Typ.Tint ik, _, _)) when Typ.ikind_is_unsigned ik -> uexps := e :: !uexps | _ -> () in @@ -1309,15 +1309,15 @@ let pi_normalize sub sigma pi0 = let pi = IList.map (atom_normalize sub) pi0 in let ineq_list, nonineq_list = pi_tighten_ineq pi in let syntactically_different = function - | Sil.BinOp(op1, e1, Sil.Const(c1)), Sil.BinOp(op2, e2, Sil.Const(c2)) + | Exp.BinOp(op1, e1, Exp.Const(c1)), Exp.BinOp(op2, e2, Exp.Const(c2)) when Sil.exp_equal e1 e2 -> Binop.equal op1 op2 && Binop.injective op1 && not (Const.equal c1 c2) - | e1, Sil.BinOp(op2, e2, Sil.Const(c2)) + | e1, Exp.BinOp(op2, e2, Exp.Const(c2)) when Sil.exp_equal e1 e2 -> Binop.injective op2 && Binop.is_zero_runit op2 && not (Const.equal (Const.Cint IntLit.zero) c2) - | Sil.BinOp(op1, e1, Sil.Const(c1)), e2 + | Exp.BinOp(op1, e1, Exp.Const(c1)), e2 when Sil.exp_equal e1 e2 -> Binop.injective op1 && Binop.is_zero_runit op1 && @@ -1326,11 +1326,11 @@ let pi_normalize sub sigma pi0 = let filter_useful_atom = let unsigned_exps = lazy (sigma_get_unsigned_exps sigma) in function - | Sil.Aneq ((Sil.Var _) as e, Sil.Const (Const.Cint n)) when IntLit.isnegative n -> + | Sil.Aneq ((Exp.Var _) as e, Exp.Const (Const.Cint n)) when IntLit.isnegative n -> not (IList.exists (Sil.exp_equal e) (Lazy.force unsigned_exps)) | Sil.Aneq(e1, e2) -> not (syntactically_different (e1, e2)) - | Sil.Aeq(Sil.Const c1, Sil.Const c2) -> + | Sil.Aeq(Exp.Const c1, Exp.Const c2) -> not (Const.equal c1 c2) | _ -> true in let pi' = @@ -1370,7 +1370,7 @@ let footprint_normalize prop = let ids_footprint = IList.map (fun id -> (id, Ident.create_fresh Ident.kfootprint)) ids_primed in let ren_sub = - Sil.sub_of_list (IList.map (fun (id1, id2) -> (id1, Sil.Var id2)) ids_footprint) in + Sil.sub_of_list (IList.map (fun (id1, id2) -> (id1, Exp.Var id2)) ids_footprint) in let nsigma' = sigma_normalize Sil.sub_empty (sigma_sub ren_sub nsigma) in let npi' = pi_normalize Sil.sub_empty nsigma' (pi_sub ren_sub npi) in (npi', nsigma') in @@ -1403,8 +1403,8 @@ let exp_collapse_consecutive_indices_prop typ exp = | _ -> false in let rec exp_remove e0 = match e0 with - | Sil.Lindex(Sil.Lindex(base, e1), e2) -> - let e0' = Sil.Lindex(base, Sil.BinOp(Binop.PlusA, e1, e2)) in + | Exp.Lindex(Exp.Lindex(base, e1), e2) -> + let e0' = Exp.Lindex(base, Exp.BinOp(Binop.PlusA, e1, e2)) in exp_remove e0' | _ -> e0 in begin @@ -1468,10 +1468,10 @@ let prop_is_emp p = match p.sigma with let mk_atom atom = Config.run_with_abs_val_equal_zero (fun () -> atom_normalize Sil.sub_empty atom) () -(** Sil.Construct a disequality. *) +(** Exp.Construct a disequality. *) let mk_neq e1 e2 = mk_atom (Aneq (e1, e2)) -(** Sil.Construct an equality. *) +(** Exp.Construct an equality. *) let mk_eq e1 e2 = mk_atom (Aeq (e1, e2)) (** Construct a pred. *) @@ -1483,19 +1483,19 @@ let mk_npred a es = mk_atom (Anpred (a, es)) (** Construct a points-to predicate for a single program variable. If [expand_structs] is true, initialize the fields of structs with fresh variables. *) let mk_ptsto_lvar tenv expand_structs inst ((pvar: Pvar.t), texp, expo) : Sil.hpred = - mk_ptsto_exp tenv expand_structs (Sil.Lvar pvar, texp, expo) inst + mk_ptsto_exp tenv expand_structs (Exp.Lvar pvar, texp, expo) inst -(** Sil.Construct a lseg predicate *) +(** Exp.Construct a lseg predicate *) let mk_lseg k para e_start e_end es_shared = let npara = hpara_normalize para in Sil.Hlseg (k, npara, e_start, e_end, es_shared) -(** Sil.Construct a dllseg predicate *) +(** Exp.Construct a dllseg predicate *) let mk_dllseg k para exp_iF exp_oB exp_oF exp_iB exps_shared = let npara = hpara_dll_normalize para in Sil.Hdllseg (k, npara, exp_iF, exp_oB , exp_oF, exp_iB, exps_shared) -(** Sil.Construct a hpara *) +(** Exp.Construct a hpara *) let mk_hpara root next svars evars body = let para = { Sil.root = root; @@ -1505,7 +1505,7 @@ let mk_hpara root next svars evars body = body = body } in hpara_normalize para -(** Sil.Construct a dll_hpara *) +(** Exp.Construct a dll_hpara *) let mk_dll_hpara iF oB oF svars evars body = let para = { Sil.cell = iF; @@ -1538,7 +1538,7 @@ let prop_sigma_star (p : 'a t) (sigma : sigma) : exposed t = (** return the set of subexpressions of [strexp] *) let strexp_get_exps strexp = let rec strexp_get_exps_rec exps = function - | Sil.Eexp (Sil.Exn e, _) -> Sil.ExpSet.add e exps + | Sil.Eexp (Exp.Exn e, _) -> Sil.ExpSet.add e exps | Sil.Eexp (e, _) -> Sil.ExpSet.add e exps | Sil.Estruct (flds, _) -> IList.fold_left (fun exps (_, strexp) -> strexp_get_exps_rec exps strexp) exps flds @@ -1577,13 +1577,13 @@ let get_fld_typ_path_opt src_exps snk_exp_ reachable_hpreds_ = | (_, Sil.Eexp (e, _)) -> Sil.exp_equal target_exp e | _ -> false in let extend_path hpred (snk_exp, path, reachable_hpreds) = match hpred with - | Sil.Hpointsto (lhs, Sil.Estruct (flds, _), Sil.Sizeof (typ, _, _)) -> + | Sil.Hpointsto (lhs, Sil.Estruct (flds, _), Exp.Sizeof (typ, _, _)) -> (try let fld, _ = IList.find (fun fld -> strexp_matches snk_exp fld) flds in let reachable_hpreds' = Sil.HpredSet.remove hpred reachable_hpreds in (lhs, (Some fld, typ) :: path, reachable_hpreds') with Not_found -> (snk_exp, path, reachable_hpreds)) - | Sil.Hpointsto (lhs, Sil.Earray (_, elems, _), Sil.Sizeof (typ, _, _)) -> + | Sil.Hpointsto (lhs, Sil.Earray (_, elems, _), Exp.Sizeof (typ, _, _)) -> if IList.exists (fun pair -> strexp_matches snk_exp pair) elems then let reachable_hpreds' = Sil.HpredSet.remove hpred reachable_hpreds in @@ -1607,8 +1607,8 @@ let get_fld_typ_path_opt src_exps snk_exp_ reachable_hpreds_ = let compute_reachable_atoms pi exps = let rec exp_contains = function | exp when Sil.ExpSet.mem exp exps -> true - | Sil.UnOp (_, e, _) | Sil.Cast (_, e) | Sil.Lfield (e, _, _) -> exp_contains e - | Sil.BinOp (_, e0, e1) | Sil.Lindex (e0, e1) -> exp_contains e0 || exp_contains e1 + | Exp.UnOp (_, e, _) | Exp.Cast (_, e) | Exp.Lfield (e, _, _) -> exp_contains e + | Exp.BinOp (_, e0, e1) | Exp.Lindex (e0, e1) -> exp_contains e0 || exp_contains e1 | _ -> false in IList.filter (function @@ -1681,19 +1681,19 @@ let sigma_intro_nonemptylseg e1 e2 sigma = let normalize_and_strengthen_atom (p : normal t) (a : Sil.atom) : Sil.atom = let a' = atom_normalize p.sub a in match a' with - | Sil.Aeq (Sil.BinOp (Binop.Le, Sil.Var id, Sil.Const (Const.Cint n)), Sil.Const (Const.Cint i)) + | Sil.Aeq (Exp.BinOp (Binop.Le, Exp.Var id, Exp.Const (Const.Cint n)), Exp.Const (Const.Cint i)) when IntLit.isone i -> let lower = Sil.exp_int (n -- IntLit.one) in - let a_lower = Sil.Aeq (Sil.BinOp (Binop.Lt, lower, Sil.Var id), Sil.exp_one) in + let a_lower = Sil.Aeq (Exp.BinOp (Binop.Lt, lower, Exp.Var id), Sil.exp_one) in if not (IList.mem Sil.atom_equal a_lower p.pi) then a' - else Sil.Aeq (Sil.Var id, Sil.exp_int n) - | Sil.Aeq (Sil.BinOp (Binop.Lt, Sil.Const (Const.Cint n), Sil.Var id), Sil.Const (Const.Cint i)) + else Sil.Aeq (Exp.Var id, Sil.exp_int n) + | Sil.Aeq (Exp.BinOp (Binop.Lt, Exp.Const (Const.Cint n), Exp.Var id), Exp.Const (Const.Cint i)) when IntLit.isone i -> let upper = Sil.exp_int (n ++ IntLit.one) in - let a_upper = Sil.Aeq (Sil.BinOp (Binop.Le, Sil.Var id, upper), Sil.exp_one) in + let a_upper = Sil.Aeq (Exp.BinOp (Binop.Le, Exp.Var id, upper), Sil.exp_one) in if not (IList.mem Sil.atom_equal a_upper p.pi) then a' - else Sil.Aeq (Sil.Var id, upper) - | Sil.Aeq (Sil.BinOp (Binop.Ne, e1, e2), Sil.Const (Const.Cint i)) when IntLit.isone i -> + else Sil.Aeq (Exp.Var id, upper) + | Sil.Aeq (Exp.BinOp (Binop.Ne, e1, e2), Exp.Const (Const.Cint i)) when IntLit.isone i -> Sil.Aneq (e1, e2) | _ -> a' @@ -1704,8 +1704,8 @@ let rec prop_atom_and ?(footprint=false) (p : normal t) a : normal t = else begin let p' = match a' with - | Sil.Aeq (Sil.Var i, e) when Sil.ident_in_exp i e -> p - | Sil.Aeq (Sil.Var i, e) -> + | Sil.Aeq (Exp.Var i, e) when Sil.ident_in_exp i e -> p + | Sil.Aeq (Exp.Var i, e) -> let sub_list = [(i, e)] in let mysub = Sil.sub_of_list sub_list in let p_sub = Sil.sub_filter (fun i' -> not (Ident.equal i i')) p.sub in @@ -1736,7 +1736,7 @@ let rec prop_atom_and ?(footprint=false) (p : normal t) a : normal t = if predicate_warning then footprint_normalize p' else match a' with - | Sil.Aeq (Sil.Var i, e) when not (Sil.ident_in_exp i e) -> + | Sil.Aeq (Exp.Var i, e) when not (Sil.ident_in_exp i e) -> let mysub = Sil.sub_of_list [(i, e)] in let foot_sigma' = sigma_normalize mysub p'.foot_sigma in let foot_pi' = a' :: pi_normalize mysub foot_sigma' p'.foot_pi in @@ -1882,12 +1882,12 @@ let add_or_replace_attribute prop atom = let check_attr_changed = (fun _ _ -> ()) in add_or_replace_attribute_check_changed check_attr_changed prop atom -(** mark Sil.Var's or Sil.Lvar's as undefined *) +(** mark Exp.Var's or Exp.Lvar's as undefined *) let mark_vars_as_undefined prop vars_to_mark callee_pname ret_annots loc path_pos = let att_undef = Sil.Aundef (callee_pname, ret_annots, loc, path_pos) in let mark_var_as_undefined exp prop = match exp with - | Sil.Var _ | Lvar _ -> add_or_replace_attribute prop (Apred (att_undef, [exp])) + | Exp.Var _ | Lvar _ -> add_or_replace_attribute prop (Apred (att_undef, [exp])) | _ -> prop in IList.fold_left (fun prop id -> mark_var_as_undefined id prop) prop vars_to_mark @@ -1922,7 +1922,7 @@ let remove_attribute_from_exp prop atom = (* Replace an attribute OBJC_NULL($n1) with OBJC_NULL(var) when var = $n1, and also sets $n1 = 0 *) let replace_objc_null prop lhs_exp rhs_exp = match get_objc_null_attribute prop rhs_exp, rhs_exp with - | Some atom, Sil.Var _ -> + | Some atom, Exp.Var _ -> let prop = remove_attribute_from_exp prop atom in let prop = conjoin_eq rhs_exp Sil.exp_zero prop in let natom = Sil.atom_replace_exp [(rhs_exp, lhs_exp)] atom in @@ -1931,12 +1931,12 @@ let replace_objc_null prop lhs_exp rhs_exp = let rec nullify_exp_with_objc_null prop exp = match exp with - | Sil.BinOp (_, exp1, exp2) -> + | Exp.BinOp (_, exp1, exp2) -> let prop' = nullify_exp_with_objc_null prop exp1 in nullify_exp_with_objc_null prop' exp2 - | Sil.UnOp (_, exp, _) -> + | Exp.UnOp (_, exp, _) -> nullify_exp_with_objc_null prop exp - | Sil.Var _ -> + | Exp.Var _ -> (match get_objc_null_attribute prop exp with | Some atom -> let prop' = remove_attribute_from_exp prop atom in @@ -1965,10 +1965,10 @@ let attribute_map_resource prop f = (** type for arithmetic problems *) type arith_problem = (* division by zero *) - | Div0 of Sil.exp + | Div0 of Exp.t (* unary minus of unsigned type applied to the given expression *) - | UminusUnsigned of Sil.exp * Typ.t + | UminusUnsigned of Exp.t * Typ.t (** Look for an arithmetic problem in [exp] *) let find_arithmetic_problem proc_node_session prop exp = @@ -1977,29 +1977,29 @@ let find_arithmetic_problem proc_node_session prop exp = let res = ref prop in let check_zero e = match exp_normalize_prop prop e with - | Sil.Const c when iszero_int_float c -> true + | Exp.Const c when iszero_int_float c -> true | _ -> res := add_or_replace_attribute !res (Apred (Adiv0 proc_node_session, [e])); false in let rec walk = function - | Sil.Var _ -> () - | Sil.UnOp (Unop.Neg, e, Some ( + | Exp.Var _ -> () + | Exp.UnOp (Unop.Neg, e, Some ( (Typ.Tint (Typ.IUChar | Typ.IUInt | Typ.IUShort | Typ.IULong | Typ.IULongLong) as typ))) -> uminus_unsigned := (e, typ) :: !uminus_unsigned - | Sil.UnOp(_, e, _) -> walk e - | Sil.BinOp(op, e1, e2) -> + | Exp.UnOp(_, e, _) -> walk e + | Exp.BinOp(op, e1, e2) -> if op = Binop.Div || op = Binop.Mod then exps_divided := e2 :: !exps_divided; walk e1; walk e2 - | Sil.Exn _ -> () - | Sil.Closure _ -> () - | Sil.Const _ -> () - | Sil.Cast (_, e) -> walk e - | Sil.Lvar _ -> () - | Sil.Lfield (e, _, _) -> walk e - | Sil.Lindex (e1, e2) -> walk e1; walk e2 - | Sil.Sizeof (_, None, _) -> () - | Sil.Sizeof (_, Some len, _) -> walk len in + | Exp.Exn _ -> () + | Exp.Closure _ -> () + | Exp.Const _ -> () + | Exp.Cast (_, e) -> walk e + | Exp.Lvar _ -> () + | Exp.Lfield (e, _, _) -> walk e + | Exp.Lindex (e1, e2) -> walk e1; walk e2 + | Exp.Sizeof (_, None, _) -> () + | Exp.Sizeof (_, Some len, _) -> walk len in walk exp; try Some (Div0 (IList.find check_zero !exps_divided)), !res with Not_found -> @@ -2011,19 +2011,19 @@ let find_arithmetic_problem proc_node_session prop exp = Return the list of stack variables whose address was still present after deallocation. *) let deallocate_stack_vars p pvars = let filter = function - | Sil.Hpointsto (Sil.Lvar v, _, _) -> + | Sil.Hpointsto (Exp.Lvar v, _, _) -> IList.exists (Pvar.equal v) pvars | _ -> false in 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 - | Sil.Hpointsto (Sil.Lvar v, _, _) -> + | Sil.Hpointsto (Exp.Lvar v, _, _) -> let freshv = Ident.create_fresh Ident.kprimed in fresh_address_vars := (v, freshv) :: !fresh_address_vars; - (Sil.Lvar v, Sil.Var freshv) + (Exp.Lvar v, Exp.Var freshv) | _ -> assert false) sigma_stack in - let pi1 = IList.map (fun (id, e) -> Sil.Aeq (Sil.Var id, e)) (Sil.sub_to_list p.sub) 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 p' = { p with @@ -2037,7 +2037,7 @@ let deallocate_stack_vars p pvars = if Sil.fav_mem p'_fav freshv then (* the address of a de-allocated stack var in in the post *) begin stack_vars_address_in_post := v :: !stack_vars_address_in_post; - let pred = Sil.Apred (Adangling DAaddr_stack_var, [Sil.Var freshv]) in + let pred = Sil.Apred (Adangling DAaddr_stack_var, [Exp.Var freshv]) in res := add_or_replace_attribute !res pred end in IList.iter do_var !fresh_address_vars; @@ -2065,18 +2065,18 @@ let extract_spec p = let prop_set_footprint p p_foot = let pi = (IList.map - (fun (i, e) -> Sil.Aeq(Sil.Var i, e)) + (fun (i, e) -> Sil.Aeq(Exp.Var i, e)) (Sil.sub_to_list p_foot.sub)) @ p_foot.pi in { p with foot_pi = pi; foot_sigma = p_foot.sigma } (** {2 Functions for renaming primed variables by "canonical names"} *) module ExpStack : sig - val init : Sil.exp list -> unit + val init : Exp.t list -> unit val final : unit -> unit val is_empty : unit -> bool - val push : Sil.exp -> unit - val pop : unit -> Sil.exp + val push : Exp.t -> unit + val pop : unit -> Exp.t end = struct let stack = Stack.create () let init es = @@ -2193,16 +2193,16 @@ let compute_reindexing fav_add get_id_offset list = let list_passed = select [] [] list in let transform x = let id, offset = match get_id_offset x with None -> assert false | Some io -> io in - let base_new = Sil.Var (Ident.create_fresh Ident.kprimed) in + let base_new = Exp.Var (Ident.create_fresh Ident.kprimed) in let offset_new = Sil.exp_int (IntLit.neg offset) in - let exp_new = Sil.BinOp(Binop.PlusA, base_new, offset_new) in + let exp_new = Exp.BinOp(Binop.PlusA, base_new, offset_new) in (id, exp_new) in let reindexing = IList.map transform list_passed in Sil.sub_of_list reindexing let compute_reindexing_from_indices indices = let get_id_offset = function - | Sil.BinOp (Binop.PlusA, Sil.Var id, Sil.Const(Const.Cint offset)) -> + | Exp.BinOp (Binop.PlusA, Exp.Var id, Exp.Const(Const.Cint offset)) -> if Ident.is_primed id then Some (id, offset) else None | _ -> None in let fav_add = Sil.exp_fav_add in @@ -2218,7 +2218,7 @@ let apply_reindexing subst prop = 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 (Sil.Var id, exp_normalize subst e)) eqs in + let atoms = IList.map (fun (id, e) -> Sil.Aeq (Exp.Var id, exp_normalize subst e)) eqs in (sub_keep, atoms) in let p' = { prop with sub = nsub; pi = npi; sigma = nsigma } in IList.fold_left prop_atom_and p' atoms @@ -2229,8 +2229,8 @@ let prop_rename_array_indices prop = let indices = sigma_get_array_indices prop.sigma in let not_same_base_lt_offsets e1 e2 = match e1, e2 with - | Sil.BinOp(Binop.PlusA, e1', Sil.Const (Const.Cint n1')), - Sil.BinOp(Binop.PlusA, e2', Sil.Const (Const.Cint n2')) -> + | Exp.BinOp(Binop.PlusA, e1', Exp.Const (Const.Cint n1')), + Exp.BinOp(Binop.PlusA, e2', Exp.Const (Const.Cint n2')) -> not (Sil.exp_equal e1' e2' && IntLit.lt n1' n2') | _ -> true in let rec select_minimal_indices indices_seen = function @@ -2277,23 +2277,23 @@ let ident_captured_ren ren id = (* If not defined in ren, id should be mapped to itself *) let rec exp_captured_ren ren = function - | Sil.Var id -> Sil.Var (ident_captured_ren ren id) - | Sil.Exn e -> Sil.Exn (exp_captured_ren ren e) - | Sil.Closure _ as e -> e (* TODO: why captured vars not renamed? *) - | Sil.Const _ as e -> e - | Sil.Sizeof (t, len, st) -> Sil.Sizeof (t, Option.map (exp_captured_ren ren) len, st) - | Sil.Cast (t, e) -> Sil.Cast (t, exp_captured_ren ren e) - | Sil.UnOp (op, e, topt) -> Sil.UnOp (op, exp_captured_ren ren e, topt) - | Sil.BinOp (op, e1, e2) -> + | Exp.Var id -> Exp.Var (ident_captured_ren ren id) + | Exp.Exn e -> Exp.Exn (exp_captured_ren ren e) + | Exp.Closure _ as e -> e (* TODO: why captured vars not renamed? *) + | Exp.Const _ as e -> e + | Exp.Sizeof (t, len, st) -> Exp.Sizeof (t, Option.map (exp_captured_ren ren) len, st) + | Exp.Cast (t, e) -> Exp.Cast (t, exp_captured_ren ren e) + | Exp.UnOp (op, e, topt) -> Exp.UnOp (op, exp_captured_ren ren e, topt) + | Exp.BinOp (op, e1, e2) -> let e1' = exp_captured_ren ren e1 in let e2' = exp_captured_ren ren e2 in - Sil.BinOp (op, e1', e2') - | Sil.Lvar id -> Sil.Lvar id - | Sil.Lfield (e, fld, typ) -> Sil.Lfield (exp_captured_ren ren e, fld, typ) - | Sil.Lindex (e1, e2) -> + Exp.BinOp (op, e1', e2') + | Exp.Lvar id -> Exp.Lvar id + | Exp.Lfield (e, fld, typ) -> Exp.Lfield (exp_captured_ren ren e, fld, typ) + | Exp.Lindex (e1, e2) -> let e1' = exp_captured_ren ren e1 in let e2' = exp_captured_ren ren e2 in - Sil.Lindex(e1', e2') + Exp.Lindex(e1', e2') let atom_captured_ren ren = function | Sil.Aeq (e1, e2) -> @@ -2436,7 +2436,7 @@ let exist_quantify fav prop = let ids = Sil.fav_to_list fav in if IList.exists Ident.is_primed ids then assert false; (* sanity check *) if ids == [] then prop else - let gen_fresh_id_sub id = (id, Sil.Var (Ident.create_fresh Ident.kprimed)) in + 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 prop' = (* throw away x=E if x becomes _x *) @@ -2452,7 +2452,7 @@ let exist_quantify fav prop = prop_ren_sub ren_sub prop' (** Apply the substitution [fe] to all the expressions in the prop. *) -let prop_expmap (fe: Sil.exp -> Sil.exp) 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 @@ -2465,7 +2465,7 @@ let vars_make_unprimed fav prop = let ids = Sil.fav_to_list fav in let ren_sub = Sil.sub_of_list (IList.map - (fun i -> (i, Sil.Var (Ident.create_fresh Ident.knormal))) + (fun i -> (i, Exp.Var (Ident.create_fresh Ident.knormal))) ids) in prop_ren_sub ren_sub prop @@ -2494,7 +2494,7 @@ let prop_rename_fav_with_existentials (p : normal t) : normal t = 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, Sil.Var i')) ids') in + let ren_sub = Sil.sub_of_list (IList.map (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 p' @@ -2624,10 +2624,10 @@ let prop_iter_set_state iter state = let prop_iter_make_id_primed id iter = let pid = Ident.create_fresh Ident.kprimed in - let sub_id = Sil.sub_of_list [(id, Sil.Var pid)] in + let sub_id = Sil.sub_of_list [(id, Exp.Var pid)] in let normalize (id, e) = - let eq' = Sil.Aeq(Sil.exp_sub sub_id (Sil.Var id), Sil.exp_sub sub_id e) in + let eq' = Sil.Aeq(Sil.exp_sub sub_id (Exp.Var id), Sil.exp_sub sub_id e) in atom_normalize Sil.sub_empty eq' in let rec split pairs_unpid pairs_pid = function @@ -2635,15 +2635,15 @@ let prop_iter_make_id_primed id iter = | eq:: eqs_cur -> begin match eq with - | Sil.Aeq (Sil.Var id1, e1) when Sil.ident_in_exp id1 e1 -> + | Sil.Aeq (Exp.Var id1, e1) when Sil.ident_in_exp id1 e1 -> L.out "@[<2>#### ERROR: an assumption of the analyzer broken ####@\n"; L.out "Broken Assumption: id notin e for all (id,e) in sub@\n"; L.out "(id,e) : (%a,%a)@\n" (Ident.pp pe_text) id1 (Sil.pp_exp pe_text) e1; L.out "PROP : %a@\n@." (pp_prop pe_text) (prop_iter_to_prop iter); assert false - | Sil.Aeq (Sil.Var id1, e1) when Ident.equal pid id1 -> + | Sil.Aeq (Exp.Var id1, e1) when Ident.equal pid id1 -> split pairs_unpid ((id1, e1):: pairs_pid) eqs_cur - | Sil.Aeq (Sil.Var id1, e1) -> + | Sil.Aeq (Exp.Var id1, e1) -> split ((id1, e1):: pairs_unpid) pairs_pid eqs_cur | _ -> assert false @@ -2661,7 +2661,7 @@ let prop_iter_make_id_primed id iter = match pairs_pid with | [] -> let sub_unpid = Sil.sub_of_list pairs_unpid in - let pairs = (id, Sil.Var pid) :: pairs_unpid in + let pairs = (id, Exp.Var pid) :: pairs_unpid in sub_unpid, Sil.sub_of_list pairs, [] | (id1, e1):: _ -> let sub_id1 = Sil.sub_of_list [(id1, e1)] in @@ -2784,24 +2784,24 @@ let trans_land_lor op ((idl1, stml1), e1) ((idl2, stml2), e2) loc = let no_side_effects stml = stml = [] in if no_side_effects stml2 then - ((idl1@idl2, stml1@stml2), Sil.BinOp(op, e1, e2)) + ((idl1@idl2, stml1@stml2), Exp.BinOp(op, e1, e2)) else begin let id = Ident.create_fresh Ident.knormal in let prune_instr1, prune_res1, prune_instr2, prune_res2 = let cond1, cond2, res = match op with - | Binop.LAnd -> e1, Sil.UnOp(Unop.LNot, e1, None), IntLit.zero - | Binop.LOr -> Sil.UnOp(Unop.LNot, e1, None), e1, IntLit.one + | Binop.LAnd -> e1, Exp.UnOp(Unop.LNot, e1, None), IntLit.zero + | Binop.LOr -> Exp.UnOp(Unop.LNot, e1, None), e1, IntLit.one | _ -> assert false in - let cond_res1 = Sil.BinOp(Binop.Eq, Sil.Var id, e2) in - let cond_res2 = Sil.BinOp(Binop.Eq, Sil.Var id, Sil.exp_int res) in + let cond_res1 = Exp.BinOp(Binop.Eq, Exp.Var id, e2) in + let cond_res2 = Exp.BinOp(Binop.Eq, Exp.Var id, Sil.exp_int res) in let mk_prune cond = (* don't report always true/false *) Sil.Prune (cond, loc, true, Sil.Ik_land_lor) in mk_prune cond1, mk_prune cond_res1, mk_prune cond2, mk_prune cond_res2 in let instrs2 = mk_nondet (prune_instr1 :: stml2 @ [prune_res1]) ([prune_instr2; prune_res2]) loc in - ((id:: idl1@idl2, stml1@instrs2), Sil.Var id) + ((id:: idl1@idl2, stml1@instrs2), Exp.Var id) end (** Input of this method is an exp in a prop. Output is a formal variable or path from a @@ -2818,10 +2818,10 @@ let find_equal_formal_path e prop = | Some _ -> res | None -> match hpred with - | Sil.Hpointsto (Sil.Lvar pvar1, Sil.Eexp (exp2, Sil.Iformal(_, _) ), _) + | Sil.Hpointsto (Exp.Lvar pvar1, Sil.Eexp (exp2, Sil.Iformal(_, _) ), _) when Sil.exp_equal exp2 e && (Pvar.is_local pvar1 || Pvar.is_seed pvar1) -> - Some (Sil.Lvar pvar1) + Some (Exp.Lvar pvar1) | Sil.Hpointsto (exp1, Sil.Estruct (fields, _), _) -> IList.fold_right (fun (field, strexp) res -> match res with @@ -2830,7 +2830,7 @@ let find_equal_formal_path e prop = match strexp with | Sil.Eexp (exp2, _) when Sil.exp_equal exp2 e -> (match find_in_sigma exp1 seen_hpreds with - | Some vfs -> Some (Sil.Lfield (vfs, field, Typ.Tvoid)) + | Some vfs -> Some (Exp.Lfield (vfs, field, Typ.Tvoid)) | None -> None) | _ -> None) fields None | _ -> None) (get_sigma prop) None in @@ -2844,21 +2844,21 @@ let find_equal_formal_path e prop = (** translate an if-then-else expression *) let trans_if_then_else ((idl1, stml1), e1) ((idl2, stml2), e2) ((idl3, stml3), e3) loc = match sym_eval false e1 with - | Sil.Const (Const.Cint i) when IntLit.iszero i -> (idl1@idl3, stml1@stml3), e3 - | Sil.Const (Const.Cint _) -> (idl1@idl2, stml1@stml2), e2 + | Exp.Const (Const.Cint i) when IntLit.iszero i -> (idl1@idl3, stml1@stml3), e3 + | Exp.Const (Const.Cint _) -> (idl1@idl2, stml1@stml2), e2 | _ -> - let e1not = Sil.UnOp(Unop.LNot, e1, None) in + let e1not = Exp.UnOp(Unop.LNot, e1, None) in let id = Ident.create_fresh Ident.knormal in let mk_prune_res e = let mk_prune cond = Sil.Prune (cond, loc, true, Sil.Ik_land_lor) (* don't report always true/false *) in - mk_prune (Sil.BinOp(Binop.Eq, Sil.Var id, e)) in + mk_prune (Exp.BinOp(Binop.Eq, Exp.Var id, e)) in let prune1 = Sil.Prune (e1, loc, true, Sil.Ik_bexp) in let prune1not = Sil.Prune (e1not, loc, false, Sil.Ik_bexp) in let stml' = mk_nondet (prune1 :: stml2 @ [mk_prune_res e2]) (prune1not :: stml3 @ [mk_prune_res e3]) loc in - (id:: idl1@idl2@idl3, stml1@stml'), Sil.Var id + (id:: idl1@idl2@idl3, stml1@stml'), Exp.Var id (*** START of module Metrics ***) module Metrics : sig @@ -2914,7 +2914,7 @@ end = struct let process_hpred = function | Sil.Hpointsto (e, _, te) -> (match e with - | Sil.Var id when Ident.is_primed id || Ident.is_footprint id -> add te + | Exp.Var id when Ident.is_primed id || Ident.is_footprint id -> add te | _ -> ()) | Sil.Hlseg _ | Sil.Hdllseg _ -> () in IList.iter process_hpred sigma; @@ -2941,17 +2941,17 @@ module CategorizePreconditions = struct (** categorize a list of preconditions *) let categorize preconditions = let lhs_is_lvar = function - | Sil.Lvar _ -> true + | Exp.Lvar _ -> true | _ -> false in let lhs_is_var_lvar = function - | Sil.Var _ -> true - | Sil.Lvar _ -> true + | Exp.Var _ -> true + | Exp.Lvar _ -> true | _ -> false in let rhs_is_var = function - | Sil.Eexp (Sil.Var _, _) -> true + | Sil.Eexp (Exp.Var _, _) -> true | _ -> false in let rec rhs_only_vars = function - | Sil.Eexp (Sil.Var _, _) -> true + | Sil.Eexp (Exp.Var _, _) -> true | Sil.Estruct (fsel, _) -> IList.for_all (fun (_, se) -> rhs_only_vars se) fsel | Sil.Earray _ -> true diff --git a/infer/src/backend/prop.mli b/infer/src/backend/prop.mli index 85ba383d4..e97882de7 100644 --- a/infer/src/backend/prop.mli +++ b/infer/src/backend/prop.mli @@ -134,28 +134,28 @@ val sigma_sub : subst -> hpred list -> hpred list val prop_sub : subst -> 'a t -> exposed t (** Apply the substitution to all the expressions in the prop. *) -val prop_expmap : (Sil.exp -> Sil.exp) -> 'a t -> exposed t +val prop_expmap : (Exp.t -> Exp.t) -> 'a t -> exposed t (** Relaces all expressions in the [hpred list] using the first argument. Assume that the first parameter defines a partial function. No expressions inside hpara are replaced. *) -val sigma_replace_exp : (exp * exp) list -> hpred list -> hpred list +val sigma_replace_exp : (Exp.t * Exp.t) list -> hpred list -> hpred list val sigma_map : 'a t -> (hpred -> hpred) -> 'a t (** {2 Normalization} *) (** Turn an inequality expression into an atom *) -val mk_inequality : Sil.exp -> Sil.atom +val mk_inequality : Exp.t -> Sil.atom (** Return [true] if the atom is an inequality *) val atom_is_inequality : Sil.atom -> bool (** If the atom is [e<=n] return [e,n] *) -val atom_exp_le_const : Sil.atom -> (Sil.exp * IntLit.t) option +val atom_exp_le_const : Sil.atom -> (Exp.t * IntLit.t) option (** If the atom is [n (IntLit.t * Sil.exp) option +val atom_const_lt_exp : Sil.atom -> (IntLit.t * Exp.t) option (** Negate an atom *) val atom_negate : Sil.atom -> Sil.atom @@ -163,30 +163,30 @@ val atom_negate : Sil.atom -> Sil.atom (** type for arithmetic problems *) type arith_problem = (* division by zero *) - | Div0 of Sil.exp + | Div0 of Exp.t (* unary minus of unsigned type applied to the given expression *) - | UminusUnsigned of Sil.exp * Typ.t + | UminusUnsigned of Exp.t * Typ.t (** Look for an arithmetic problem in [exp] *) -val find_arithmetic_problem : path_pos -> normal t -> Sil.exp -> arith_problem option * normal t +val find_arithmetic_problem : path_pos -> normal t -> Exp.t -> arith_problem option * normal t (** Normalize [exp] using the pure part of [prop]. Later, we should change this such that the normalization exposes offsets of [exp] as much as possible. *) -val exp_normalize_prop : 'a t -> Sil.exp -> Sil.exp +val exp_normalize_prop : 'a t -> Exp.t -> Exp.t (** Normalize the expression without abstracting complex subexpressions *) -val exp_normalize_noabs : Sil.subst -> Sil.exp -> Sil.exp +val exp_normalize_noabs : Sil.subst -> Exp.t -> Exp.t (** Collapse consecutive indices that should be added. For instance, this function reduces x[1][1] to x[2]. The [typ] argument is used to ensure the soundness of this collapsing. *) -val exp_collapse_consecutive_indices_prop : Typ.t -> Sil.exp -> Sil.exp +val exp_collapse_consecutive_indices_prop : Typ.t -> Exp.t -> Exp.t (** Normalize [exp] used for the address of a heap cell. This normalization does not combine two offsets inside [exp]. *) -val lexp_normalize_prop : 'a t -> exp -> exp +val lexp_normalize_prop : 'a t -> Exp.t -> Exp.t val atom_normalize_prop : 'a t -> atom -> atom @@ -217,38 +217,39 @@ val prop_is_emp : 'a t -> bool (** {2 Functions for changing and generating propositions} *) (** Construct a disequality. *) -val mk_neq : exp -> exp -> atom +val mk_neq : Exp.t -> Exp.t -> atom (** Construct an equality. *) -val mk_eq : exp -> exp -> atom +val mk_eq : Exp.t -> Exp.t -> atom (** Construct a positive pred. *) -val mk_pred : attribute -> exp list -> atom +val mk_pred : attribute -> Exp.t list -> atom (** Construct a negative pred. *) -val mk_npred : attribute -> exp list -> atom +val mk_npred : attribute -> Exp.t list -> atom (** create a strexp of the given type, populating the structures if [expand_structs] is true *) val create_strexp_of_type : - Tenv.t option -> struct_init_mode -> Typ.t -> Sil.exp option -> Sil.inst -> Sil.strexp + Tenv.t option -> struct_init_mode -> Typ.t -> Exp.t option -> Sil.inst -> Sil.strexp (** Construct a pointsto. *) -val mk_ptsto : exp -> strexp -> exp -> hpred +val mk_ptsto : Exp.t -> strexp -> Exp.t -> hpred (** Construct a points-to predicate for an expression using either the provided expression [name] as base for fresh identifiers. *) -val mk_ptsto_exp : Tenv.t option -> struct_init_mode -> exp * exp * exp option -> Sil.inst -> hpred +val mk_ptsto_exp : + Tenv.t option -> struct_init_mode -> Exp.t * Exp.t * Exp.t option -> Sil.inst -> hpred (** Construct a points-to predicate for a single program variable. If [expand_structs] is true, initialize the fields of structs with fresh variables. *) val mk_ptsto_lvar : - Tenv.t option -> struct_init_mode -> Sil.inst -> Pvar.t * exp * exp option -> hpred + Tenv.t option -> struct_init_mode -> Sil.inst -> Pvar.t * Exp.t * Exp.t option -> hpred (** Construct a lseg predicate *) -val mk_lseg : lseg_kind -> hpara -> exp -> exp -> exp list -> hpred +val mk_lseg : lseg_kind -> hpara -> Exp.t -> Exp.t -> Exp.t list -> hpred (** Construct a dllseg predicate *) -val mk_dllseg : lseg_kind -> hpara_dll -> exp -> exp -> exp -> exp -> exp list -> hpred +val mk_dllseg : lseg_kind -> hpara_dll -> Exp.t -> Exp.t -> Exp.t -> Exp.t -> Exp.t list -> hpred (** Construct a hpara *) val mk_hpara : Ident.t -> Ident.t -> Ident.t list -> Ident.t list -> hpred list -> hpara @@ -273,55 +274,55 @@ val prop_sigma_star : 'a t -> hpred list -> exposed t val prop_atom_and : ?footprint: bool -> normal t -> atom -> normal t (** Conjoin [exp1]=[exp2] with a symbolic heap [prop]. *) -val conjoin_eq : ?footprint: bool -> exp -> exp -> normal t -> normal t +val conjoin_eq : ?footprint: bool -> Exp.t -> Exp.t -> normal t -> normal t (** Conjoin [exp1]!=[exp2] with a symbolic heap [prop]. *) -val conjoin_neq : ?footprint: bool -> exp -> exp -> normal t -> normal t +val conjoin_neq : ?footprint: bool -> Exp.t -> Exp.t -> normal t -> normal t (** Check whether an atom is used to mark an attribute *) val atom_is_attribute : atom -> bool (** Apply f to every resource attribute in the prop *) -val attribute_map_resource : normal t -> (Sil.exp -> Sil.res_action -> Sil.res_action) -> normal t +val attribute_map_resource : normal t -> (Exp.t -> Sil.res_action -> Sil.res_action) -> normal t (** Return the exp and attribute marked in the atom if any, and return None otherwise *) val atom_get_attribute : atom -> atom option (** Get the attributes associated to the expression, if any *) -val get_attributes : 'a t -> exp -> atom list +val get_attributes : 'a t -> Exp.t -> atom list (** Get the undef attribute associated to the expression, if any *) -val get_undef_attribute : 'a t -> exp -> atom option +val get_undef_attribute : 'a t -> Exp.t -> atom option (** Get the resource attribute associated to the expression, if any *) -val get_resource_attribute : 'a t -> exp -> atom option +val get_resource_attribute : 'a t -> Exp.t -> atom option (** Get the taint attribute associated to the expression, if any *) -val get_taint_attribute : 'a t -> exp -> atom option +val get_taint_attribute : 'a t -> Exp.t -> atom option (** Get the autorelease attribute associated to the expression, if any *) -val get_autorelease_attribute : 'a t -> exp -> atom option +val get_autorelease_attribute : 'a t -> Exp.t -> atom option (** Get the div0 attribute associated to the expression, if any *) -val get_div0_attribute : 'a t -> exp -> atom option +val get_div0_attribute : 'a t -> Exp.t -> atom option (** Get the observer attribute associated to the expression, if any *) -val get_observer_attribute : 'a t -> exp -> atom option +val get_observer_attribute : 'a t -> Exp.t -> atom option (** Get the objc null attribute associated to the expression, if any *) -val get_objc_null_attribute : 'a t -> exp -> atom option +val get_objc_null_attribute : 'a t -> Exp.t -> atom option (** Get the retval null attribute associated to the expression, if any *) -val get_retval_attribute : 'a t -> exp -> atom option +val get_retval_attribute : 'a t -> Exp.t -> atom option (** Get all the attributes of the prop *) val get_all_attributes : 'a t -> atom list -val has_dangling_uninit_attribute : 'a t -> exp -> bool +val has_dangling_uninit_attribute : 'a t -> Exp.t -> bool (** Set an attribute associated to the argument expressions *) val set_attribute : ?footprint: bool -> ?polarity: bool -> - normal t -> attribute -> exp list -> normal t + normal t -> attribute -> Exp.t list -> normal t val add_or_replace_attribute_check_changed : (Sil.attribute -> Sil.attribute -> unit) -> normal t -> atom -> normal t @@ -329,8 +330,8 @@ val add_or_replace_attribute_check_changed : (** Replace an attribute associated to the expression *) val add_or_replace_attribute : normal t -> atom -> normal t -(** mark Sil.Var's or Sil.Lvar's as undefined *) -val mark_vars_as_undefined : normal t -> Sil.exp list -> Procname.t -> Typ.item_annotation -> +(** mark Exp.Var's or Exp.Lvar's as undefined *) +val mark_vars_as_undefined : normal t -> Exp.t list -> Procname.t -> Typ.item_annotation -> Location.t -> Sil.path_pos -> normal t (** Remove an attribute from all the atoms in the heap *) @@ -340,9 +341,9 @@ val remove_resource_attribute : Sil.res_act_kind -> Sil.resource -> 'a t -> norm (** [replace_objc_null lhs rhs]. If rhs has the objc_null attribute, replace the attribute and set the lhs = 0 *) -val replace_objc_null : normal t -> exp -> exp -> normal t +val replace_objc_null : normal t -> Exp.t -> Exp.t -> normal t -val nullify_exp_with_objc_null : normal t -> exp -> normal t +val nullify_exp_with_objc_null : normal t -> Exp.t -> normal t (** Remove an attribute from an exp in the heap *) val remove_attribute_from_exp : 'a t -> atom -> normal t @@ -390,15 +391,15 @@ val prop_expand : normal t -> normal t list (** translate a logical and/or operation taking care of the non-strict semantics for side effects *) val trans_land_lor : - Binop.t -> (Ident.t list * Sil.instr list) * Sil.exp -> - (Ident.t list * Sil.instr list) * Sil.exp -> Location.t -> - (Ident.t list * Sil.instr list) * Sil.exp + Binop.t -> (Ident.t list * Sil.instr list) * Exp.t -> + (Ident.t list * Sil.instr list) * Exp.t -> Location.t -> + (Ident.t list * Sil.instr list) * Exp.t (** translate an if-then-else expression *) val trans_if_then_else : - (Ident.t list * Sil.instr list) * Sil.exp -> (Ident.t list * Sil.instr list) * Sil.exp -> - (Ident.t list * Sil.instr list) * Sil.exp -> Location.t -> - (Ident.t list * Sil.instr list) * Sil.exp + (Ident.t list * Sil.instr list) * Exp.t -> (Ident.t list * Sil.instr list) * Exp.t -> + (Ident.t list * Sil.instr list) * Exp.t -> Location.t -> + (Ident.t list * Sil.instr list) * Exp.t (** {2 Functions for existentially quantifying and unquantifying variables} *) @@ -497,7 +498,7 @@ val prop_iter_make_id_primed : Ident.t -> 'a prop_iter -> 'a prop_iter (** Collect garbage fields. *) val prop_iter_gc_fields : unit prop_iter -> unit prop_iter -val find_equal_formal_path : exp -> 'a t -> exp option +val find_equal_formal_path : Exp.t -> 'a t -> Exp.t option (** return the set of subexpressions of [strexp] *) val strexp_get_exps : Sil.strexp -> Sil.ExpSet.t @@ -512,7 +513,7 @@ val compute_reachable_hpreds : hpred list -> Sil.ExpSet.t -> Sil.HpredSet.t * Si (** if possible, produce a (fieldname, typ) path from one of the [src_exps] to [snk_exp] using [reachable_hpreds]. *) -val get_fld_typ_path_opt : Sil.ExpSet.t -> Sil.exp -> Sil.HpredSet.t -> +val get_fld_typ_path_opt : Sil.ExpSet.t -> Exp.t -> Sil.HpredSet.t -> (Ident.fieldname option * Typ.t) list option (** filter [pi] by removing the pure atoms that do not contain an expression in [exps] *) diff --git a/infer/src/backend/propgraph.ml b/infer/src/backend/propgraph.ml index 542d359c7..609de577e 100644 --- a/infer/src/backend/propgraph.ml +++ b/infer/src/backend/propgraph.ml @@ -17,9 +17,9 @@ module L = Logging type t = Prop.normal Prop.t -type node = Sil.exp +type node = Exp.t -type sub_entry = Ident.t * Sil.exp +type sub_entry = Ident.t * Exp.t type edge = Ehpred of Sil.hpred | Eatom of Sil.atom | Esub_entry of sub_entry @@ -27,10 +27,10 @@ let from_prop p = p (** Return [true] if root node *) let rec is_root = function - | Sil.Var id -> Ident.is_normal id - | Sil.Exn _ | Sil.Closure _ | Sil.Const _ | Sil.Lvar _ -> true - | Sil.Cast (_, e) -> is_root e - | Sil.UnOp _ | Sil.BinOp _ | Sil.Lfield _ | Sil.Lindex _ | Sil.Sizeof _ -> false + | Exp.Var id -> Ident.is_normal id + | Exp.Exn _ | Exp.Closure _ | Exp.Const _ | Exp.Lvar _ -> true + | Exp.Cast (_, e) -> is_root e + | Exp.UnOp _ | Exp.BinOp _ | Exp.Lfield _ | Exp.Lindex _ | Exp.Sizeof _ -> false (** Return [true] if the nodes are connected. Used to compute reachability. *) let nodes_connected n1 n2 = @@ -51,7 +51,7 @@ let edge_get_source = function | Eatom (Sil.Aneq (e1, _)) -> Some e1 | Eatom (Sil.Apred (_, e :: _) | Anpred (_, e :: _)) -> Some e | Eatom (Sil.Apred (_, []) | Anpred (_, [])) -> None - | Esub_entry (x, _) -> Some (Sil.Var x) + | Esub_entry (x, _) -> Some (Exp.Var x) (** Return the successor nodes of the edge *) let edge_get_succs = function @@ -123,7 +123,7 @@ type diff = diff_cmap_foot : colormap (** colormap for the footprint part *) } (** Compute the subobjects in [e2] which are different from those in [e1] *) -let compute_exp_diff (e1: Sil.exp) (e2: Sil.exp) : Obj.t list = +let compute_exp_diff (e1: Exp.t) (e2: Exp.t) : Obj.t list = if Sil.exp_equal e1 e2 then [] else [Obj.repr e2] diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index 7c07d9076..74f2fd627 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -55,16 +55,16 @@ let (--) = IntLit.sub module DiffConstr : sig type t - val to_leq : t -> Sil.exp * Sil.exp - val to_lt : t -> Sil.exp * Sil.exp - val to_triple : t -> Sil.exp * Sil.exp * IntLit.t - val from_leq : t list -> Sil.exp * Sil.exp -> t list - val from_lt : t list -> Sil.exp * Sil.exp -> t list + val to_leq : t -> Exp.t * Exp.t + val to_lt : t -> Exp.t * Exp.t + val to_triple : t -> Exp.t * Exp.t * IntLit.t + val from_leq : t list -> Exp.t * Exp.t -> t list + val from_lt : t list -> Exp.t * Exp.t -> t list val saturate : t list -> bool * t list end = struct - type t = Sil.exp * Sil.exp * IntLit.t + type t = Exp.t * Exp.t * IntLit.t let compare (e1, e2, n) (f1, f2, m) = let c1 = exp_pair_compare (e1, e2) (f1, f2) in @@ -72,15 +72,15 @@ end = struct let equal entry1 entry2 = compare entry1 entry2 = 0 let to_leq (e1, e2, n) = - Sil.BinOp(Binop.MinusA, e1, e2), Sil.exp_int n + Exp.BinOp(Binop.MinusA, e1, e2), Sil.exp_int n let to_lt (e1, e2, n) = - Sil.exp_int (IntLit.zero -- n -- IntLit.one), Sil.BinOp(Binop.MinusA, e2, e1) + Sil.exp_int (IntLit.zero -- n -- IntLit.one), Exp.BinOp(Binop.MinusA, e2, e1) let to_triple entry = entry let from_leq acc (e1, e2) = match e1, e2 with - | Sil.BinOp (Binop.MinusA, (Sil.Var id11 as e11), (Sil.Var id12 as e12)), - Sil.Const (Const.Cint n) + | Exp.BinOp (Binop.MinusA, (Exp.Var id11 as e11), (Exp.Var id12 as e12)), + Exp.Const (Const.Cint n) when not (Ident.equal id11 id12) -> (match IntLit.to_signed n with | None -> acc (* ignore: constraint algorithm only terminates on signed integers *) @@ -89,8 +89,8 @@ end = struct | _ -> acc let from_lt acc (e1, e2) = match e1, e2 with - | Sil.Const (Const.Cint n), - Sil.BinOp (Binop.MinusA, (Sil.Var id21 as e21), (Sil.Var id22 as e22)) + | Exp.Const (Const.Cint n), + Exp.BinOp (Binop.MinusA, (Exp.Var id21 as e21), (Exp.Var id22 as e22)) when not (Ident.equal id21 id22) -> (match IntLit.to_signed n with | None -> acc (* ignore: constraint algorithm only terminates on signed integers *) @@ -206,19 +206,19 @@ module Inequalities : sig val from_prop : Prop.normal Prop.t -> t (** Check [t |- e1!=e2]. Result [false] means "don't know". *) - val check_ne : t -> Sil.exp -> Sil.exp -> bool + val check_ne : t -> Exp.t -> Exp.t -> bool (** Check [t |- e1<=e2]. Result [false] means "don't know". *) - val check_le : t -> Sil.exp -> Sil.exp -> bool + val check_le : t -> Exp.t -> Exp.t -> bool (** Check [t |- e1 Sil.exp -> Sil.exp -> bool + val check_lt : t -> Exp.t -> Exp.t -> bool (** Find a IntLit.t n such that [t |- e<=n] if possible. *) - val compute_upper_bound : t -> Sil.exp -> IntLit.t option + val compute_upper_bound : t -> Exp.t -> IntLit.t option (** Find a IntLit.t n such that [t |- n Sil.exp -> IntLit.t option + val compute_lower_bound : t -> Exp.t -> IntLit.t option (** Return [true] if a simple inconsistency is detected *) val inconsistent : t -> bool @@ -248,9 +248,9 @@ module Inequalities : sig end = struct type t = { - mutable leqs: (Sil.exp * Sil.exp) list; (** le fasts [e1 <= e2] *) - mutable lts: (Sil.exp * Sil.exp) list; (** lt facts [e1 < e2] *) - mutable neqs: (Sil.exp * Sil.exp) list; (** ne facts [e1 != e2] *) + mutable leqs: (Exp.t * Exp.t) list; (** le fasts [e1 <= e2] *) + mutable lts: (Exp.t * Exp.t) list; (** lt facts [e1 < e2] *) + mutable neqs: (Exp.t * Exp.t) list; (** ne facts [e1 != e2] *) } let inconsistent_ineq = { leqs = [(Sil.exp_one, Sil.exp_zero)]; lts = []; neqs = [] } @@ -266,7 +266,7 @@ end = struct let leqs_sorted = IList.sort leq_compare leqs in let have_same_key leq1 leq2 = match leq1, leq2 with - | (e1, Sil.Const (Const.Cint n1)), (e2, Sil.Const (Const.Cint n2)) -> + | (e1, Exp.Const (Const.Cint n1)), (e2, Exp.Const (Const.Cint n2)) -> Sil.exp_equal e1 e2 && IntLit.leq n1 n2 | _, _ -> false in remove_redundancy have_same_key [] leqs_sorted @@ -274,7 +274,7 @@ end = struct let lts_sorted = IList.sort lt_compare lts in let have_same_key lt1 lt2 = match lt1, lt2 with - | (Sil.Const (Const.Cint n1), e1), (Sil.Const (Const.Cint n2), e2) -> + | (Exp.Const (Const.Cint n1), e1), (Exp.Const (Const.Cint n2), e2) -> Sil.exp_equal e1 e2 && IntLit.geq n1 n2 | _, _ -> false in remove_redundancy have_same_key [] lts_sorted @@ -300,13 +300,13 @@ end = struct with Not_found -> Sil.ExpMap.add e new_lower lmap in let rec umap_create_from_leqs umap = function | [] -> umap - | (e1, Sil.Const (Const.Cint upper1)):: leqs_rest -> + | (e1, Exp.Const (Const.Cint upper1)):: leqs_rest -> let umap' = umap_add umap e1 upper1 in umap_create_from_leqs umap' leqs_rest | _:: leqs_rest -> umap_create_from_leqs umap leqs_rest in let rec lmap_create_from_lts lmap = function | [] -> lmap - | (Sil.Const (Const.Cint lower1), e1):: lts_rest -> + | (Exp.Const (Const.Cint lower1), e1):: lts_rest -> let lmap' = lmap_add lmap e1 lower1 in lmap_create_from_lts lmap' lts_rest | _:: lts_rest -> lmap_create_from_lts lmap lts_rest in @@ -359,9 +359,9 @@ end = struct let process_atom = function | Sil.Aneq (e1, e2) -> (* != *) neqs := (e1, e2) :: !neqs - | Sil.Aeq (Sil.BinOp (Binop.Le, e1, e2), Sil.Const (Const.Cint i)) when IntLit.isone i -> + | Sil.Aeq (Exp.BinOp (Binop.Le, e1, e2), Exp.Const (Const.Cint i)) when IntLit.isone i -> leqs := (e1, e2) :: !leqs (* <= *) - | Sil.Aeq (Sil.BinOp (Binop.Lt, e1, e2), Sil.Const (Const.Cint i)) when IntLit.isone i -> + | Sil.Aeq (Exp.BinOp (Binop.Lt, e1, e2), Exp.Const (Const.Cint i)) when IntLit.isone i -> lts := (e1, e2) :: !lts (* < *) | Sil.Aeq _ | Sil.Apred _ | Anpred _ -> () in @@ -374,7 +374,7 @@ end = struct let add_lt_minus1_e e = lts := (Sil.exp_minus_one, e)::!lts in let texp_is_unsigned = function - | Sil.Sizeof (Typ.Tint ik, _, _) -> Typ.ikind_is_unsigned ik + | Exp.Sizeof (Typ.Tint ik, _, _) -> Typ.ikind_is_unsigned ik | _ -> false in let strexp_lt_minus1 = function | Sil.Eexp (e, _) -> add_lt_minus1_e e @@ -417,19 +417,19 @@ end = struct let check_le { leqs = leqs; lts = lts; neqs = _ } e1 e2 = (* L.d_str "check_le "; Sil.d_exp e1; L.d_str " "; Sil.d_exp e2; L.d_ln (); *) match e1, e2 with - | Sil.Const (Const.Cint n1), Sil.Const (Const.Cint n2) -> IntLit.leq n1 n2 - | Sil.BinOp (Binop.MinusA, Sil.Sizeof (t1, None, _), Sil.Sizeof (t2, None, _)), - Sil.Const(Const.Cint n2) + | Exp.Const (Const.Cint n1), Exp.Const (Const.Cint n2) -> IntLit.leq n1 n2 + | Exp.BinOp (Binop.MinusA, Exp.Sizeof (t1, None, _), Exp.Sizeof (t2, None, _)), + Exp.Const(Const.Cint n2) when IntLit.isminusone n2 && type_size_comparable t1 t2 -> (* [ sizeof(t1) - sizeof(t2) <= -1 ] *) check_type_size_lt t1 t2 - | e, Sil.Const (Const.Cint n) -> (* [e <= n' <= n |- e <= n] *) + | e, Exp.Const (Const.Cint n) -> (* [e <= n' <= n |- e <= n] *) IList.exists (function - | e', Sil.Const (Const.Cint n') -> Sil.exp_equal e e' && IntLit.leq n' n + | e', Exp.Const (Const.Cint n') -> Sil.exp_equal e e' && IntLit.leq n' n | _, _ -> false) leqs - | Sil.Const (Const.Cint n), e -> (* [ n-1 <= n' < e |- n <= e] *) + | Exp.Const (Const.Cint n), e -> (* [ n-1 <= n' < e |- n <= e] *) IList.exists (function - | Sil.Const (Const.Cint n'), e' -> Sil.exp_equal e e' && IntLit.leq (n -- IntLit.one) n' + | Exp.Const (Const.Cint n'), e' -> Sil.exp_equal e e' && IntLit.leq (n -- IntLit.one) n' | _, _ -> false) lts | _ -> Sil.exp_equal e1 e2 @@ -437,14 +437,14 @@ end = struct let check_lt { leqs = leqs; lts = lts; neqs = _ } e1 e2 = (* L.d_str "check_lt "; Sil.d_exp e1; L.d_str " "; Sil.d_exp e2; L.d_ln (); *) match e1, e2 with - | Sil.Const (Const.Cint n1), Sil.Const (Const.Cint n2) -> IntLit.lt n1 n2 - | Sil.Const (Const.Cint n), e -> (* [n <= n' < e |- n < e] *) + | Exp.Const (Const.Cint n1), Exp.Const (Const.Cint n2) -> IntLit.lt n1 n2 + | Exp.Const (Const.Cint n), e -> (* [n <= n' < e |- n < e] *) IList.exists (function - | Sil.Const (Const.Cint n'), e' -> Sil.exp_equal e e' && IntLit.leq n n' + | Exp.Const (Const.Cint n'), e' -> Sil.exp_equal e e' && IntLit.leq n n' | _, _ -> false) lts - | e, Sil.Const (Const.Cint n) -> (* [e <= n' <= n-1 |- e < n] *) + | e, Exp.Const (Const.Cint n) -> (* [e <= n' <= n-1 |- e < n] *) IList.exists (function - | e', Sil.Const (Const.Cint n') -> Sil.exp_equal e e' && IntLit.leq n' (n -- IntLit.one) + | e', Exp.Const (Const.Cint n') -> Sil.exp_equal e e' && IntLit.leq n' (n -- IntLit.one) | _, _ -> false) leqs | _ -> false @@ -456,15 +456,15 @@ end = struct (** Find a IntLit.t n such that [t |- e<=n] if possible. *) let compute_upper_bound { leqs = leqs; lts = _; neqs = _ } e1 = match e1 with - | Sil.Const (Const.Cint n1) -> Some n1 + | Exp.Const (Const.Cint n1) -> Some n1 | _ -> let e_upper_list = IList.filter (function - | e', Sil.Const (Const.Cint _) -> Sil.exp_equal e1 e' + | e', Exp.Const (Const.Cint _) -> Sil.exp_equal e1 e' | _, _ -> false) leqs in let upper_list = IList.map (function - | _, Sil.Const (Const.Cint n) -> n + | _, Exp.Const (Const.Cint n) -> n | _ -> assert false) e_upper_list in if upper_list == [] then None else Some (compute_min_from_nonempty_int_list upper_list) @@ -472,16 +472,16 @@ end = struct (** Find a IntLit.t n such that [t |- n < e] if possible. *) let compute_lower_bound { leqs = _; lts = lts; neqs = _ } e1 = match e1 with - | Sil.Const (Const.Cint n1) -> Some (n1 -- IntLit.one) - | Sil.Sizeof _ -> Some IntLit.zero + | Exp.Const (Const.Cint n1) -> Some (n1 -- IntLit.one) + | Exp.Sizeof _ -> Some IntLit.zero | _ -> let e_lower_list = IList.filter (function - | Sil.Const (Const.Cint _), e' -> Sil.exp_equal e1 e' + | Exp.Const (Const.Cint _), e' -> Sil.exp_equal e1 e' | _, _ -> false) lts in let lower_list = IList.map (function - | Sil.Const (Const.Cint n), _ -> n + | Exp.Const (Const.Cint n), _ -> n | _ -> assert false) e_lower_list in if lower_list == [] then None else Some (compute_max_from_nonempty_int_list lower_list) @@ -505,15 +505,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) -> Sil.BinOp(Binop.Le, e1, e2)) leqs in + let elist = IList.map (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) -> Sil.BinOp(Binop.Lt, e1, e2)) lts in + let elist = IList.map (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) -> Sil.BinOp(Binop.Ne, e1, e2)) lts in + let elist = IList.map (fun (e1, e2) -> Exp.BinOp(Binop.Ne, e1, e2)) lts in Sil.d_exp_list elist *) end @@ -527,13 +527,13 @@ let check_equal prop e1 e2 = Sil.exp_equal n_e1 n_e2 in let check_equal_const () = match n_e1, n_e2 with - | Sil.BinOp (Binop.PlusA, e1, Sil.Const (Const.Cint d)), e2 - | e2, Sil.BinOp (Binop.PlusA, e1, Sil.Const (Const.Cint d)) -> + | Exp.BinOp (Binop.PlusA, e1, Exp.Const (Const.Cint d)), e2 + | e2, Exp.BinOp (Binop.PlusA, e1, Exp.Const (Const.Cint d)) -> if Sil.exp_equal e1 e2 then IntLit.iszero d else false - | Sil.Const c1, Sil.Lindex(Sil.Const c2, Sil.Const (Const.Cint i)) when IntLit.iszero i -> + | Exp.Const c1, Exp.Lindex(Exp.Const c2, Exp.Const (Const.Cint i)) when IntLit.iszero i -> Const.equal c1 c2 - | Sil.Lindex(Sil.Const c1, Sil.Const (Const.Cint i)), Sil.Const c2 when IntLit.iszero i -> + | Exp.Lindex(Exp.Const c1, Exp.Const (Const.Cint i)), Exp.Const c2 when IntLit.iszero i -> Const.equal c1 c2 | _, _ -> false in let check_equal_pi () = @@ -554,23 +554,23 @@ let check_zero e = *) let is_root prop base_exp exp = let rec f offlist_past e = match e with - | Sil.Var _ | Sil.Const _ | Sil.UnOp _ | Sil.BinOp _ | Sil.Exn _ | Sil.Closure _ | Sil.Lvar _ - | Sil.Sizeof _ -> + | Exp.Var _ | Exp.Const _ | Exp.UnOp _ | Exp.BinOp _ | Exp.Exn _ | Exp.Closure _ | Exp.Lvar _ + | Exp.Sizeof _ -> if check_equal prop base_exp e then Some offlist_past else None - | Sil.Cast(_, sub_exp) -> f offlist_past sub_exp - | Sil.Lfield(sub_exp, fldname, typ) -> f (Sil.Off_fld (fldname, typ) :: offlist_past) sub_exp - | Sil.Lindex(sub_exp, e) -> f (Sil.Off_index e :: offlist_past) sub_exp + | Exp.Cast(_, sub_exp) -> f offlist_past sub_exp + | Exp.Lfield(sub_exp, fldname, typ) -> f (Sil.Off_fld (fldname, typ) :: offlist_past) sub_exp + | Exp.Lindex(sub_exp, e) -> f (Sil.Off_index e :: offlist_past) sub_exp in f [] exp (** Get upper and lower bounds of an expression, if any *) let get_bounds prop _e = let e_norm = Prop.exp_normalize_prop prop _e in let e_root, off = match e_norm with - | Sil.BinOp (Binop.PlusA, e, Sil.Const (Const.Cint n1)) -> + | Exp.BinOp (Binop.PlusA, e, Exp.Const (Const.Cint n1)) -> e, IntLit.neg n1 - | Sil.BinOp (Binop.MinusA, e, Sil.Const (Const.Cint n1)) -> + | Exp.BinOp (Binop.MinusA, e, Exp.Const (Const.Cint n1)) -> e, n1 | _ -> e_norm, IntLit.zero in @@ -589,23 +589,23 @@ let check_disequal prop e1 e2 = let n_e2 = Prop.exp_normalize_prop prop e2 in let check_disequal_const () = match n_e1, n_e2 with - | Sil.Const c1, Sil.Const c2 -> + | Exp.Const c1, Exp.Const c2 -> (Const.kind_equal c1 c2) && not (Const.equal c1 c2) - | Sil.Const c1, Sil.Lindex(Sil.Const c2, Sil.Const (Const.Cint d)) -> + | Exp.Const c1, Exp.Lindex(Exp.Const c2, Exp.Const (Const.Cint d)) -> if IntLit.iszero d then not (Const.equal c1 c2) (* offset=0 is no offset *) else Const.equal c1 c2 (* same base, different offsets *) - | Sil.BinOp (Binop.PlusA, e1, Sil.Const (Const.Cint d1)), - Sil.BinOp (Binop.PlusA, e2, Sil.Const (Const.Cint d2)) -> + | Exp.BinOp (Binop.PlusA, e1, Exp.Const (Const.Cint d1)), + Exp.BinOp (Binop.PlusA, e2, Exp.Const (Const.Cint d2)) -> if Sil.exp_equal e1 e2 then IntLit.neq d1 d2 else false - | Sil.BinOp (Binop.PlusA, e1, Sil.Const (Const.Cint d)), e2 - | e2, Sil.BinOp (Binop.PlusA, e1, Sil.Const (Const.Cint d)) -> + | Exp.BinOp (Binop.PlusA, e1, Exp.Const (Const.Cint d)), e2 + | e2, Exp.BinOp (Binop.PlusA, e1, Exp.Const (Const.Cint d)) -> if Sil.exp_equal e1 e2 then not (IntLit.iszero d) else false - | Sil.Lindex(Sil.Const c1, Sil.Const (Const.Cint d)), Sil.Const c2 -> + | Exp.Lindex(Exp.Const c1, Exp.Const (Const.Cint d)), Exp.Const c2 -> if IntLit.iszero d then not (Const.equal c1 c2) else Const.equal c1 c2 - | Sil.Lindex(Sil.Const c1, Sil.Const d1), Sil.Lindex (Sil.Const c2, Sil.Const d2) -> + | Exp.Lindex(Exp.Const c1, Exp.Const d1), Exp.Lindex (Exp.Const c2, Exp.Const d2) -> Const.equal c1 c2 && not (Const.equal d1 d2) | _, _ -> false in let ineq = lazy (Inequalities.from_prop prop) in @@ -678,7 +678,7 @@ let check_disequal prop e1 e2 = let check_le_normalized prop e1 e2 = (* L.d_str "check_le_normalized "; Sil.d_exp e1; L.d_str " "; Sil.d_exp e2; L.d_ln (); *) let eL, eR, off = match e1, e2 with - | Sil.BinOp(Binop.MinusA, f1, f2), Sil.Const (Const.Cint n) -> + | Exp.BinOp(Binop.MinusA, f1, f2), Exp.Const (Const.Cint n) -> if Sil.exp_equal f1 f2 then Sil.exp_zero, Sil.exp_zero, n else f1, f2, n @@ -735,9 +735,9 @@ let check_atom prop a0 = close_out outc; end; match a with - | Sil.Aeq (Sil.BinOp (Binop.Le, e1, e2), Sil.Const (Const.Cint i)) + | Sil.Aeq (Exp.BinOp (Binop.Le, e1, e2), Exp.Const (Const.Cint i)) when IntLit.isone i -> check_le_normalized prop e1 e2 - | Sil.Aeq (Sil.BinOp (Binop.Lt, e1, e2), Sil.Const (Const.Cint i)) + | Sil.Aeq (Exp.BinOp (Binop.Lt, e1, e2), Exp.Const (Const.Cint i)) when IntLit.isone i -> check_lt_normalized prop e1 e2 | Sil.Aeq (e1, e2) -> check_equal prop e1 e2 | Sil.Aneq (e1, e2) -> check_disequal prop e1 e2 @@ -745,7 +745,7 @@ let check_atom prop a0 = (** Check [prop |- e1<=e2]. Result [false] means "don't know". *) let check_le prop e1 e2 = - let e1_le_e2 = Sil.BinOp (Binop.Le, e1, e2) in + let e1_le_e2 = Exp.BinOp (Binop.Le, e1, e2) in check_atom prop (Prop.mk_inequality e1_le_e2) (** Check whether [prop |- allocated(e)]. *) @@ -782,7 +782,7 @@ let check_inconsistency_two_hpreds prop = | (Sil.Hdllseg (Sil.Lseg_NE, _, iF, _, _, iB, _) as hpred) :: sigma_rest -> if Sil.exp_equal iF e || Sil.exp_equal iB e then true else f e (hpred:: sigma_seen) sigma_rest - | Sil.Hlseg (Sil.Lseg_PE, _, e1, Sil.Const (Const.Cint i), _) as hpred :: sigma_rest + | Sil.Hlseg (Sil.Lseg_PE, _, e1, Exp.Const (Const.Cint i), _) as hpred :: sigma_rest when IntLit.iszero i -> if Sil.exp_equal e1 e then true else f e (hpred:: sigma_seen) sigma_rest @@ -795,7 +795,7 @@ let check_inconsistency_two_hpreds prop = let e_new = Prop.exp_normalize_prop prop_new e in f e_new [] sigma_new else f e (hpred:: sigma_seen) sigma_rest - | Sil.Hdllseg (Sil.Lseg_PE, _, e1, _, Sil.Const (Const.Cint i), _, _) as hpred :: sigma_rest + | Sil.Hdllseg (Sil.Lseg_PE, _, e1, _, Exp.Const (Const.Cint i), _, _) as hpred :: sigma_rest when IntLit.iszero i -> if Sil.exp_equal e1 e then true else f e (hpred:: sigma_seen) sigma_rest @@ -844,7 +844,7 @@ let check_inconsistency_base prop = Pvar.is_this pvar && procedure_attr.ProcAttributes.is_cpp_instance_method in let do_hpred = function - | Sil.Hpointsto (Sil.Lvar pv, Sil.Eexp (e, _), _) -> + | Sil.Hpointsto (Exp.Lvar pv, Sil.Eexp (e, _), _) -> Sil.exp_equal e Sil.exp_zero && Pvar.is_seed pv && (is_java_this pv || is_cpp_this pv || is_objc_instance_self pv) @@ -853,11 +853,11 @@ let check_inconsistency_base prop = let inconsistent_atom = function | Sil.Aeq (e1, e2) -> (match e1, e2 with - | Sil.Const c1, Sil.Const c2 -> not (Const.equal c1 c2) + | Exp.Const c1, Exp.Const c2 -> not (Const.equal c1 c2) | _ -> check_disequal prop e1 e2) | Sil.Aneq (e1, e2) -> (match e1, e2 with - | Sil.Const c1, Sil.Const c2 -> Const.equal c1 c2 + | Exp.Const c1, Exp.Const c2 -> Const.equal c1 c2 | _ -> (Sil.exp_compare e1 e2 = 0)) | Sil.Apred _ | Anpred _ -> false in let inconsistent_inequalities () = @@ -893,7 +893,7 @@ type subst2 = Sil.subst * Sil.subst type exc_body = | EXC_FALSE | EXC_FALSE_HPRED of Sil.hpred - | EXC_FALSE_EXPS of Sil.exp * Sil.exp + | EXC_FALSE_EXPS of Exp.t * Exp.t | EXC_FALSE_SEXPS of Sil.strexp * Sil.strexp | EXC_FALSE_ATOM of Sil.atom | EXC_FALSE_SIGMA of Sil.hpred list @@ -904,7 +904,7 @@ exception MISSING_EXC of string type check = | Bounds_check - | Class_cast_check of Sil.exp * Sil.exp * Sil.exp + | Class_cast_check of Exp.t * Exp.t * Exp.t let d_typings typings = let d_elem (exp, texp) = @@ -918,32 +918,32 @@ module ProverState : sig (** type for array bounds checks *) type bounds_check = - | BClen_imply of Sil.exp * Sil.exp * Sil.exp list (** coming from array_len_imply *) + | BClen_imply of Exp.t * Exp.t * Exp.t list (** coming from array_len_imply *) | BCfrom_pre of Sil.atom (** coming implicitly from preconditions *) val add_bounds_check : bounds_check -> unit val add_frame_fld : Sil.hpred -> unit - val add_frame_typ : Sil.exp * Sil.exp -> unit + val add_frame_typ : Exp.t * Exp.t -> unit val add_missing_fld : Sil.hpred -> unit val add_missing_pi : Sil.atom -> unit val add_missing_sigma : Sil.hpred list -> unit - val add_missing_typ : Sil.exp * Sil.exp -> unit + val add_missing_typ : Exp.t * Exp.t -> unit val atom_is_array_bounds_check : Sil.atom -> bool (** check if atom in pre is a bounds check *) val get_bounds_checks : unit -> bounds_check list val get_frame_fld : unit -> Sil.hpred list - val get_frame_typ : unit -> (Sil.exp * Sil.exp) list + val get_frame_typ : unit -> (Exp.t * Exp.t) list val get_missing_fld : unit -> Sil.hpred list val get_missing_pi : unit -> Sil.atom list val get_missing_sigma : unit -> Sil.hpred list - val get_missing_typ : unit -> (Sil.exp * Sil.exp) list + val get_missing_typ : unit -> (Exp.t * Exp.t) list val d_implication : Sil.subst * Sil.subst -> 'a Prop.t * 'b Prop.t -> unit val d_implication_error : string * (Sil.subst * Sil.subst) * exc_body -> unit end = struct type bounds_check = - | BClen_imply of Sil.exp * Sil.exp * Sil.exp list + | BClen_imply of Exp.t * Exp.t * Exp.t list | BCfrom_pre of Sil.atom let implication_lhs = ref Prop.prop_emp @@ -962,7 +962,7 @@ end = struct let prop_fav_len prop = let fav = Sil.fav_new () in let do_hpred = function - | Sil.Hpointsto (_, Sil.Earray (Sil.Var _ as len, _, _), _) -> + | Sil.Hpointsto (_, Sil.Earray (Exp.Var _ as len, _, _), _) -> Sil.exp_fav_add fav len | _ -> () in IList.iter do_hpred (Prop.get_sigma prop); @@ -1127,19 +1127,19 @@ let exp_imply calc_missing subs e1_in e2_in : subst2 = else raise (IMPL_EXC ("exps", subs, (EXC_FALSE_EXPS (e1, e2)))) | true, false -> raise (IMPL_EXC ("exps", subs, (EXC_FALSE_EXPS (e1, e2)))) | false, true -> - let sub2' = extend_sub (snd subs) v2 (Sil.exp_sub (fst subs) (Sil.Var v1)) in + let sub2' = extend_sub (snd subs) v2 (Sil.exp_sub (fst subs) (Exp.Var v1)) in (fst subs, sub2') | true, true -> let v1' = Ident.create_fresh Ident.knormal in - let sub1' = extend_sub (fst subs) v1 (Sil.Var v1') in - let sub2' = extend_sub (snd subs) v2 (Sil.Var v1') in + let sub1' = extend_sub (fst subs) v1 (Exp.Var v1') in + let sub2' = extend_sub (snd subs) v2 (Exp.Var v1') in (sub1', sub2') in let rec do_imply subs e1 e2 : subst2 = L.d_str "do_imply "; Sil.d_exp e1; L.d_str " "; Sil.d_exp e2; L.d_ln (); match e1, e2 with - | Sil.Var v1, Sil.Var v2 -> + | Exp.Var v1, Exp.Var v2 -> var_imply subs v1 v2 - | e1, Sil.Var v2 -> + | e1, Exp.Var v2 -> let occurs_check v e = (* check whether [v] occurs in normalized [e] *) if Sil.fav_mem (Sil.exp_fav e) v && Sil.fav_mem (Sil.exp_fav (Prop.exp_normalize_prop Prop.prop_emp e)) v @@ -1150,42 +1150,42 @@ let exp_imply calc_missing subs e1_in e2_in : subst2 = (fst subs, sub2') else raise (IMPL_EXC ("expressions not equal", subs, (EXC_FALSE_EXPS (e1, e2)))) - | e1, Sil.BinOp (Binop.PlusA, Sil.Var v2, e2) - | e1, Sil.BinOp (Binop.PlusA, e2, Sil.Var v2) + | e1, Exp.BinOp (Binop.PlusA, Exp.Var v2, e2) + | e1, Exp.BinOp (Binop.PlusA, e2, Exp.Var v2) when Ident.is_primed v2 || Ident.is_footprint v2 -> - let e' = Sil.BinOp (Binop.MinusA, e1, e2) in - do_imply subs (Prop.exp_normalize_noabs Sil.sub_empty e') (Sil.Var v2) - | Sil.Var _, e2 -> + let e' = Exp.BinOp (Binop.MinusA, e1, e2) in + do_imply subs (Prop.exp_normalize_noabs Sil.sub_empty e') (Exp.Var v2) + | Exp.Var _, e2 -> if calc_missing then let () = ProverState.add_missing_pi (Sil.Aeq (e1_in, e2_in)) in subs else raise (IMPL_EXC ("expressions not equal", subs, (EXC_FALSE_EXPS (e1, e2)))) - | Sil.Lvar pv1, Sil.Const _ when Pvar.is_global pv1 -> + | Exp.Lvar pv1, Exp.Const _ when Pvar.is_global pv1 -> if calc_missing then let () = ProverState.add_missing_pi (Sil.Aeq (e1_in, e2_in)) in subs else raise (IMPL_EXC ("expressions not equal", subs, (EXC_FALSE_EXPS (e1, e2)))) - | Sil.Lvar v1, Sil.Lvar v2 -> + | Exp.Lvar v1, Exp.Lvar v2 -> if Pvar.equal v1 v2 then subs else raise (IMPL_EXC ("expressions not equal", subs, (EXC_FALSE_EXPS (e1, e2)))) - | Sil.Const c1, Sil.Const c2 -> + | Exp.Const c1, Exp.Const c2 -> if (Const.equal c1 c2) then subs else raise (IMPL_EXC ("constants not equal", subs, (EXC_FALSE_EXPS (e1, e2)))) - | Sil.Const (Const.Cint _), Sil.BinOp (Binop.PlusPI, _, _) -> + | Exp.Const (Const.Cint _), Exp.BinOp (Binop.PlusPI, _, _) -> raise (IMPL_EXC ("pointer+index cannot evaluate to a constant", subs, (EXC_FALSE_EXPS (e1, e2)))) - | Sil.Const (Const.Cint n1), Sil.BinOp (Binop.PlusA, f1, Sil.Const (Const.Cint n2)) -> + | Exp.Const (Const.Cint n1), Exp.BinOp (Binop.PlusA, f1, Exp.Const (Const.Cint n2)) -> do_imply subs (Sil.exp_int (n1 -- n2)) f1 - | Sil.BinOp(op1, e1, f1), Sil.BinOp(op2, e2, f2) when op1 == op2 -> + | Exp.BinOp(op1, e1, f1), Exp.BinOp(op2, e2, f2) when op1 == op2 -> do_imply (do_imply subs e1 e2) f1 f2 - | Sil.BinOp (Binop.PlusA, Sil.Var v1, e1), e2 -> - do_imply subs (Sil.Var v1) (Sil.BinOp (Binop.MinusA, e2, e1)) - | Sil.BinOp (Binop.PlusPI, Sil.Lvar pv1, e1), e2 -> - do_imply subs (Sil.Lvar pv1) (Sil.BinOp (Binop.MinusA, e2, e1)) - | e1, Sil.Const _ -> + | Exp.BinOp (Binop.PlusA, Exp.Var v1, e1), e2 -> + do_imply subs (Exp.Var v1) (Exp.BinOp (Binop.MinusA, e2, e1)) + | Exp.BinOp (Binop.PlusPI, Exp.Lvar pv1, e1), e2 -> + do_imply subs (Exp.Lvar pv1) (Exp.BinOp (Binop.MinusA, e2, e1)) + | e1, Exp.Const _ -> raise (IMPL_EXC ("lhs not constant", subs, (EXC_FALSE_EXPS (e1, e2)))) - | Sil.Lfield(e1, fd1, _), Sil.Lfield(e2, fd2, _) when fd1 == fd2 -> + | Exp.Lfield(e1, fd1, _), Exp.Lfield(e2, fd2, _) when fd1 == fd2 -> do_imply subs e1 e2 - | Sil.Lindex(e1, f1), Sil.Lindex(e2, f2) -> + | Exp.Lindex(e1, f1), Exp.Lindex(e2, f2) -> do_imply (do_imply subs e1 e2) f1 f2 | _ -> d_impl_err ("exp_imply not implemented", subs, (EXC_FALSE_EXPS (e1, e2))); @@ -1198,24 +1198,24 @@ let exp_imply calc_missing subs e1_in e2_in : subst2 = and stamp - 1 *) let path_to_id path = let rec f = function - | Sil.Var id -> + | Exp.Var id -> if Ident.is_footprint id then None else Some (Ident.name_to_string (Ident.get_name id) ^ (string_of_int (Ident.get_stamp id))) - | Sil.Lfield (e, fld, _) -> + | Exp.Lfield (e, fld, _) -> (match f e with | None -> None | Some s -> Some (s ^ "_" ^ (Ident.fieldname_to_string fld))) - | Sil.Lindex (e, ind) -> + | Exp.Lindex (e, ind) -> (match f e with | None -> None | Some s -> Some (s ^ "_" ^ (Sil.exp_to_string ind))) - | Sil.Lvar _ -> + | Exp.Lvar _ -> Some (Sil.exp_to_string path) - | Sil.Const (Const.Cstr s) -> + | Exp.Const (Const.Cstr s) -> Some ("_const_str_" ^ s) - | Sil.Const (Const.Cclass c) -> + | Exp.Const (Const.Cclass c) -> Some ("_const_class_" ^ Ident.name_to_string c) - | Sil.Const _ -> None + | Exp.Const _ -> None | _ -> L.d_str "path_to_id undefined on "; Sil.d_exp path; L.d_ln (); assert false (* None *) in @@ -1227,10 +1227,10 @@ let path_to_id path = (** Implication for the length of arrays *) let array_len_imply calc_missing subs len1 len2 indices2 = match len1, len2 with - | _, Sil.Var _ - | _, Sil.BinOp (Binop.PlusA, Sil.Var _, _) - | _, Sil.BinOp (Binop.PlusA, _, Sil.Var _) - | Sil.BinOp (Binop.Mult, _, _), _ -> + | _, Exp.Var _ + | _, Exp.BinOp (Binop.PlusA, Exp.Var _, _) + | _, Exp.BinOp (Binop.PlusA, _, Exp.Var _) + | Exp.BinOp (Binop.Mult, _, _), _ -> (try exp_imply calc_missing subs len1 len2 with | IMPL_EXC (s, subs', x) -> raise (IMPL_EXC ("array len:" ^ s, subs', x))) @@ -1256,9 +1256,9 @@ let rec sexp_imply source calc_index_frame calc_missing subs se1 se2 typ2 : subs begin let e2' = Sil.exp_sub (snd subs) e2 in match e2' with - | Sil.Var id2 when Ident.is_primed id2 -> + | Exp.Var id2 when Ident.is_primed id2 -> let id2' = Ident.create_fresh Ident.knormal in - let sub2' = extend_sub (snd subs) id2 (Sil.Var id2') in + let sub2' = extend_sub (snd subs) id2 (Exp.Var id2') in (fst subs, sub2'), None, None | _ -> d_impl_err ("sexp_imply not implemented", subs, (EXC_FALSE_SEXPS (se1, se2))); @@ -1281,7 +1281,7 @@ let rec sexp_imply source calc_index_frame calc_missing subs se1 se2 typ2 : subs | Sil.Eexp (_, inst), Sil.Estruct (fsel, inst') -> 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 (Sil.Var (Ident.create_fresh Ident.knormal), inst)) in + let g (f, _) = (f, Sil.Eexp (Exp.Var (Ident.create_fresh Ident.knormal), inst)) in IList.map g fsel in sexp_imply source calc_index_frame calc_missing subs (Sil.Estruct (fsel', inst')) se2 typ2 | Sil.Eexp _, Sil.Earray (len, _, inst) @@ -1292,7 +1292,7 @@ let rec sexp_imply source calc_index_frame calc_missing subs se1 se2 typ2 : subs let se2' = Sil.Earray (len, [(Sil.exp_zero, se2)], inst) in let typ2' = Typ.Tarray (typ2, None) in (* In the sexp_imply, struct_imply, array_imply, and sexp_imply_nolhs functions, the typ2 - argument is only used by eventually passing its value to Typ.struct_typ_fld, Sil.Lfield, + argument is only used by eventually passing its value to Typ.struct_typ_fld, Exp.Lfield, Typ.struct_typ_fld, or Typ.array_elem. None of these are sensitive to the length field of Tarray, so forgetting the length of typ2' here is not a problem. *) sexp_imply source true calc_missing subs se1 se2' typ2' (* calculate index_frame because the rhs is a singleton array *) @@ -1308,7 +1308,8 @@ and struct_imply source calc_missing subs fsel1 fsel2 typ2 : subst2 * ((Ident.fi match Ident.fieldname_compare f1 f2 with | 0 -> let typ' = Typ.struct_typ_fld (Some Typ.Tvoid) f2 typ2 in - let subs', se_frame, se_missing = sexp_imply (Sil.Lfield (source, f2, typ2)) false calc_missing subs se1 se2 typ' in + let subs', se_frame, se_missing = + sexp_imply (Exp.Lfield (source, f2, typ2)) false calc_missing subs se1 se2 typ' in let subs'', fld_frame, fld_missing = struct_imply source calc_missing subs' fsel1' fsel2' typ2 in let fld_frame' = match se_frame with | None -> fld_frame @@ -1322,19 +1323,20 @@ and struct_imply source calc_missing subs fsel1 fsel2 typ2 : subst2 * ((Ident.fi subs', ((f1, se1) :: fld_frame), fld_missing | _ -> let typ' = Typ.struct_typ_fld (Some Typ.Tvoid) f2 typ2 in - let subs' = sexp_imply_nolhs (Sil.Lfield (source, f2, typ2)) calc_missing subs se2 typ' in + let subs' = + sexp_imply_nolhs (Exp.Lfield (source, f2, typ2)) calc_missing subs se2 typ' in let subs', fld_frame, fld_missing = struct_imply source calc_missing subs' fsel1 fsel2' typ2 in let fld_missing' = (f2, se2) :: fld_missing in subs', fld_frame, fld_missing' end | [], (f2, se2) :: fsel2' -> let typ' = Typ.struct_typ_fld (Some Typ.Tvoid) f2 typ2 in - let subs' = sexp_imply_nolhs (Sil.Lfield (source, f2, typ2)) calc_missing subs se2 typ' in + let subs' = sexp_imply_nolhs (Exp.Lfield (source, f2, typ2)) calc_missing subs se2 typ' in let subs'', fld_frame, fld_missing = struct_imply source calc_missing subs' [] fsel2' typ2 in subs'', fld_frame, (f2, se2):: fld_missing and array_imply source calc_index_frame calc_missing subs esel1 esel2 typ2 - : subst2 * ((Sil.exp * Sil.strexp) list) * ((Sil.exp * Sil.strexp) list) + : subst2 * ((Exp.t * Sil.strexp) list) * ((Exp.t * Sil.strexp) list) = let typ_elem = Typ.array_elem (Some Typ.Tvoid) typ2 in match esel1, esel2 with @@ -1346,10 +1348,11 @@ and array_imply source calc_index_frame calc_missing subs esel1 esel2 typ2 if n < 0 then array_imply source calc_index_frame calc_missing subs esel1' esel2 typ2 else if n > 0 then array_imply source calc_index_frame calc_missing subs esel1 esel2' typ2 else (* n=0 *) - let subs', _, _ = sexp_imply (Sil.Lindex (source, e1)) false calc_missing subs se1 se2 typ_elem in + let subs', _, _ = + sexp_imply (Exp.Lindex (source, e1)) false calc_missing subs se1 se2 typ_elem in array_imply source calc_index_frame calc_missing subs' esel1' esel2' typ2 | [], (e2, se2) :: esel2' -> - let subs' = sexp_imply_nolhs (Sil.Lindex (source, e2)) calc_missing subs se2 typ_elem in + let subs' = sexp_imply_nolhs (Exp.Lindex (source, e2)) calc_missing subs se2 typ_elem in let subs'', index_frame, index_missing = array_imply source calc_index_frame calc_missing subs' [] esel2' typ2 in let index_missing' = (e2, se2) :: index_missing in subs'', index_frame, index_missing' @@ -1360,17 +1363,18 @@ and sexp_imply_nolhs source calc_missing subs se2 typ2 = let e2 = Sil.exp_sub (snd subs) _e2 in begin match e2 with - | Sil.Var v2 when Ident.is_primed v2 -> + | Exp.Var v2 when Ident.is_primed v2 -> let v2' = path_to_id source in - (* L.d_str "called path_to_id on "; Sil.d_exp e2; L.d_str " returns "; Sil.d_exp (Sil.Var v2'); L.d_ln (); *) - let sub2' = extend_sub (snd subs) v2 (Sil.Var v2') in + (* L.d_str "called path_to_id on "; Sil.d_exp e2; *) + (* L.d_str " returns "; Sil.d_exp (Exp.Var v2'); L.d_ln (); *) + let sub2' = extend_sub (snd subs) v2 (Exp.Var v2') in (fst subs, sub2') - | Sil.Var _ -> + | Exp.Var _ -> if calc_missing then subs else raise (IMPL_EXC ("exp only in rhs is not a primed var", subs, EXC_FALSE)) - | Sil.Const _ when calc_missing -> + | Exp.Const _ when calc_missing -> let id = path_to_id source in - ProverState.add_missing_pi (Sil.Aeq (Sil.Var id, _e2)); + ProverState.add_missing_pi (Sil.Aeq (Exp.Var id, _e2)); subs | _ -> raise (IMPL_EXC ("exp only in rhs is not a primed var", subs, EXC_FALSE)) @@ -1406,11 +1410,11 @@ let filter_hpred sub hpred2 hpred1 = match (Sil.hpred_sub sub hpred1), hpred2 wi let hpred_has_primed_lhs sub hpred = let rec find_primed e = match e with - | Sil.Lfield (e, _, _) -> + | Exp.Lfield (e, _, _) -> find_primed e - | Sil.Lindex (e, _) -> + | Exp.Lindex (e, _) -> find_primed e - | Sil.BinOp (Binop.PlusPI, e1, _) -> + | Exp.BinOp (Binop.PlusPI, e1, _) -> find_primed e1 | _ -> Sil.fav_exists (Sil.exp_fav e) Ident.is_primed in @@ -1437,13 +1441,13 @@ let move_primed_lhs_from_front subs sigma = match sigma with Return [(changed, calc_index_frame', hpred')] where [changed] indicates whether the predicate has changed. *) let expand_hpred_pointer calc_index_frame hpred : bool * bool * Sil.hpred = let rec expand changed calc_index_frame hpred = match hpred with - | Sil.Hpointsto (Sil.Lfield (e, fld, typ_fld), se, t) -> + | Sil.Hpointsto (Exp.Lfield (e, fld, typ_fld), se, t) -> let t' = match t, typ_fld with | _, Typ.Tstruct _ -> (* the struct type of fld is known *) - Sil.Sizeof (typ_fld, None, Subtype.exact) - | Sil.Sizeof (t1, len, st), _ -> + Exp.Sizeof (typ_fld, None, Subtype.exact) + | Exp.Sizeof (t1, len, st), _ -> (* the struct type of fld is not known -- typically Tvoid *) - Sil.Sizeof + Exp.Sizeof (Typ.Tstruct { Typ.instance_fields = [(fld, t1, Typ.item_annotation_empty)]; static_fields = []; @@ -1457,17 +1461,17 @@ let expand_hpred_pointer calc_index_frame hpred : bool * bool * Sil.hpred = | _ -> raise (Failure "expand_hpred_pointer: Unexpected non-sizeof type in Lfield") in let hpred' = Sil.Hpointsto (e, Sil.Estruct ([(fld, se)], Sil.inst_none), t') in expand true true hpred' - | Sil.Hpointsto (Sil.Lindex (e, ind), se, t) -> + | Sil.Hpointsto (Exp.Lindex (e, ind), se, t) -> let t' = match t with - | Sil.Sizeof (t_, len, st) -> Sil.Sizeof (Typ.Tarray (t_, None), len, st) + | Exp.Sizeof (t_, len, st) -> Exp.Sizeof (Typ.Tarray (t_, None), len, st) | _ -> raise (Failure "expand_hpred_pointer: Unexpected non-sizeof type in Lindex") in let len = match t' with - | Sil.Sizeof (_, Some len, _) -> len + | Exp.Sizeof (_, Some len, _) -> len | _ -> Sil.exp_get_undefined false in let hpred' = Sil.Hpointsto (e, Sil.Earray (len, [(ind, se)], Sil.inst_none), t') in expand true true hpred' - | Sil.Hpointsto (Sil.BinOp (Binop.PlusPI, e1, e2), Sil.Earray (len, esel, inst), t) -> - let shift_exp e = Sil.BinOp (Binop.PlusA, e, e2) in + | 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 hpred' = Sil.Hpointsto (e1, Sil.Earray (len', esel', inst), t) in @@ -1606,17 +1610,17 @@ struct case, if they are possible *) let subtype_case_analysis tenv texp1 texp2 = match texp1, texp2 with - | Sil.Sizeof (t1, len1, st1), Sil.Sizeof (t2, len2, st2) -> + | Exp.Sizeof (t1, len1, st1), Exp.Sizeof (t2, len2, st2) -> begin let pos_opt, neg_opt = case_analysis_type tenv (t1, st1) (t2, st2) in let pos_type_opt = match pos_opt with | None -> None | Some st1' -> let t1', len1' = if check_subtype tenv t1 t2 then t1, len1 else t2, len2 in - Some (Sil.Sizeof (t1', len1', st1')) in + Some (Exp.Sizeof (t1', len1', st1')) in let neg_type_opt = match neg_opt with | None -> None - | Some st1' -> Some (Sil.Sizeof (t1, len1, st1')) in + | Some st1' -> Some (Exp.Sizeof (t1, len1, st1')) in pos_type_opt, neg_type_opt end | _ -> (* don't know, consider both possibilities *) @@ -1625,7 +1629,7 @@ end let cast_exception tenv texp1 texp2 e1 subs = let _ = match texp1, texp2 with - | Sil.Sizeof (t1, _, _), Sil.Sizeof (t2, _, st2) -> + | Exp.Sizeof (t1, _, _), Exp.Sizeof (t2, _, st2) -> if Config.developer_mode || (Subtype.is_cast st2 && not (Subtyping_check.check_subtype tenv t1 t2)) then @@ -1655,7 +1659,7 @@ let get_overrides_of tenv supertype pname = (** Check the equality of two types ignoring flags in the subtyping components *) let texp_equal_modulo_subtype_flag texp1 texp2 = match texp1, texp2 with - | Sil.Sizeof (t1, len1, st1), Sil.Sizeof (t2, len2, st2) -> + | Exp.Sizeof (t1, len1, st1), Exp.Sizeof (t2, len2, st2) -> Typ.equal t1 t2 && (opt_equal Sil.exp_equal len1 len2) && Subtype.equal_modulo_flag st1 st2 @@ -1667,13 +1671,13 @@ let texp_imply tenv subs texp1 texp2 e1 calc_missing = (* classes and arrays in Java, and just classes in C++ and ObjC *) let types_subject_to_dynamic_cast = match texp1, texp2 with - | Sil.Sizeof ((Typ.Tstruct _) as typ1, _, _), Sil.Sizeof (Typ.Tstruct _, _, _) - | Sil.Sizeof ((Typ.Tarray _) as typ1, _, _), Sil.Sizeof (Typ.Tarray _, _, _) - | Sil.Sizeof ((Typ.Tarray _) as typ1, _, _), Sil.Sizeof (Typ.Tstruct _, _, _) - | Sil.Sizeof ((Typ.Tstruct _) as typ1, _, _), Sil.Sizeof (Typ.Tarray _, _, _) + | Exp.Sizeof ((Typ.Tstruct _) as typ1, _, _), Exp.Sizeof (Typ.Tstruct _, _, _) + | Exp.Sizeof ((Typ.Tarray _) as typ1, _, _), Exp.Sizeof (Typ.Tarray _, _, _) + | Exp.Sizeof ((Typ.Tarray _) as typ1, _, _), Exp.Sizeof (Typ.Tstruct _, _, _) + | Exp.Sizeof ((Typ.Tstruct _) as typ1, _, _), Exp.Sizeof (Typ.Tarray _, _, _) when is_java_class typ1 -> true - | Sil.Sizeof (typ1, _, _), Sil.Sizeof (typ2, _, _) -> + | Exp.Sizeof (typ1, _, _), Exp.Sizeof (typ2, _, _) -> (Typ.is_cpp_class typ1 && Typ.is_cpp_class typ2) || (Typ.is_objc_class typ1 && Typ.is_objc_class typ2) | _ -> false in @@ -1707,7 +1711,7 @@ let texp_imply tenv subs texp1 texp2 e1 calc_missing = (** pre-process implication between a non-array and an array: the non-array is turned into an array of length given by its type only active in type_size mode *) let sexp_imply_preprocess se1 texp1 se2 = match se1, texp1, se2 with - | Sil.Eexp (_, inst), Sil.Sizeof _, Sil.Earray _ when Config.type_size -> + | Sil.Eexp (_, inst), Exp.Sizeof _, Sil.Earray _ when Config.type_size -> let se1' = Sil.Earray (texp1, [(Sil.exp_zero, se1)], inst) in L.d_strln_color Orange "sexp_imply_preprocess"; L.d_str " se1: "; Sil.d_sexp se1; L.d_ln (); L.d_str " se1': "; Sil.d_sexp se1'; L.d_ln (); se1' @@ -1717,7 +1721,7 @@ let sexp_imply_preprocess se1 texp1 se2 = match se1, texp1, se2 with of the one in the callee, add a type frame and type missing *) let handle_parameter_subtype tenv prop1 sigma2 subs (e1, se1, texp1) (se2, texp2) = let is_callee = match e1 with - | Sil.Lvar pv -> Pvar.is_callee pv + | Exp.Lvar pv -> Pvar.is_callee pv | _ -> false in let is_allocated_lhs e = let filter = function @@ -1727,13 +1731,13 @@ let handle_parameter_subtype tenv prop1 sigma2 subs (e1, se1, texp1) (se2, texp2 let type_rhs e = let sub_opt = ref None in let filter = function - | Sil.Hpointsto(e', _, Sil.Sizeof(t, len, sub)) when Sil.exp_equal e' e -> + | Sil.Hpointsto(e', _, Exp.Sizeof(t, len, sub)) when Sil.exp_equal e' e -> sub_opt := Some (t, len, sub); true | _ -> false in if IList.exists filter sigma2 then !sub_opt else None in let add_subtype () = match texp1, texp2, se1, se2 with - | Sil.Sizeof (Typ.Tptr (t1_, _), None, _), Sil.Sizeof (Typ.Tptr (t2_, _), None, _), + | Exp.Sizeof (Typ.Tptr (t1_, _), None, _), Exp.Sizeof (Typ.Tptr (t2_, _), None, _), Sil.Eexp (e1', _), Sil.Eexp (e2', _) when not (is_allocated_lhs e1') -> begin @@ -1744,8 +1748,8 @@ let handle_parameter_subtype tenv prop1 sigma2 subs (e1, se1, texp1) (se2, texp2 then begin let pos_type_opt, _ = Subtyping_check.subtype_case_analysis tenv - (Sil.Sizeof (t1, None, Subtype.subtypes)) - (Sil.Sizeof (t2_ptsto, len2, sub2)) in + (Exp.Sizeof (t1, None, Subtype.subtypes)) + (Exp.Sizeof (t2_ptsto, len2, sub2)) in match pos_type_opt with | Some t1_noptr -> ProverState.add_frame_typ (e1', t1_noptr); @@ -1761,8 +1765,8 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 | Sil.Hpointsto (_e2, se2, texp2) -> let e2 = Sil.exp_sub (snd subs) _e2 in let _ = match e2 with - | Sil.Lvar _ -> () - | Sil.Var v -> if Ident.is_primed v then + | Exp.Lvar _ -> () + | Exp.Var v -> if Ident.is_primed v then (d_impl_err ("rhs |-> not implemented", subs, (EXC_FALSE_HPRED hpred2)); raise (Exceptions.Abduction_case_not_implemented __POS__)) | _ -> () in @@ -1805,7 +1809,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 | IMPL_EXC (s, _, _) when calc_missing -> raise (MISSING_EXC s)) | Sil.Hlseg (Sil.Lseg_NE, para1, e1, f1, elist1), _ -> (* Unroll lseg *) - let n' = Sil.Var (Ident.create_fresh Ident.kprimed) in + let n' = Exp.Var (Ident.create_fresh Ident.kprimed) in let (_, para_inst1) = Sil.hpara_instantiate para1 e1 n' elist1 in let hpred_list1 = para_inst1@[Prop.mk_lseg Sil.Lseg_PE para1 n' f1 elist1] in let iter1'' = Prop.prop_iter_update_current_by_list iter1' hpred_list1 in @@ -1817,7 +1821,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 res | Sil.Hdllseg (Sil.Lseg_NE, para1, iF1, oB1, oF1, iB1, elist1), _ when Sil.exp_equal (Sil.exp_sub (fst subs) iF1) e2 -> (* Unroll dllseg forward *) - let n' = Sil.Var (Ident.create_fresh Ident.kprimed) in + let n' = Exp.Var (Ident.create_fresh Ident.kprimed) in let (_, para_inst1) = Sil.hpara_dll_instantiate para1 iF1 oB1 n' elist1 in let hpred_list1 = para_inst1@[Prop.mk_dllseg Sil.Lseg_PE para1 n' iF1 oF1 iB1 elist1] in let iter1'' = Prop.prop_iter_update_current_by_list iter1' hpred_list1 in @@ -1830,7 +1834,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 | Sil.Hdllseg (Sil.Lseg_NE, para1, iF1, oB1, oF1, iB1, elist1), _ when Sil.exp_equal (Sil.exp_sub (fst subs) iB1) e2 -> (* Unroll dllseg backward *) - let n' = Sil.Var (Ident.create_fresh Ident.kprimed) in + let n' = Exp.Var (Ident.create_fresh Ident.kprimed) in let (_, para_inst1) = Sil.hpara_dll_instantiate para1 iB1 n' oF1 elist1 in let hpred_list1 = para_inst1@[Prop.mk_dllseg Sil.Lseg_PE para1 iF1 oB1 iB1 n' elist1] in let iter1'' = Prop.prop_iter_update_current_by_list iter1' hpred_list1 in @@ -1847,8 +1851,8 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 | Sil.Hlseg (k, para2, _e2, _f2, _elist2) -> (* for now ignore implications between PE and NE *) let e2, f2 = Sil.exp_sub (snd subs) _e2, Sil.exp_sub (snd subs) _f2 in let _ = match e2 with - | Sil.Lvar _ -> () - | Sil.Var v -> if Ident.is_primed v then + | Exp.Lvar _ -> () + | Exp.Var v -> if Ident.is_primed v then (d_impl_err ("rhs |-> not implemented", subs, (EXC_FALSE_HPRED hpred2)); raise (Exceptions.Abduction_case_not_implemented __POS__)) | _ -> () @@ -1881,7 +1885,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 in match hpred1 with | Sil.Hlseg _ -> (subs', prop1') | Sil.Hpointsto _ -> (* unroll rhs list and try again *) - let n' = Sil.Var (Ident.create_fresh Ident.kprimed) in + let n' = Exp.Var (Ident.create_fresh Ident.kprimed) in let (_, para_inst2) = Sil.hpara_instantiate para2 _e2 n' elist2 in let hpred_list2 = para_inst2@[Prop.mk_lseg Sil.Lseg_PE para2 n' _f2 _elist2] in L.d_increase_indent 1; @@ -1908,15 +1912,15 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 let iF2, oF2 = Sil.exp_sub (snd subs) iF2, Sil.exp_sub (snd subs) oF2 in let iB2, oB2 = Sil.exp_sub (snd subs) iB2, Sil.exp_sub (snd subs) oB2 in let _ = match oF2 with - | Sil.Lvar _ -> () - | Sil.Var v -> if Ident.is_primed v then + | Exp.Lvar _ -> () + | Exp.Var v -> if Ident.is_primed v then (d_impl_err ("rhs dllseg not implemented", subs, (EXC_FALSE_HPRED hpred2)); raise (Exceptions.Abduction_case_not_implemented __POS__)) | _ -> () in let _ = match oB2 with - | Sil.Lvar _ -> () - | Sil.Var v -> if Ident.is_primed v then + | Exp.Lvar _ -> () + | Exp.Var v -> if Ident.is_primed v then (d_impl_err ("rhs dllseg not implemented", subs, (EXC_FALSE_HPRED hpred2)); raise (Exceptions.Abduction_case_not_implemented __POS__)) | _ -> () @@ -1958,13 +1962,13 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 * | Sil.Hpointsto (_e2, _, _) -> let e2 = Sil.exp_sub (snd subs) _e2 in (match e2 with - | Sil.Const (Const.Cstr s) -> Some (s, true) - | Sil.Const (Const.Cclass c) -> Some (Ident.name_to_string c, false) + | Exp.Const (Const.Cstr s) -> Some (s, true) + | Exp.Const (Const.Cclass c) -> Some (Ident.name_to_string c, false) | _ -> None) | _ -> None in let mk_constant_string_hpred s = (* create an hpred from a constant string *) let len = IntLit.of_int (1 + String.length s) in - let root = Sil.Const (Const.Cstr s) in + let root = Exp.Const (Const.Cstr s) in let sexp = let index = Sil.exp_int (IntLit.of_int (String.length s)) in match !Config.curr_language with @@ -1974,35 +1978,35 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 * | Config.Java -> let mk_fld_sexp s = let fld = Ident.create_fieldname (Mangled.from_string s) 0 in - let se = Sil.Eexp (Sil.Var (Ident.create_fresh Ident.kprimed), Sil.Inone) in + 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 let const_string_texp = match !Config.curr_language with | Config.Clang -> - Sil.Sizeof (Typ.Tarray (Typ.Tint Typ.IChar, Some len), None, Subtype.exact) + Exp.Sizeof (Typ.Tarray (Typ.Tint Typ.IChar, Some len), None, Subtype.exact) | Config.Java -> let object_type = Typename.TN_csu (Csu.Class Csu.Java, Mangled.from_string "java.lang.String") in let typ = match Tenv.lookup tenv object_type with | Some typ -> typ | None -> assert false in - Sil.Sizeof (Typ.Tstruct typ, None, Subtype.exact) in + Exp.Sizeof (Typ.Tstruct typ, None, Subtype.exact) in Sil.Hpointsto (root, sexp, const_string_texp) in let mk_constant_class_hpred s = (* creat an hpred from a constant class *) - let root = Sil.Const (Const.Cclass (Ident.string_to_name s)) in + let root = Exp.Const (Const.Cclass (Ident.string_to_name s)) in let sexp = (* TODO: add appropriate fields *) Sil.Estruct ([(Ident.create_fieldname (Mangled.from_string "java.lang.Class.name") 0, - Sil.Eexp ((Sil.Const (Const.Cstr s), Sil.Inone)))], Sil.inst_none) in + Sil.Eexp ((Exp.Const (Const.Cstr s), Sil.Inone)))], Sil.inst_none) in let class_texp = let class_type = Typename.TN_csu (Csu.Class Csu.Java, Mangled.from_string "java.lang.Class") in let typ = match Tenv.lookup tenv class_type with | Some typ -> typ | None -> assert false in - Sil.Sizeof (Typ.Tstruct typ, None, Subtype.exact) in + Exp.Sizeof (Typ.Tstruct typ, None, Subtype.exact) in Sil.Hpointsto (root, sexp, class_texp) in try (match move_primed_lhs_from_front subs sigma2 with @@ -2093,12 +2097,12 @@ let rec pre_check_pure_implication calc_missing subs pi1 pi2 = if Sil.exp_equal e2 f2 then pre_check_pure_implication calc_missing subs pi1 pi2' else (match e2, f2 with - | Sil.Var v2, f2 + | Exp.Var v2, f2 when Ident.is_primed v2 (* && not (Sil.mem_sub v2 (snd subs)) *) -> (* The commented-out condition should always hold. *) let sub2' = extend_sub (snd subs) v2 f2 in pre_check_pure_implication calc_missing (fst subs, sub2') pi1 pi2' - | e2, Sil.Var v2 + | e2, Exp.Var v2 when Ident.is_primed v2 (* && not (Sil.mem_sub v2 (snd subs)) *) -> (* The commented-out condition should always hold. *) let sub2' = extend_sub (snd subs) v2 e2 in @@ -2126,7 +2130,7 @@ let check_array_bounds (sub1, sub2) prop = if (not Config.bound_error_allowed_in_procedure_call) then raise (IMPL_EXC ("bounds check", (sub1, sub2), EXC_FALSE)) in let fail_if_le e' e'' = - let lt_ineq = Prop.mk_inequality (Sil.BinOp(Binop.Le, e', e'')) in + let lt_ineq = Prop.mk_inequality (Exp.BinOp(Binop.Le, e', e'')) in if check_atom prop lt_ineq then check_failed lt_ineq in let check_bound = function | ProverState.BClen_imply (len1_, len2_, _indices2) -> @@ -2135,7 +2139,7 @@ let check_array_bounds (sub1, sub2) prop = (* L.d_strln_color Orange "check_bound "; Sil.d_exp len1; L.d_str " "; Sil.d_exp len2; L.d_ln(); *) let indices_to_check = match len2 with - | _ -> [Sil.BinOp(Binop.PlusA, len2, Sil.exp_minus_one)] (* only check len *) in + | _ -> [Exp.BinOp(Binop.PlusA, len2, Sil.exp_minus_one)] (* only check len *) in IList.iter (fail_if_le len1) indices_to_check | ProverState.BCfrom_pre _atom -> let atom_neg = Prop.atom_negate (Sil.atom_sub sub2 _atom) in @@ -2197,7 +2201,9 @@ let check_implication_base pname tenv check_frame_empty calc_missing prop1 prop2 None type implication_result = - | ImplOK of (check list * Sil.subst * Sil.subst * Sil.hpred list * (Sil.atom list) * (Sil.hpred list) * (Sil.hpred list) * (Sil.hpred list) * ((Sil.exp * Sil.exp) list) * ((Sil.exp * Sil.exp) list)) + | ImplOK of + (check list * Sil.subst * Sil.subst * Sil.hpred list * (Sil.atom list) * (Sil.hpred list) * + (Sil.hpred list) * (Sil.hpred list) * ((Exp.t * Exp.t) list) * ((Exp.t * Exp.t) list)) | ImplFail of check list (** [check_implication_for_footprint p1 p2] returns @@ -2265,7 +2271,7 @@ let find_minimum_pure_cover cases = (* (** Check [prop |- e1 bool +val check_zero : Exp.t -> bool (** Check [prop |- exp1=exp2]. Result [false] means "don't know". *) -val check_equal : Prop.normal Prop.t -> exp -> exp -> bool +val check_equal : Prop.normal Prop.t -> Exp.t -> Exp.t -> bool (** Check whether [prop |- exp1!=exp2]. Result [false] means "don't know". *) -val check_disequal : Prop.normal Prop.t -> exp -> exp -> bool +val check_disequal : Prop.normal Prop.t -> Exp.t -> Exp.t -> bool -val check_le : Prop.normal Prop.t -> exp -> exp -> bool +val check_le : Prop.normal Prop.t -> Exp.t -> Exp.t -> bool (** Return true if the two types have sizes which can be compared *) val type_size_comparable : Typ.t -> Typ.t -> bool @@ -46,20 +46,20 @@ val check_inconsistency_base : Prop.normal Prop.t -> bool val check_inconsistency : Prop.normal Prop.t -> bool (** Check whether [prop |- allocated(exp)]. *) -val check_allocatedness : Prop.normal Prop.t -> exp -> bool +val check_allocatedness : Prop.normal Prop.t -> Exp.t -> bool (** [is_root prop base_exp exp] checks whether [base_exp = exp.offlist] for some list of offsets [offlist]. If so, it returns [Some(offlist)]. Otherwise, it returns [None]. Assumes that [base_exp] points to the beginning of a structure, not the middle. *) -val is_root : Prop.normal Prop.t -> exp -> exp -> offset list option +val is_root : Prop.normal Prop.t -> Exp.t -> Exp.t -> offset list option (** [expand_hpred_pointer calc_index_frame hpred] expands [hpred] if it is a |-> whose lhs is a Lfield or Lindex or ptr+off. Return [(changed, calc_index_frame', hpred')] where [changed] indicates whether the predicate has changed. *) val expand_hpred_pointer : bool -> Sil.hpred -> bool * bool * Sil.hpred (** Get upper and lower bounds of an expression, if any *) -val get_bounds : Prop.normal Prop.t -> Sil.exp -> IntLit.t option * IntLit.t option +val get_bounds : Prop.normal Prop.t -> Exp.t -> IntLit.t option * IntLit.t option (** {2 Abduction prover} *) @@ -68,12 +68,14 @@ val check_implication : Procname.t -> Tenv.t -> Prop.normal Prop.t -> Prop.expos type check = | Bounds_check - | Class_cast_check of Sil.exp * Sil.exp * Sil.exp + | Class_cast_check of Exp.t * Exp.t * Exp.t -val d_typings : (Sil.exp * Sil.exp) list -> unit +val d_typings : (Exp.t * Exp.t) list -> unit type implication_result = - | ImplOK of (check list * Sil.subst * Sil.subst * Sil.hpred list * (Sil.atom list) * (Sil.hpred list) * (Sil.hpred list) * (Sil.hpred list) * ((Sil.exp * Sil.exp) list) * ((Sil.exp * Sil.exp) list)) + | ImplOK of + (check list * Sil.subst * Sil.subst * Sil.hpred list * (Sil.atom list) * (Sil.hpred list) * + (Sil.hpred list) * (Sil.hpred list) * ((Exp.t * Exp.t) list) * ((Exp.t * Exp.t) list)) | ImplFail of check list (** [check_implication_for_footprint p1 p2] returns @@ -91,7 +93,7 @@ val find_minimum_pure_cover : (Sil.atom list * 'a) list -> (Sil.atom list * 'a) (** {2 Compute various lower or upper bounds} *) (** Computer an upper bound of an expression *) -val compute_upper_bound_of_exp : Prop.normal Prop.t -> Sil.exp -> IntLit.t option +val compute_upper_bound_of_exp : Prop.normal Prop.t -> Exp.t -> IntLit.t option (** {2 Subtype checking} *) @@ -103,7 +105,7 @@ sig (** subtype_case_analysis tenv tecp1 texp2 performs case analysis on [texp1 <: texp2], and returns the updated types in the true and false case, if they are possible *) - val subtype_case_analysis : Tenv.t -> Sil.exp -> Sil.exp -> Sil.exp option * Sil.exp option + val subtype_case_analysis : Tenv.t -> Exp.t -> Exp.t -> Exp.t option * Exp.t option end diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index cec9f4f5b..e37208152 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -34,16 +34,16 @@ let rec list_rev_and_concat l1 l2 = *) let check_bad_index pname p len index loc = let len_is_constant = match len with - | Sil.Const _ -> true + | Exp.Const _ -> true | _ -> false in let index_provably_out_of_bound () = - let index_too_large = Prop.mk_inequality (Sil.BinOp (Binop.Le, len, index)) in - let index_negative = Prop.mk_inequality (Sil.BinOp (Binop.Le, index, Sil.exp_minus_one)) in + let index_too_large = Prop.mk_inequality (Exp.BinOp (Binop.Le, len, index)) in + let index_negative = Prop.mk_inequality (Exp.BinOp (Binop.Le, index, Sil.exp_minus_one)) in (Prover.check_atom p index_too_large) || (Prover.check_atom p index_negative) in let index_provably_in_bound () = - let len_minus_one = Sil.BinOp(Binop.PlusA, len, Sil.exp_minus_one) in - let index_not_too_large = Prop.mk_inequality (Sil.BinOp(Binop.Le, index, len_minus_one)) in - let index_nonnegative = Prop.mk_inequality (Sil.BinOp(Binop.Le, Sil.exp_zero, index)) in + let len_minus_one = Exp.BinOp(Binop.PlusA, len, Sil.exp_minus_one) in + let index_not_too_large = Prop.mk_inequality (Exp.BinOp(Binop.Le, index, len_minus_one)) in + let index_nonnegative = Prop.mk_inequality (Exp.BinOp(Binop.Le, Sil.exp_zero, index)) in Prover.check_zero index || (* index 0 always in bound, even when we know nothing about len *) ((Prover.check_atom p index_not_too_large) && (Prover.check_atom p index_nonnegative)) in let index_has_bounds () = @@ -51,7 +51,7 @@ let check_bad_index pname p len index loc = | Some _, Some _ -> true | _ -> false in let get_const_opt = function - | Sil.Const (Const.Cint n) -> Some n + | Exp.Const (Const.Cint n) -> Some n | _ -> None in if not (index_provably_in_bound ()) then begin @@ -122,14 +122,14 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp create_struct_values pname tenv orig_prop footprint_part kind max_stamp t off' inst in let e' = Sil.array_clean_new_index footprint_part e in - let len = Sil.Var (new_id ()) in + let len = Exp.Var (new_id ()) in let se = Sil.Earray (len, [(e', se')], inst) in let res_t = Typ.Tarray (res_t', None) in (Sil.Aeq(e, e') :: atoms', se, res_t) | Typ.Tarray (t', len_), off -> let len = match len_ with - | None -> Sil.Var (new_id ()) - | Some len -> Sil.Const (Const.Cint len) in + | None -> Exp.Var (new_id ()) + | Some len -> Exp.Const (Const.Cint len) in (match off with | [] -> ([], Sil.Earray (len, [], inst), t) @@ -147,7 +147,7 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp ) | Typ.Tint _, [] | Typ.Tfloat _, [] | Typ.Tvoid, [] | Typ.Tfun _, [] | Typ.Tptr _, [] -> let id = new_id () in - ([], Sil.Eexp (Sil.Var id, inst), t) + ([], Sil.Eexp (Exp.Var id, inst), t) | Typ.Tint _, [Sil.Off_index e] | Typ.Tfloat _, [Sil.Off_index e] | Typ.Tvoid, [Sil.Off_index e] | Typ.Tfun _, [Sil.Off_index e] | Typ.Tptr _, [Sil.Off_index e] -> @@ -155,7 +155,7 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp let t' = match t with | Typ.Tptr(t', _) -> t' | _ -> t in - let len = Sil.Var (new_id ()) in + let len = Exp.Var (new_id ()) in let atoms', se', res_t' = create_struct_values pname tenv orig_prop footprint_part kind max_stamp t' [] inst in @@ -255,8 +255,8 @@ let rec _strexp_extend_values let len = match se with | Sil.Eexp (_, Sil.Ialloc) -> Sil.exp_one (* if allocated explicitly, we know len is 1 *) | _ -> - if Config.type_size then Sil.exp_one (* Sil.Sizeof (typ, Subtype.exact) *) - else Sil.Var (new_id ()) in + if Config.type_size then Sil.exp_one (* Exp.Sizeof (typ, Subtype.exact) *) + else Exp.Var (new_id ()) in let se_new = Sil.Earray (len, [(Sil.exp_zero, se)], inst) in let typ_new = Typ.Tarray (typ, None) in _strexp_extend_values @@ -303,7 +303,7 @@ and array_case_analysis_index pname tenv orig_prop IList.exists (fun (i, _) -> Prover.check_equal Prop.prop_emp index i) array_cont in let array_is_full = match array_len with - | Sil.Const (Const.Cint n') -> IntLit.geq (IntLit.of_int (IList.length array_cont)) n' + | Exp.Const (Const.Cint n') -> IntLit.geq (IntLit.of_int (IList.length array_cont)) n' | _ -> false in if index_in_array then @@ -374,7 +374,7 @@ let laundry_offset_for_footprint max_stamp offs_in = else let () = incr max_stamp in let fid_new = Ident.create Ident.kfootprint !max_stamp in - let exp_new = Sil.Var fid_new in + let exp_new = Exp.Var fid_new in let off_new = Sil.Off_index exp_new in let offs_seen' = off_new:: offs_seen in let eqs' = (fid_new, idx):: eqs in @@ -389,7 +389,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 (Sil.Var id) e) eqs + off', IList.map (fun (id, e) -> Prop.mk_eq (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: "; @@ -404,9 +404,9 @@ let strexp_extend_values IList.filter check_not_inconsistent atoms_se_typ_list in if Config.trace_rearrange then L.d_strln "exiting strexp_extend_values"; let len, st = match te with - | Sil.Sizeof(_, len, st) -> (len, st) + | Exp.Sizeof(_, len, st) -> (len, st) | _ -> None, Subtype.exact in - IList.map (fun (atoms', se', typ') -> (laundry_atoms @ atoms', se', Sil.Sizeof (typ', len, st))) + IList.map (fun (atoms', se', typ') -> (laundry_atoms @ atoms', se', Exp.Sizeof (typ', len, st))) atoms_se_typ_list_filtered let collect_root_offset exp = @@ -414,7 +414,7 @@ let collect_root_offset exp = let offsets = Sil.exp_get_offsets exp in (root, offsets) -(** Sil.Construct a points-to predicate for an expression, to add to a footprint. *) +(** Exp.Construct a points-to predicate for an expression, to add to a footprint. *) let mk_ptsto_exp_footprint pname tenv orig_prop (lexp, typ) max_stamp inst : Sil.hpred * Sil.hpred * Sil.atom list = let root, off = collect_root_offset lexp in @@ -439,24 +439,24 @@ let mk_ptsto_exp_footprint | Config.Clang -> Subtype.exact | Config.Java -> Subtype.subtypes in let create_ptsto footprint_part off0 = match root, off0, typ with - | Sil.Lvar pvar, [], Typ.Tfun _ -> + | Exp.Lvar pvar, [], Typ.Tfun _ -> let fun_name = Procname.from_string_c_fun (Mangled.to_string (Pvar.get_name pvar)) in - let fun_exp = Sil.Const (Const.Cfun fun_name) in - ([], Prop.mk_ptsto root (Sil.Eexp (fun_exp, inst)) (Sil.Sizeof (typ, None, st))) + let fun_exp = Exp.Const (Const.Cfun fun_name) in + ([], Prop.mk_ptsto root (Sil.Eexp (fun_exp, inst)) (Exp.Sizeof (typ, None, st))) | _, [], Typ.Tfun _ -> let atoms, se, t = create_struct_values pname tenv orig_prop footprint_part Ident.kfootprint max_stamp typ off0 inst in - (atoms, Prop.mk_ptsto root se (Sil.Sizeof (t, None, st))) + (atoms, Prop.mk_ptsto root se (Exp.Sizeof (t, None, st))) | _ -> let atoms, se, t = create_struct_values pname tenv orig_prop footprint_part Ident.kfootprint max_stamp typ off0 inst in - (atoms, Prop.mk_ptsto root se (Sil.Sizeof (t, None, st))) in + (atoms, Prop.mk_ptsto root se (Exp.Sizeof (t, None, st))) in 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 (Sil.Var id) e) eqs in + let atoms' = IList.map (fun (id, e) -> Prop.mk_eq (Exp.Var id) e) eqs in (ptsto, ptsto_foot, atoms @ atoms') (** Check if the path in exp exists already in the current ptsto predicate. @@ -528,8 +528,8 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst = L.d_ln (); L.d_ln () end; let extend_kind = match e with (* Determine whether to extend the footprint part or just the normal part *) - | Sil.Var id when not (Ident.is_footprint id) -> Ident.kprimed - | Sil.Lvar pvar when Pvar.is_local pvar -> Ident.kprimed + | Exp.Var id when not (Ident.is_footprint id) -> Ident.kprimed + | Exp.Lvar pvar when Pvar.is_local pvar -> Ident.kprimed | _ -> Ident.kfootprint in let iter_list = let atoms_se_te_list = @@ -675,10 +675,10 @@ let add_guarded_by_constraints prop lexp pdesc = Ident.fieldname_to_string fld = guarded_by_str in IList.find_map_opt (function - | Sil.Hpointsto ((Const (Cclass clazz) as lhs_exp), _, Sil.Sizeof (typ, _, _)) + | Sil.Hpointsto ((Const (Cclass clazz) as lhs_exp), _, Exp.Sizeof (typ, _, _)) when guarded_by_str_is_class guarded_by_str (Ident.name_to_string clazz) -> Some (Sil.Eexp (lhs_exp, Sil.inst_none), typ) - | Sil.Hpointsto (_, Estruct (flds, _), Sil.Sizeof (typ, _, _)) -> + | Sil.Hpointsto (_, Estruct (flds, _), Exp.Sizeof (typ, _, _)) -> let get_fld_strexp_and_typ f flds = try let fld, strexp = IList.find f flds in @@ -701,7 +701,7 @@ let add_guarded_by_constraints prop lexp pdesc = | res -> res end - | Sil.Hpointsto (Lvar pvar, rhs_exp, Sil.Sizeof (typ, _, _)) + | Sil.Hpointsto (Lvar pvar, rhs_exp, Exp.Sizeof (typ, _, _)) when guarded_by_str_is_current_class_this guarded_by_str pname && Pvar.is_this pvar -> Some (rhs_exp, typ) | _ -> @@ -819,7 +819,7 @@ let add_guarded_by_constraints prop lexp pdesc = | _ -> prop_acc in match lexp with - | Sil.Lfield (_, fld, typ) -> + | Exp.Lfield (_, fld, typ) -> (* check for direct access to field annotated with @GuardedBy *) enforce_guarded_access fld typ prop | _ -> @@ -919,7 +919,7 @@ let iter_rearrange_ptsto pname tenv orig_prop iter lexp inst = let iter_rearrange_ne_lseg recurse_on_iters iter para e1 e2 elist = if Config.nelseg then let iter_inductive_case = - let n' = Sil.Var (Ident.create_fresh Ident.kprimed) in + let n' = Exp.Var (Ident.create_fresh Ident.kprimed) in let (_, para_inst1) = Sil.hpara_instantiate para e1 n' elist in let hpred_list1 = para_inst1@[Prop.mk_lseg Sil.Lseg_NE para n' e2 elist] in Prop.prop_iter_update_current_by_list iter hpred_list1 in @@ -929,7 +929,7 @@ let iter_rearrange_ne_lseg recurse_on_iters iter para e1 e2 elist = recurse_on_iters [iter_inductive_case; iter_base_case] else let iter_inductive_case = - let n' = Sil.Var (Ident.create_fresh Ident.kprimed) in + let n' = Exp.Var (Ident.create_fresh Ident.kprimed) in let (_, para_inst1) = Sil.hpara_instantiate para e1 n' elist in let hpred_list1 = para_inst1@[Prop.mk_lseg Sil.Lseg_PE para n' e2 elist] in Prop.prop_iter_update_current_by_list iter hpred_list1 in @@ -938,7 +938,7 @@ let iter_rearrange_ne_lseg recurse_on_iters iter para e1 e2 elist = (** do re-arrangment for an iter whose current element is a nonempty dllseg to be unrolled from lhs *) let iter_rearrange_ne_dllseg_first recurse_on_iters iter para_dll e1 e2 e3 e4 elist = let iter_inductive_case = - let n' = Sil.Var (Ident.create_fresh Ident.kprimed) in + let n' = Exp.Var (Ident.create_fresh Ident.kprimed) in let (_, para_dll_inst1) = Sil.hpara_dll_instantiate para_dll e1 e2 n' elist in let hpred_list1 = para_dll_inst1@[Prop.mk_dllseg Sil.Lseg_NE para_dll n' e1 e3 e4 elist] in Prop.prop_iter_update_current_by_list iter hpred_list1 in @@ -955,7 +955,7 @@ let iter_rearrange_ne_dllseg_first recurse_on_iters iter para_dll e1 e2 e3 e4 el (** do re-arrangment for an iter whose current element is a nonempty dllseg to be unrolled from rhs *) let iter_rearrange_ne_dllseg_last recurse_on_iters iter para_dll e1 e2 e3 e4 elist = let iter_inductive_case = - let n' = Sil.Var (Ident.create_fresh Ident.kprimed) in + let n' = Exp.Var (Ident.create_fresh Ident.kprimed) in let (_, para_dll_inst1) = Sil.hpara_dll_instantiate para_dll e4 n' e3 elist in let hpred_list1 = para_dll_inst1@[Prop.mk_dllseg Sil.Lseg_NE para_dll e1 e2 e4 n' elist] in Prop.prop_iter_update_current_by_list iter hpred_list1 in @@ -972,7 +972,7 @@ let iter_rearrange_ne_dllseg_last recurse_on_iters iter para_dll e1 e2 e3 e4 eli (** do re-arrangment for an iter whose current element is a possibly empty listseg *) let iter_rearrange_pe_lseg recurse_on_iters default_case_iter iter para e1 e2 elist = let iter_nonemp_case = - let n' = Sil.Var (Ident.create_fresh Ident.kprimed) in + let n' = Exp.Var (Ident.create_fresh Ident.kprimed) in let (_, para_inst1) = Sil.hpara_instantiate para e1 n' elist in let hpred_list1 = para_inst1@[Prop.mk_lseg Sil.Lseg_PE para n' e2 elist] in Prop.prop_iter_update_current_by_list iter hpred_list1 in @@ -989,7 +989,7 @@ let iter_rearrange_pe_lseg recurse_on_iters default_case_iter iter para e1 e2 el (** do re-arrangment for an iter whose current element is a possibly empty dllseg to be unrolled from lhs *) let iter_rearrange_pe_dllseg_first recurse_on_iters default_case_iter iter para_dll e1 e2 e3 e4 elist = let iter_inductive_case = - let n' = Sil.Var (Ident.create_fresh Ident.kprimed) in + let n' = Exp.Var (Ident.create_fresh Ident.kprimed) in let (_, para_dll_inst1) = Sil.hpara_dll_instantiate para_dll e1 e2 n' elist in let hpred_list1 = para_dll_inst1@[Prop.mk_dllseg Sil.Lseg_PE para_dll n' e1 e3 e4 elist] in Prop.prop_iter_update_current_by_list iter hpred_list1 in @@ -1007,7 +1007,7 @@ let iter_rearrange_pe_dllseg_first recurse_on_iters default_case_iter iter para_ (** do re-arrangment for an iter whose current element is a possibly empty dllseg to be unrolled from rhs *) let iter_rearrange_pe_dllseg_last recurse_on_iters default_case_iter iter para_dll e1 e2 e3 e4 elist = let iter_inductive_case = - let n' = Sil.Var (Ident.create_fresh Ident.kprimed) in + let n' = Exp.Var (Ident.create_fresh Ident.kprimed) in let (_, para_dll_inst1) = Sil.hpara_dll_instantiate para_dll e4 n' e3 elist in let hpred_list1 = para_dll_inst1@[Prop.mk_dllseg Sil.Lseg_PE para_dll e1 e2 e4 n' elist] in Prop.prop_iter_update_current_by_list iter hpred_list1 in @@ -1037,7 +1037,7 @@ let type_at_offset texp off = strip_offset off' typ' | _ -> None in match texp with - | Sil.Sizeof(typ, _, _) -> + | Exp.Sizeof(typ, _, _) -> strip_offset off typ | _ -> None @@ -1187,7 +1187,7 @@ let check_dereference_error pdesc (prop : Prop.normal Prop.t) lexp loc = IList.for_all (fun hpred -> match hpred with - | Sil.Hpointsto (Sil.Lvar pvar, Sil.Eexp (Sil.Var _ as exp, _), _) + | Sil.Hpointsto (Exp.Lvar pvar, Sil.Eexp (Exp.Var _ as exp, _), _) when Sil.exp_equal exp deref_exp -> let is_weak_captured_var = is_weak_captured_var pdesc pvar in let is_nullable = @@ -1208,14 +1208,14 @@ let check_dereference_error pdesc (prop : Prop.normal Prop.t) lexp loc = IList.exists is_nullable_attr (Prop.get_attributes prop exp) in (* it's ok for a non-nullable local to point to deref_exp *) is_nullable || Pvar.is_local pvar - | Sil.Hpointsto (_, Sil.Estruct (flds, _), Sil.Sizeof (typ, _, _)) -> + | Sil.Hpointsto (_, Sil.Estruct (flds, _), Exp.Sizeof (typ, _, _)) -> let fld_is_nullable fld = match Annotations.get_field_type_and_annotation fld typ with | Some (_, annot) -> Annotations.ia_is_nullable annot | _ -> false in let is_strexp_pt_by_nullable_fld (fld, strexp) = match strexp with - | Sil.Eexp (Sil.Var _ as exp, _) when Sil.exp_equal exp deref_exp -> + | Sil.Eexp (Exp.Var _ as exp, _) when Sil.exp_equal exp deref_exp -> let is_nullable = fld_is_nullable fld in if is_nullable then nullable_obj_str := Some (Ident.fieldname_to_simplified_string fld); @@ -1246,7 +1246,7 @@ let check_dereference_error pdesc (prop : Prop.normal Prop.t) lexp loc = | Some att -> Some att | None -> (* try to remove an offset if any, and find the attribute there *) let root_no_offset = match root with - | Sil.BinOp((Binop.PlusPI | Binop.PlusA | Binop.MinusPI | Binop.MinusA), base, _) -> base + | Exp.BinOp((Binop.PlusPI | Binop.PlusA | Binop.MinusPI | Binop.MinusA), base, _) -> base | _ -> root in get_relevant_attributes root_no_offset in if Prover.check_zero (Sil.root_of_lexp root) || is_deref_of_nullable then @@ -1299,27 +1299,27 @@ let check_call_to_objc_block_error pdesc prop fun_exp loc = not (Prover.check_disequal prop (Sil.root_of_lexp fun_exp) Sil.exp_zero) in let try_explaining_exp e = (* when e is a temp var, try to find the pvar defining e*) match e with - | Sil.Var id -> + | Exp.Var id -> (match (Errdesc.find_ident_assignment (State.get_node ()) id) with | Some (_, e') -> e' | None -> e) | _ -> e in let get_exp_called () = (* Exp called in the block's function call*) match State.get_instr () with - | Some Sil.Call(_, Sil.Var id, _, _, _) -> + | Some Sil.Call(_, Exp.Var id, _, _, _) -> Errdesc.find_ident_assignment (State.get_node ()) id | _ -> None in let is_fun_exp_captured_var () = (* Called expression is a captured variable of the block *) match get_exp_called () with - | Some (_, Sil.Lvar pvar) -> (* pvar is the block *) + | Some (_, Exp.Lvar pvar) -> (* pvar is the block *) let name = Pvar.get_name pvar in IList.exists (fun (cn, _) -> (Mangled.equal name cn)) (Cfg.Procdesc.get_captured pdesc) | _ -> false in let is_field_deref () = (*Called expression is a field *) match get_exp_called () with - | Some (_, (Sil.Lfield(e', fn, t))) -> + | Some (_, (Exp.Lfield(e', fn, t))) -> let e'' = try_explaining_exp e' in - Some (Sil.Lfield(e'', fn, t)), true (* the block dereferences is a field of an object*) + Some (Exp.Lfield(e'', fn, t)), true (* the block dereferences is a field of an object*) | Some (_, e) -> Some e, false | _ -> None, false in if (!Config.curr_language = Config.Clang) && @@ -1329,7 +1329,7 @@ let check_call_to_objc_block_error pdesc prop fun_exp loc = let deref_str = Localise.deref_str_null None in let err_desc_nobuckets = Errdesc.explain_dereference ~is_nullable: true deref_str prop loc in match fun_exp with - | Sil.Var id when Ident.is_footprint id -> + | Exp.Var id when Ident.is_footprint id -> let e_opt, is_field_deref = is_field_deref () in let err_desc_nobuckets' = (match e_opt with | Some e -> Localise.parameter_field_not_null_checked_desc err_desc_nobuckets e @@ -1362,8 +1362,8 @@ let rearrange ?(report_deref_errors=true) pdesc tenv lexp typ prop loc : (Sil.offset list) Prop.prop_iter list = let nlexp = match Prop.exp_normalize_prop prop lexp with - | Sil.BinOp(Binop.PlusPI, ep, e) -> (* array access with pointer arithmetic *) - Sil.Lindex(ep, e) + | Exp.BinOp(Binop.PlusPI, ep, e) -> (* array access with pointer arithmetic *) + Exp.Lindex(ep, e) | e -> e in let ptr_tested_for_zero = Prover.check_disequal prop (Sil.root_of_lexp nlexp) Sil.exp_zero in diff --git a/infer/src/backend/rearrange.mli b/infer/src/backend/rearrange.mli index d8cbbad96..61291c38f 100644 --- a/infer/src/backend/rearrange.mli +++ b/infer/src/backend/rearrange.mli @@ -16,17 +16,17 @@ exception ARRAY_ACCESS (** Check for dereference errors: dereferencing 0, a freed value, or an undefined value *) val check_dereference_error : - Cfg.Procdesc.t -> Prop.normal Prop.t -> Sil.exp -> Location.t -> unit + Cfg.Procdesc.t -> Prop.normal Prop.t -> Exp.t -> Location.t -> unit (** Check that an expression representing an objc block can be null and raise a [B1] null exception. It's used to check that we don't call possibly null blocks *) val check_call_to_objc_block_error : - Cfg.Procdesc.t -> Prop.normal Prop.t -> Sil.exp -> Location.t -> unit + Cfg.Procdesc.t -> Prop.normal Prop.t -> Exp.t -> Location.t -> unit (** [rearrange lexp prop] rearranges [prop] into the form [prop' * lexp|->strexp:typ]. It returns an iterator with [lexp |-> strexp: typ] as current predicate and the path (an [offsetlist]) which leads to [lexp] as the iterator state. *) val rearrange : - ?report_deref_errors:bool -> Cfg.Procdesc.t -> Tenv.t -> Sil.exp -> + ?report_deref_errors:bool -> Cfg.Procdesc.t -> Tenv.t -> Exp.t -> Typ.t -> Prop.normal Prop.t -> Location.t -> (Sil.offset list) Prop.prop_iter list diff --git a/infer/src/backend/specs.ml b/infer/src/backend/specs.ml index e0e89f614..5eb96a257 100644 --- a/infer/src/backend/specs.ml +++ b/infer/src/backend/specs.ml @@ -200,7 +200,9 @@ end = struct let fav = spec_fav spec in let idlist = Sil.fav_to_list fav in let count = ref 0 in - let sub = Sil.sub_of_list (IList.map (fun id -> incr count; (id, Sil.Var (Ident.create_normal Ident.name_spec !count))) idlist) in + let sub = + Sil.sub_of_list (IList.map (fun id -> + incr count; (id, Exp.Var (Ident.create_normal Ident.name_spec !count))) idlist) in spec_sub sub spec (** Return a compact representation of the spec *) diff --git a/infer/src/backend/state.ml b/infer/src/backend/state.ml index b553eef8f..669259ee1 100644 --- a/infer/src/backend/state.ml +++ b/infer/src/backend/state.ml @@ -15,7 +15,7 @@ open! Utils module L = Logging module F = Format -type const_map = Cfg.Node.t -> Sil.exp -> Const.t option +type const_map = Cfg.Node.t -> Exp.t -> Const.t option (** failure statistics for symbolic execution on a given node *) type failure_stats = { @@ -156,7 +156,7 @@ let instrs_normalize instrs = let gensym id = incr count; Ident.set_stamp id !count in - Sil.sub_of_list (IList.map (fun id -> (id, Sil.Var (gensym id))) bound_ids) in + Sil.sub_of_list (IList.map (fun id -> (id, Exp.Var (gensym id))) bound_ids) in IList.map (Sil.instr_sub subst) instrs (** Create a function to find duplicate nodes. @@ -254,7 +254,8 @@ 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 -> incr count; (id, Sil.Var (Ident.create_normal Ident.name_spec !count))) idlist) in + Sil.sub_of_list (IList.map (fun id -> + incr count; (id, Exp.Var (Ident.create_normal Ident.name_spec !count))) idlist) in let _, p' = Cfg.remove_locals_formals pdesc p in let pre, _ = Prop.extract_spec p' in let pre' = try abstract_fun tenv pre with exn when SymOp.exn_not_failure exn -> pre in diff --git a/infer/src/backend/state.mli b/infer/src/backend/state.mli index 13e340d75..60432b972 100644 --- a/infer/src/backend/state.mli +++ b/infer/src/backend/state.mli @@ -18,7 +18,7 @@ type t (** Add diverging states *) val add_diverging_states : Paths.PathSet.t -> unit -type const_map = Cfg.Node.t -> Sil.exp -> Const.t option +type const_map = Cfg.Node.t -> Exp.t -> Const.t option (** Get the constant map for the current procedure. *) val get_const_map : unit -> const_map diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index 9812f99ca..0a6e7b271 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -35,7 +35,7 @@ let rec unroll_type tenv typ off = end | Typ.Tarray (typ', _), Sil.Off_index _ -> typ' - | _, Sil.Off_index (Sil.Const (Const.Cint i)) when IntLit.iszero i -> + | _, Sil.Off_index (Exp.Const (Const.Cint i)) when IntLit.iszero i -> typ | _ -> L.d_strln ".... Invalid Field Access ...."; @@ -82,7 +82,7 @@ let check_block_retain_cycle tenv caller_pname prop block_nullified = false cases for field and array accesses. *) let rec apply_offlist pdesc tenv p fp_root nullify_struct (root_lexp, strexp, typ) offlist - (f: Sil.exp option -> Sil.exp) inst lookup_inst = + (f: Exp.t option -> Exp.t) inst lookup_inst = let pname = Cfg.Procdesc.get_proc_name pdesc in let pp_error () = L.d_strln ".... Invalid Field ...."; @@ -100,7 +100,7 @@ let rec apply_offlist | _ -> false in let is_hidden_field () = match State.get_instr () with - | Some (Sil.Letderef (_, Sil.Lfield (_, fieldname, _), _, _)) -> + | Some (Sil.Letderef (_, Exp.Lfield (_, fieldname, _), _, _)) -> Ident.fieldname_is_hidden fieldname | _ -> false in let inst_new = match inst with @@ -194,7 +194,7 @@ let rec apply_offlist (* return a nondeterministic value if the index is not found after rearrangement *) L.d_str "apply_offlist: index "; Sil.d_exp idx; L.d_strln " not materialized -- returning nondeterministic value"; - let res_e' = Sil.Var (Ident.create_fresh Ident.kprimed) in + let res_e' = Exp.Var (Ident.create_fresh Ident.kprimed) in (res_e', strexp, typ, None) end | (Sil.Off_index _):: _, _ -> @@ -217,9 +217,9 @@ let rec apply_offlist extensions of se are done before this function. *) let ptsto_lookup pdesc tenv p (lexp, se, typ, len, st) offlist id = let f = - function Some exp -> exp | None -> Sil.Var id in + function Some exp -> exp | None -> Exp.Var id in let fp_root = - match lexp with Sil.Var id -> Ident.is_footprint id | _ -> false in + match lexp with Exp.Var id -> Ident.is_footprint id | _ -> false in let lookup_inst = ref None in let e', se', typ', pred_insts_op' = apply_offlist @@ -228,7 +228,7 @@ let ptsto_lookup pdesc tenv p (lexp, se, typ, len, st) offlist id = match !lookup_inst with | Some (Sil.Iinitial | Sil.Ialloc | Sil.Ilookup) -> true | _ -> false in - let ptsto' = Prop.mk_ptsto lexp se' (Sil.Sizeof (typ', len, st)) in + let ptsto' = Prop.mk_ptsto lexp se' (Exp.Sizeof (typ', len, st)) in (e', ptsto', pred_insts_op', lookup_uninitialized) (** [ptsto_update p (lexp,se,typ) offlist exp] takes @@ -245,13 +245,13 @@ let ptsto_lookup pdesc tenv p (lexp, se, typ, len, st) offlist id = let ptsto_update pdesc tenv p (lexp, se, typ, len, st) offlist exp = let f _ = exp in let fp_root = - match lexp with Sil.Var id -> Ident.is_footprint id | _ -> false in + match lexp with Exp.Var id -> Ident.is_footprint id | _ -> false in let lookup_inst = ref None in let _, se', typ', pred_insts_op' = let pos = State.get_path_pos () in apply_offlist pdesc tenv p fp_root true (lexp, se, typ) offlist f (State.get_inst_update pos) lookup_inst in - let ptsto' = Prop.mk_ptsto lexp se' (Sil.Sizeof (typ', len, st)) in + let ptsto' = Prop.mk_ptsto lexp se' (Exp.Sizeof (typ', len, st)) in (ptsto', pred_insts_op') let update_iter iter pi sigma = @@ -297,10 +297,10 @@ let prune_ineq ~is_strict ~positive prop e1 e2 = the comment above *) (* build [e1] CMP [e2] *) let cmp = if is_strict then Binop.Lt else Binop.Le in - let e1_cmp_e2 = Sil.BinOp (cmp, e1, e2) in + let e1_cmp_e2 = Exp.BinOp (cmp, e1, e2) in (* build !([e1] CMP [e2]) *) let dual_cmp = if is_strict then Binop.Le else Binop.Lt in - let not_e1_cmp_e2 = Sil.BinOp (dual_cmp, e2, e1) in + let not_e1_cmp_e2 = Exp.BinOp (dual_cmp, e2, e1) in (* take polarity into account *) let (prune_cond, not_prune_cond) = if positive then (e1_cmp_e2, not_e1_cmp_e2) @@ -314,47 +314,47 @@ let prune_ineq ~is_strict ~positive prop e1 e2 = let rec prune ~positive condition prop = match condition with - | Sil.Var _ | Sil.Lvar _ -> + | Exp.Var _ | Exp.Lvar _ -> prune_ne ~positive condition Sil.exp_zero prop - | Sil.Const (Const.Cint i) when IntLit.iszero i -> + | Exp.Const (Const.Cint i) when IntLit.iszero i -> if positive then Propset.empty else Propset.singleton prop - | Sil.Const (Const.Cint _ | Const.Cstr _ | Const.Cclass _) | Sil.Sizeof _ -> + | Exp.Const (Const.Cint _ | Const.Cstr _ | Const.Cclass _) | Exp.Sizeof _ -> if positive then Propset.singleton prop else Propset.empty - | Sil.Const _ -> + | Exp.Const _ -> assert false - | Sil.Cast (_, condition') -> + | Exp.Cast (_, condition') -> prune ~positive condition' prop - | Sil.UnOp (Unop.LNot, condition', _) -> + | Exp.UnOp (Unop.LNot, condition', _) -> prune ~positive:(not positive) condition' prop - | Sil.UnOp _ -> + | Exp.UnOp _ -> assert false - | Sil.BinOp (Binop.Eq, e, Sil.Const (Const.Cint i)) - | Sil.BinOp (Binop.Eq, Sil.Const (Const.Cint i), e) + | Exp.BinOp (Binop.Eq, e, Exp.Const (Const.Cint i)) + | Exp.BinOp (Binop.Eq, Exp.Const (Const.Cint i), e) when IntLit.iszero i && not (IntLit.isnull i) -> prune ~positive:(not positive) e prop - | Sil.BinOp (Binop.Eq, e1, e2) -> + | Exp.BinOp (Binop.Eq, e1, e2) -> prune_ne ~positive:(not positive) e1 e2 prop - | Sil.BinOp (Binop.Ne, e, Sil.Const (Const.Cint i)) - | Sil.BinOp (Binop.Ne, Sil.Const (Const.Cint i), e) + | Exp.BinOp (Binop.Ne, e, Exp.Const (Const.Cint i)) + | Exp.BinOp (Binop.Ne, Exp.Const (Const.Cint i), e) when IntLit.iszero i && not (IntLit.isnull i) -> prune ~positive e prop - | Sil.BinOp (Binop.Ne, e1, e2) -> + | Exp.BinOp (Binop.Ne, e1, e2) -> prune_ne ~positive e1 e2 prop - | Sil.BinOp (Binop.Ge, e2, e1) | Sil.BinOp (Binop.Le, e1, e2) -> + | Exp.BinOp (Binop.Ge, e2, e1) | Exp.BinOp (Binop.Le, e1, e2) -> prune_ineq ~is_strict:false ~positive prop e1 e2 - | Sil.BinOp (Binop.Gt, e2, e1) | Sil.BinOp (Binop.Lt, e1, e2) -> + | Exp.BinOp (Binop.Gt, e2, e1) | Exp.BinOp (Binop.Lt, e1, e2) -> prune_ineq ~is_strict:true ~positive prop e1 e2 - | Sil.BinOp (Binop.LAnd, condition1, condition2) -> + | Exp.BinOp (Binop.LAnd, condition1, condition2) -> let pruner = if positive then prune_inter else prune_union in pruner ~positive condition1 condition2 prop - | Sil.BinOp (Binop.LOr, condition1, condition2) -> + | Exp.BinOp (Binop.LOr, condition1, condition2) -> let pruner = if positive then prune_union else prune_inter in pruner ~positive condition1 condition2 prop - | Sil.BinOp _ | Sil.Lfield _ | Sil.Lindex _ -> + | Exp.BinOp _ | Exp.Lfield _ | Exp.Lindex _ -> prune_ne ~positive condition Sil.exp_zero prop - | Sil.Exn _ -> + | Exp.Exn _ -> assert false - | Sil.Closure _ -> + | Exp.Closure _ -> assert false and prune_inter ~positive condition1 condition2 prop = @@ -403,16 +403,16 @@ let check_constant_string_dereference lexp = let c = try Char.code (String.get s (IntLit.to_int n)) with Invalid_argument _ -> 0 in Sil.exp_int (IntLit.of_int c) in match lexp with - | Sil.BinOp(Binop.PlusPI, Sil.Const (Const.Cstr s), e) - | Sil.Lindex (Sil.Const (Const.Cstr s), e) -> + | Exp.BinOp(Binop.PlusPI, Exp.Const (Const.Cstr s), e) + | Exp.Lindex (Exp.Const (Const.Cstr s), e) -> let value = match e with - | Sil.Const (Const.Cint n) + | Exp.Const (Const.Cint n) when IntLit.geq n IntLit.zero && IntLit.leq n (IntLit.of_int (String.length s)) -> string_lookup s n | _ -> Sil.exp_get_undefined false in Some value - | Sil.Const (Const.Cstr s) -> + | Exp.Const (Const.Cstr s) -> Some (string_lookup s IntLit.zero) | _ -> None @@ -443,17 +443,17 @@ let check_already_dereferenced pname cond prop = | _ -> false) (Prop.get_sigma prop)) with Not_found -> None in let rec is_check_zero = function - | Sil.Var id -> + | Exp.Var id -> Some id - | Sil.UnOp(Unop.LNot, e, _) -> + | Exp.UnOp(Unop.LNot, e, _) -> is_check_zero e - | Sil.BinOp ((Binop.Eq | Binop.Ne), Sil.Const Const.Cint i, Sil.Var id) - | Sil.BinOp ((Binop.Eq | Binop.Ne), Sil.Var id, Sil.Const Const.Cint i) when IntLit.iszero i -> + | Exp.BinOp ((Binop.Eq | Binop.Ne), Exp.Const Const.Cint i, Exp.Var id) + | Exp.BinOp ((Binop.Eq | Binop.Ne), Exp.Var id, Exp.Const Const.Cint i) when IntLit.iszero i -> Some id | _ -> None in let dereferenced_line = match is_check_zero cond with | Some id -> - (match find_hpred (Prop.exp_normalize_prop prop (Sil.Var id)) with + (match find_hpred (Prop.exp_normalize_prop prop (Exp.Var id)) with | Some (Sil.Hpointsto (_, se, _)) -> (match Tabulation.find_dereference_without_null_check_in_sexp se with | Some n -> Some (id, n) @@ -465,7 +465,7 @@ let check_already_dereferenced pname cond prop = | Some (id, (n, _)) -> let desc = Errdesc.explain_null_test_after_dereference - (Sil.Var id) (State.get_node ()) n (State.get_loc ()) in + (Exp.Var id) (State.get_node ()) n (State.get_loc ()) in let exn = (Exceptions.Null_test_after_dereference (desc, __POS__)) in let pre_opt = State.get_normalized_pre (Abs.abstract_no_symop pname) in @@ -534,8 +534,8 @@ let resolve_typename prop receiver_exp = | _ :: hpreds -> loop hpreds in loop (Prop.get_sigma prop) in match typexp_opt with - | Some (Sil.Sizeof (Typ.Tstruct { Typ.struct_name = None }, _, _)) -> None - | Some (Sil.Sizeof (Typ.Tstruct { Typ.csu = Csu.Class ck; struct_name = Some name }, _, _)) -> + | Some (Exp.Sizeof (Typ.Tstruct { Typ.struct_name = None }, _, _)) -> None + | Some (Exp.Sizeof (Typ.Tstruct { Typ.csu = Csu.Class ck; struct_name = Some name }, _, _)) -> Some (Typename.TN_csu (Csu.Class ck, name)) | _ -> None @@ -693,7 +693,7 @@ let call_constructor_url_update_args pname actual_params = [(Some "java.lang"), "String"] Procname.Non_Static) in if (Procname.equal url_pname pname) then (match actual_params with - | [this; (Sil.Const (Const.Cstr s), atype)] -> + | [this; (Exp.Const (Const.Cstr s), atype)] -> let parts = Str.split (Str.regexp_string "://") s in (match parts with | frst:: _ -> @@ -703,10 +703,10 @@ let call_constructor_url_update_args pname actual_params = frst = "mailto" || frst = "jar" then - [this; (Sil.Const (Const.Cstr frst), atype)] + [this; (Exp.Const (Const.Cstr frst), atype)] else actual_params | _ -> actual_params) - | [this; _, atype] -> [this; (Sil.Const (Const.Cstr "file"), atype)] + | [this; _, atype] -> [this; (Exp.Const (Const.Cstr "file"), atype)] | _ -> actual_params) else actual_params @@ -738,9 +738,9 @@ let handle_objc_instance_method_call_or_skip actual_pars path callee_pname pre r | [ret_id] -> ( match Prop.find_equal_formal_path receiver prop with | Some vfs -> - Prop.add_or_replace_attribute prop (Apred (Aobjc_null, [Sil.Var ret_id; vfs])) + Prop.add_or_replace_attribute prop (Apred (Aobjc_null, [Exp.Var ret_id; vfs])) | None -> - Prop.conjoin_eq (Sil.Var ret_id) Sil.exp_zero prop + Prop.conjoin_eq (Exp.Var ret_id) Sil.exp_zero prop ) | _ -> prop in if is_receiver_null then @@ -792,15 +792,15 @@ let do_error_checks node_opt instr pname pdesc = match node_opt with () let add_strexp_to_footprint strexp abducted_pv typ prop = - let abducted_lvar = Sil.Lvar abducted_pv in + let abducted_lvar = Exp.Lvar abducted_pv in let lvar_pt_fpvar = - let sizeof_exp = Sil.Sizeof (typ, None, Subtype.subtypes) in + let sizeof_exp = Exp.Sizeof (typ, None, Subtype.subtypes) in Prop.mk_ptsto abducted_lvar strexp sizeof_exp in let sigma_fp = Prop.get_sigma_footprint prop in Prop.normalize (Prop.replace_sigma_footprint (lvar_pt_fpvar :: sigma_fp) prop) let add_to_footprint abducted_pv typ prop = - let fresh_fp_var = Sil.Var (Ident.create_fresh Ident.kfootprint) in + let fresh_fp_var = Exp.Var (Ident.create_fresh Ident.kfootprint) in let prop' = add_strexp_to_footprint (Sil.Eexp (fresh_fp_var, Sil.Inone)) abducted_pv typ prop in prop', fresh_fp_var @@ -822,13 +822,13 @@ let add_constraints_on_retval pdesc prop ret_exp ~has_nullable_annot typ callee_ let already_has_abducted_retval p abducted_ret_pv = IList.exists (fun hpred -> match hpred with - | Sil.Hpointsto (Sil.Lvar pv, _, _) -> Pvar.equal pv abducted_ret_pv + | Sil.Hpointsto (Exp.Lvar pv, _, _) -> Pvar.equal pv abducted_ret_pv | _ -> false) (Prop.get_sigma_footprint p) in (* find an hpred [abducted] |-> A in [prop] and add [exp] = A to prop *) let bind_exp_to_abducted_val exp_to_bind abducted prop = let bind_exp prop = function - | Sil.Hpointsto (Sil.Lvar pv, Sil.Eexp (rhs, _), _) + | Sil.Hpointsto (Exp.Lvar pv, Sil.Eexp (rhs, _), _) when Pvar.equal pv abducted -> Prop.conjoin_eq exp_to_bind rhs prop | _ -> prop in @@ -872,15 +872,15 @@ let add_taint prop lhs_id rhs_exp pname tenv = if Taint.has_taint_annotation fieldname struct_typ then let taint_info = { Sil.taint_source = pname; taint_kind = Tk_unknown; } in - Prop.add_or_replace_attribute prop (Apred (Ataint taint_info, [Sil.Var lhs_id])) + Prop.add_or_replace_attribute prop (Apred (Ataint taint_info, [Exp.Var lhs_id])) else prop in match rhs_exp with - | Sil.Lfield (_, fieldname, Tptr (Tstruct struct_typ, _)) - | Sil.Lfield (_, fieldname, Tstruct struct_typ) -> + | Exp.Lfield (_, fieldname, Tptr (Tstruct struct_typ, _)) + | Exp.Lfield (_, fieldname, Tstruct struct_typ) -> add_attribute_if_field_tainted prop fieldname struct_typ - | Sil.Lfield (_, fieldname, Tptr (Tvar typname, _)) - | Sil.Lfield (_, fieldname, Tvar typname) -> + | Exp.Lfield (_, fieldname, Tptr (Tvar typname, _)) + | Exp.Lfield (_, fieldname, Tvar typname) -> begin match Tenv.lookup tenv typname with | Some struct_typ -> add_attribute_if_field_tainted prop fieldname struct_typ @@ -893,17 +893,17 @@ let execute_letderef ?(report_deref_errors=true) pname pdesc tenv id rhs_exp typ let iter_ren = Prop.prop_iter_make_id_primed id iter in let prop_ren = Prop.prop_iter_to_prop iter_ren in match Prop.prop_iter_current iter_ren with - | (Sil.Hpointsto(lexp, strexp, Sil.Sizeof (typ, len, st)), offlist) -> + | (Sil.Hpointsto(lexp, strexp, Exp.Sizeof (typ, len, st)), offlist) -> let contents, new_ptsto, pred_insts_op, lookup_uninitialized = ptsto_lookup pdesc tenv prop_ren (lexp, strexp, typ, len, st) offlist id in let update acc (pi, sigma) = - let pi' = Sil.Aeq (Sil.Var(id), contents):: pi in + let pi' = Sil.Aeq (Exp.Var(id), contents):: pi in let sigma' = new_ptsto:: sigma in let iter' = update_iter iter_ren pi' sigma' in let prop' = Prop.prop_iter_to_prop iter' in let prop'' = if lookup_uninitialized then - Prop.add_or_replace_attribute prop' (Apred (Adangling DAuninit, [Sil.Var id])) + Prop.add_or_replace_attribute prop' (Apred (Adangling DAuninit, [Exp.Var id])) else prop' in let prop''' = if Config.taint_analysis @@ -929,7 +929,7 @@ let execute_letderef ?(report_deref_errors=true) pname pdesc tenv id rhs_exp typ let n_rhs_exp' = Prop.exp_collapse_consecutive_indices_prop typ n_rhs_exp in match check_constant_string_dereference n_rhs_exp' with | Some value -> - [Prop.conjoin_eq (Sil.Var id) value prop] + [Prop.conjoin_eq (Exp.Var id) value prop] | None -> let exp_get_undef_attr exp = let fold_undef_pname callee_opt atom = @@ -954,7 +954,7 @@ let execute_letderef ?(report_deref_errors=true) pname pdesc tenv id rhs_exp typ if (Config.array_level = 0) then assert false else let undef = Sil.exp_get_undefined false in - [Prop.conjoin_eq (Sil.Var id) undef prop_] + [Prop.conjoin_eq (Exp.Var id) undef prop_] let load_ret_annots pname = match AttributesTable.load_attributes pname with @@ -968,7 +968,7 @@ let execute_set ?(report_deref_errors=true) pname pdesc tenv lhs_exp typ rhs_exp let execute_set_ pdesc tenv rhs_exp acc_in iter = let (lexp, strexp, typ, len, st, offlist) = match Prop.prop_iter_current iter with - | (Sil.Hpointsto(lexp, strexp, Sil.Sizeof (typ, len, st)), offlist) -> + | (Sil.Hpointsto(lexp, strexp, Exp.Sizeof (typ, len, st)), offlist) -> (lexp, strexp, typ, len, st, offlist) | _ -> assert false in let p = Prop.prop_iter_to_prop iter in @@ -1006,8 +1006,8 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path | Sil.Call (ret, exp, par, loc, call_flags) -> let exp' = Prop.exp_normalize_prop prop_ exp in let instr' = match exp' with - | Sil.Closure c -> - let proc_exp = Sil.Const (Const.Cfun c.name) in + | Exp.Closure c -> + let proc_exp = Exp.Const (Const.Cfun c.name) in let proc_exp' = Prop.exp_normalize_prop prop_ proc_exp in let par' = IList.map (fun (id_exp, _, typ) -> (id_exp, typ)) c.captured_vars in Sil.Call (ret, proc_exp', par' @ par, loc, call_flags) @@ -1058,7 +1058,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path | _ -> false in true_branch && not skip_loop in match Prop.exp_normalize_prop Prop.prop_emp cond with - | Sil.Const (Const.Cint i) when report_condition_always_true_false i -> + | Exp.Const (Const.Cint i) when report_condition_always_true_false i -> let node = State.get_node () in let desc = Errdesc.explain_condition_always_true_false i cond node loc in let exn = @@ -1071,12 +1071,12 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path check_condition_always_true_false (); let n_cond, prop = check_arith_norm_exp current_pname cond prop__ in ret_old_path (Propset.to_proplist (prune ~positive:true n_cond prop)) - | Sil.Call (ret_ids, Sil.Const (Const.Cfun callee_pname), args, loc, _) + | Sil.Call (ret_ids, Exp.Const (Const.Cfun callee_pname), args, loc, _) when Builtin.is_registered callee_pname -> let sym_exe_builtin = Builtin.get callee_pname in sym_exe_builtin (call_args prop_ callee_pname args ret_ids loc) | Sil.Call (ret_ids, - Sil.Const (Const.Cfun ((Procname.Java callee_pname_java) as callee_pname)), + Exp.Const (Const.Cfun ((Procname.Java callee_pname_java) as callee_pname)), actual_params, loc, call_flags) when Config.lazy_dynamic_dispatch -> let norm_prop, norm_args = normalize_params current_pname prop_ actual_params in @@ -1103,7 +1103,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path end | Sil.Call (ret_ids, - Sil.Const (Const.Cfun ((Procname.Java callee_pname_java) as callee_pname)), + Exp.Const (Const.Cfun ((Procname.Java callee_pname_java) as callee_pname)), actual_params, loc, call_flags) -> do_error_checks (Paths.Path.curr_node path) instr current_pname current_pdesc; let norm_prop, norm_args = normalize_params current_pname prop_ actual_params in @@ -1132,7 +1132,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path proc_call summary (call_args norm_prop pname url_handled_args ret_ids loc) in IList.fold_left (fun acc pname -> exec_one_pname pname @ acc) [] resolved_pnames - | Sil.Call (ret_ids, Sil.Const (Const.Cfun callee_pname), actual_params, loc, call_flags) -> + | Sil.Call (ret_ids, Exp.Const (Const.Cfun callee_pname), actual_params, loc, call_flags) -> (* Generic fun call with known name *) let (prop_r, n_actual_params) = normalize_params current_pname prop_ actual_params in let resolved_pname = @@ -1216,7 +1216,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path let eprop = Prop.expose prop_ in match IList.partition (function - | Sil.Hpointsto (Sil.Lvar pvar', _, _) -> Pvar.equal pvar pvar' + | Sil.Hpointsto (Exp.Lvar pvar', _, _) -> Pvar.equal pvar pvar' | _ -> false) (Prop.get_sigma eprop) with | [Sil.Hpointsto(e, se, typ)], sigma' -> let sigma'' = @@ -1245,7 +1245,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path ret_old_path [Prop.exist_quantify (Sil.fav_from_list temps) prop_] | Sil.Declare_locals (ptl, _) -> let sigma_locals = - let add_None (x, y) = (x, Sil.Sizeof (y, None, Subtype.exact), None) in + let add_None (x, y) = (x, Exp.Sizeof (y, None, Subtype.exact), None) in let sigma_locals () = IList.map (Prop.mk_ptsto_lvar (Some tenv) Prop.Fld_init Sil.inst_initial) @@ -1292,14 +1292,14 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call if Config.angelic_execution then let add_actual_by_ref_to_footprint prop (actual, actual_typ) = match actual with - | Sil.Lvar actual_pv -> + | Exp.Lvar actual_pv -> (* introduce a fresh program variable to allow abduction on the return value *) let abducted_ref_pv = Pvar.mk_abducted_ref_param callee_pname actual_pv callee_loc in let already_has_abducted_retval p = IList.exists (fun hpred -> match hpred with - | Sil.Hpointsto (Sil.Lvar pv, _, _) -> Pvar.equal pv abducted_ref_pv + | Sil.Hpointsto (Exp.Lvar pv, _, _) -> Pvar.equal pv abducted_ref_pv | _ -> false) (Prop.get_sigma_footprint p) in (* prevent introducing multiple abducted retvals for a single call site in a loop *) @@ -1343,7 +1343,7 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call IList.fold_left (fun p hpred -> match hpred with - | Sil.Hpointsto (Sil.Lvar pv, rhs, texp) when Pvar.equal pv abducted_ref_pv -> + | Sil.Hpointsto (Exp.Lvar pv, rhs, texp) when Pvar.equal pv abducted_ref_pv -> let new_hpred = Sil.Hpointsto (actual, rhs, texp) in Prop.normalize (Prop.replace_sigma (new_hpred :: (Prop.get_sigma prop')) p) | _ -> p) @@ -1355,8 +1355,8 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call (* non-angelic mode; havoc each var passed by reference by assigning it to a fresh id *) let havoc_actual_by_ref (actual, actual_typ) prop = let actual_pt_havocd_var = - let havocd_var = Sil.Var (Ident.create_fresh Ident.kprimed) in - let sizeof_exp = Sil.Sizeof (Typ.strip_ptr actual_typ, None, Subtype.subtypes) in + let havocd_var = Exp.Var (Ident.create_fresh Ident.kprimed) in + let sizeof_exp = Exp.Sizeof (Typ.strip_ptr actual_typ, None, Subtype.subtypes) in Prop.mk_ptsto actual (Sil.Eexp (havocd_var, Sil.Inone)) sizeof_exp in replace_actual_hpred actual actual_pt_havocd_var prop in IList.fold_left (fun p var -> havoc_actual_by_ref var p) prop actuals_by_ref @@ -1422,7 +1422,7 @@ and unknown_or_scan_call ~is_scan ret_type_option ret_annots let actuals_by_ref = IList.filter (function - | Sil.Lvar _, Typ.Tptr _ -> true + | Exp.Lvar _, Typ.Tptr _ -> true | _ -> false) args in let has_nullable_annot = Annotations.ia_is_nullable ret_annots in @@ -1435,7 +1435,7 @@ and unknown_or_scan_call ~is_scan ret_type_option ret_annots let pre_2 = match ret_ids, ret_type_option with | [ret_id], Some ret_typ -> add_constraints_on_retval - pdesc pre_1 (Sil.Var ret_id) ret_typ ~has_nullable_annot callee_pname loc + pdesc pre_1 (Exp.Var ret_id) ret_typ ~has_nullable_annot callee_pname loc | _ -> pre_1 in let pre_3 = add_constraints_on_actuals_by_ref tenv pre_2 actuals_by_ref callee_pname loc in @@ -1446,7 +1446,7 @@ and unknown_or_scan_call ~is_scan ret_type_option ret_annots else (* otherwise, add undefined attribute to retvals and actuals passed by ref *) let exps_to_mark = - let ret_exps = IList.map (fun ret_id -> Sil.Var ret_id) ret_ids in + let ret_exps = IList.map (fun ret_id -> Exp.Var ret_id) ret_ids in IList.fold_left (fun exps_to_mark (exp, _) -> exp :: exps_to_mark) ret_exps actuals_by_ref in let prop_with_undef_attr = @@ -1517,7 +1517,7 @@ and sym_exec_objc_getter field_name ret_typ tenv ret_ids pdesc pname loc args pr | Typ.Tstruct _ as s -> s | Typ.Tptr (t, _) -> Tenv.expand_type tenv t | _ -> assert false) in - let field_access_exp = Sil.Lfield (lexp, field_name, typ') in + let field_access_exp = Exp.Lfield (lexp, field_name, typ') in execute_letderef ~report_deref_errors:false pname pdesc tenv ret_id field_access_exp ret_typ loc prop | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -1531,7 +1531,7 @@ and sym_exec_objc_setter field_name _ tenv _ pdesc pname loc args prop = | Typ.Tstruct _ as s -> s | Typ.Tptr (t, _) -> Tenv.expand_type tenv t | _ -> assert false) in - let field_access_exp = Sil.Lfield (lexp1, field_name, typ1') in + let field_access_exp = Exp.Lfield (lexp1, field_name, typ1') in execute_set ~report_deref_errors:false pname pdesc tenv field_access_exp typ2 lexp2 loc prop | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -1623,7 +1623,7 @@ and sym_exec_wrapper handle_exn tenv pdesc instr ((prop: Prop.normal Prop.t), pa IList.map (fun id -> (id, Ident.create_fresh Ident.knormal)) ids_primed in let ren_sub = Sil.sub_of_list (IList.map - (fun (id1, id2) -> (id1, Sil.Var id2)) ids_primed_normal) in + (fun (id1, id2) -> (id1, Exp.Var id2)) ids_primed_normal) in let p' = Prop.normalize (Prop.prop_sub ren_sub p) in let fav_normal = Sil.fav_from_list (IList.map snd ids_primed_normal) in p', fav_normal in diff --git a/infer/src/backend/symExec.mli b/infer/src/backend/symExec.mli index dee9085bb..63f0ff19f 100644 --- a/infer/src/backend/symExec.mli +++ b/infer/src/backend/symExec.mli @@ -31,13 +31,13 @@ val unknown_or_scan_call : is_scan:bool -> Typ.t option -> Typ.item_annotation - val check_variadic_sentinel : ?fails_on_nil:bool -> int -> int * int -> Builtin.t val check_untainted : - Sil.exp -> Sil.taint_kind -> Procname.t -> Procname.t -> Prop.normal Prop.t -> Prop.normal Prop.t + Exp.t -> Sil.taint_kind -> Procname.t -> Procname.t -> Prop.normal Prop.t -> Prop.normal Prop.t (** Check for arithmetic problems and normalize an expression. *) val check_arith_norm_exp : - Procname.t -> Sil.exp -> Prop.normal Prop.t -> Sil.exp * Prop.normal Prop.t + Procname.t -> Exp.t -> Prop.normal Prop.t -> Exp.t * Prop.normal Prop.t -val prune : positive:bool -> Sil.exp -> Prop.normal Prop.t -> Propset.t +val prune : positive:bool -> Exp.t -> Prop.normal Prop.t -> Propset.t (** OO method resolution: given a class name and a method name, climb the class hierarchy to find the procname that the method name will actually resolve to at runtime. For example, if we have a diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index 75bfee619..83b3c1bd4 100644 --- a/infer/src/backend/tabulation.ml +++ b/infer/src/backend/tabulation.ml @@ -22,8 +22,8 @@ type splitting = { missing_sigma: Sil.hpred list; frame_fld : Sil.hpred list; missing_fld : Sil.hpred list; - frame_typ : (Sil.exp * Sil.exp) list; - missing_typ : (Sil.exp * Sil.exp) list; + frame_typ : (Exp.t * Exp.t) list; + missing_typ : (Exp.t * Exp.t) list; } type deref_error = @@ -93,8 +93,8 @@ let print_results actual_pre results = let spec_rename_vars pname spec = let prop_add_callee_suffix p = let f = function - | Sil.Lvar pv -> - Sil.Lvar (Pvar.to_callee pname pv) + | Exp.Lvar pv -> + Exp.Lvar (Pvar.to_callee pname pv) | e -> e in Prop.prop_expmap f p in let jprop_add_callee_suffix = function @@ -107,7 +107,7 @@ let spec_rename_vars pname spec = IList.iter (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, Sil.Var i')) ids') in + let ren_sub = Sil.sub_of_list (IList.map (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 pre'' = jprop_add_callee_suffix pre' in @@ -156,10 +156,10 @@ let process_splitting let sub = Sil.sub_join sub1 sub2 in let sub1_inverse = let sub1_list = Sil.sub_to_list sub1 in - let sub1_list' = IList.filter (function (_, Sil.Var _) -> true | _ -> false) sub1_list in + let sub1_list' = IList.filter (function (_, Exp.Var _) -> true | _ -> false) sub1_list in let sub1_inverse_list = IList.map - (function (id, Sil.Var id') -> (id', Sil.Var id) | _ -> assert false) + (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 = @@ -181,12 +181,12 @@ let process_splitting let fav_missing_fld = Prop.sigma_fav (Prop.sigma_sub sub missing_fld) in let map_var_to_pre_var_or_fresh id = - match Sil.exp_sub sub1_inverse (Sil.Var id) with - | Sil.Var id' -> + match Sil.exp_sub sub1_inverse (Exp.Var id) with + | Exp.Var id' -> if Sil.fav_mem fav_actual_pre id' || Ident.is_path id' (* a path id represents a position in the pre *) - then Sil.Var id' - else Sil.Var (Ident.create_fresh Ident.kprimed) + then Exp.Var id' + else Exp.Var (Ident.create_fresh Ident.kprimed) | _ -> assert false in let sub_list = Sil.sub_to_list sub in @@ -196,27 +196,27 @@ let process_splitting Sil.fav_to_list fav_sub in let sub1 = let f id = - if Sil.fav_mem fav_actual_pre id then (id, Sil.Var id) + if Sil.fav_mem fav_actual_pre id then (id, Exp.Var id) else if Ident.is_normal id then (id, map_var_to_pre_var_or_fresh id) - else if Sil.fav_mem fav_missing_fld id then (id, Sil.Var id) - else if Ident.is_footprint id then (id, Sil.Var id) + else if Sil.fav_mem fav_missing_fld id then (id, Exp.Var id) + else if Ident.is_footprint id then (id, Exp.Var id) else begin let dom1 = Sil.sub_domain sub1 in 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 -> Sil.Var id) (Sil.fav_to_list fav_actual_pre) in + let vars_actual_pre = IList.map (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 -> Sil.Var id) dom1); 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 "Ran(Sub1): "; Sil.d_exp_list rng1; L.d_ln (); - L.d_str "Dom(Sub2): "; Sil.d_exp_list (IList.map (fun id -> Sil.Var id) dom2); 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 "Ran(Sub2): "; Sil.d_exp_list rng2; L.d_ln (); - L.d_str "Don't know about id: "; Sil.d_exp (Sil.Var id); 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 let sub2_list = - let f id = (id, Sil.Var (Ident.create_fresh Ident.kfootprint)) + let f id = (id, Exp.Var (Ident.create_fresh Ident.kfootprint)) in IList.map 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 @@ -238,8 +238,8 @@ let process_splitting false end else match hpred with - | Sil.Hpointsto(Sil.Var _, _, _) -> true - | Sil.Hpointsto(Sil.Lvar pvar, _, _) -> Pvar.is_global pvar + | Sil.Hpointsto(Exp.Var _, _, _) -> true + | Sil.Hpointsto(Exp.Lvar pvar, _, _) -> Pvar.is_global pvar | _ -> L.d_warning "Missing fields in complex pred: "; Sil.d_hpred hpred; L.d_ln (); false in @@ -472,8 +472,8 @@ let texp_star texp1 texp2 = if ftal_sub instance_fields1 instance_fields2 then t2 else t1 | _ -> t1 in match texp1, texp2 with - | Sil.Sizeof (t1, len1, st1), Sil.Sizeof (t2, _, st2) -> - Sil.Sizeof (typ_star t1 t2, len1, Subtype.join st1 st2) + | Exp.Sizeof (t1, len1, st1), Exp.Sizeof (t2, _, st2) -> + Exp.Sizeof (typ_star t1 t2, len1, Subtype.join st1 st2) | _ -> texp1 @@ -520,7 +520,7 @@ let hpred_star_typing (hpred1 : Sil.hpred) (_, te2) : Sil.hpred = (** Implementation of [*] between predicates and typings *) let sigma_star_typ - (sigma1 : Sil.hpred list) (typings2 : (Sil.exp * Sil.exp) list) : Sil.hpred list = + (sigma1 : Sil.hpred list) (typings2 : (Exp.t * Exp.t) list) : Sil.hpred list = let typing_lhs_compare (e1, _) (e2, _) = Sil.exp_compare e1 e2 in let sigma1 = IList.stable_sort hpred_lhs_compare sigma1 in let typings2 = IList.stable_sort typing_lhs_compare typings2 in @@ -611,12 +611,12 @@ let prop_copy_footprint_pure p1 p2 = (** check if an expression is an exception *) let exp_is_exn = function - | Sil.Exn _ -> true + | Exp.Exn _ -> true | _ -> false (** check if a prop is an exception *) let prop_is_exn pname prop = - let ret_pvar = Sil.Lvar (Pvar.get_ret_pvar pname) in + let ret_pvar = Exp.Lvar (Pvar.get_ret_pvar pname) in let is_exn = function | Sil.Hpointsto (e1, Sil.Eexp(e2, _), _) when Sil.exp_equal e1 ret_pvar -> exp_is_exn e2 @@ -625,16 +625,16 @@ let prop_is_exn pname prop = (** when prop is an exception, return the exception name *) let prop_get_exn_name pname prop = - let ret_pvar = Sil.Lvar (Pvar.get_ret_pvar pname) in + let ret_pvar = Exp.Lvar (Pvar.get_ret_pvar pname) in let rec search_exn e = function | [] -> None - | Sil.Hpointsto (e1, _, Sil.Sizeof (Typ.Tstruct { Typ.struct_name = Some name }, _, _)) :: _ + | Sil.Hpointsto (e1, _, Exp.Sizeof (Typ.Tstruct { Typ.struct_name = Some name }, _, _)) :: _ when Sil.exp_equal e1 e -> Some (Typename.TN_csu (Csu.Class Csu.Java, name)) | _ :: tl -> search_exn e tl in let rec find_exn_name hpreds = function | [] -> None - | Sil.Hpointsto (e1, Sil.Eexp (Sil.Exn e2, _), _) :: _ + | Sil.Hpointsto (e1, Sil.Eexp (Exp.Exn e2, _), _) :: _ when Sil.exp_equal e1 ret_pvar -> search_exn e2 hpreds | _ :: tl -> find_exn_name hpreds tl in @@ -646,14 +646,14 @@ let prop_get_exn_name pname prop = let lookup_custom_errors prop = let rec search_error = function | [] -> None - | Sil.Hpointsto (Sil.Lvar var, Sil.Eexp (Sil.Const (Const.Cstr error_str), _), _) :: _ + | Sil.Hpointsto (Exp.Lvar var, Sil.Eexp (Exp.Const (Const.Cstr error_str), _), _) :: _ when Pvar.equal var Sil.custom_error -> Some error_str | _ :: tl -> search_error tl in search_error (Prop.get_sigma prop) (** set a prop to an exception sexp *) let prop_set_exn pname prop se_exn = - let ret_pvar = Sil.Lvar (Pvar.get_ret_pvar pname) in + let ret_pvar = Exp.Lvar (Pvar.get_ret_pvar pname) in let map_hpred = function | Sil.Hpointsto (e, _, t) when Sil.exp_equal e ret_pvar -> Sil.Hpointsto(e, se_exn, t) @@ -720,12 +720,12 @@ let combine let handle_null_case_analysis sigma = let id_assigned_to_null id = let filter = function - | Sil.Aeq (Sil.Var id', Sil.Const (Const.Cint i)) -> + | Sil.Aeq (Exp.Var id', Exp.Const (Const.Cint i)) -> Ident.equal id id' && IntLit.isnull i | _ -> false in IList.exists filter split.missing_pi in let f (e, inst_opt) = match e, inst_opt with - | Sil.Var id, Some inst when id_assigned_to_null id -> + | Exp.Var id, Some inst when id_assigned_to_null id -> let inst' = Sil.inst_set_null_case_flag inst in (e, Some inst') | _ -> (e, inst_opt) in @@ -739,7 +739,7 @@ let combine let post_p3 = (* replace [result|callee] with an aux variable dedicated to this proc *) let callee_ret_pvar = - Sil.Lvar (Pvar.to_callee callee_pname (Pvar.get_ret_pvar callee_pname)) in + Exp.Lvar (Pvar.to_callee callee_pname (Pvar.get_ret_pvar callee_pname)) in match Prop.prop_iter_create post_p2 with | None -> post_p2 | Some iter -> @@ -756,13 +756,13 @@ let combine prop_set_exn caller_pname p (Sil.Eexp (e', inst)) | Sil.Hpointsto (_, Sil.Eexp (e', _), _) when IList.length ret_ids = 1 -> let p = Prop.prop_iter_remove_curr_then_to_prop iter' in - Prop.conjoin_eq e' (Sil.Var (IList.hd ret_ids)) p + Prop.conjoin_eq e' (Exp.Var (IList.hd ret_ids)) p | Sil.Hpointsto (_, Sil.Estruct (ftl, _), _) when IList.length ftl = IList.length ret_ids -> let rec do_ftl_ids p = function | [], [] -> p | (_, Sil.Eexp (e', _)):: ftl', ret_id:: ret_ids' -> - let p' = Prop.conjoin_eq e' (Sil.Var ret_id) p in + let p' = Prop.conjoin_eq e' (Exp.Var ret_id) p in do_ftl_ids p' (ftl', ret_ids') | _ -> p in let p = Prop.prop_iter_remove_curr_then_to_prop iter' in @@ -866,9 +866,9 @@ let mk_actual_precondition prop actual_params formal_params = comb formal_params actual_params in let mk_instantiation (formal_var, (actual_e, actual_t)) = Prop.mk_ptsto - (Sil.Lvar formal_var) + (Exp.Lvar formal_var) (Sil.Eexp (actual_e, Sil.inst_actual_precondition)) - (Sil.Sizeof (actual_t, None, Subtype.exact)) in + (Exp.Sizeof (actual_t, None, Subtype.exact)) in let instantiated_formals = IList.map mk_instantiation formals_actuals in let actual_pre = Prop.prop_sigma_star prop instantiated_formals in Prop.normalize actual_pre @@ -892,7 +892,7 @@ let mk_posts ret_ids prop callee_pname callee_attrs posts = let returns_null prop = IList.exists (function - | Sil.Hpointsto (Sil.Lvar pvar, Sil.Eexp (e, _), _) when Pvar.is_return pvar -> + | Sil.Hpointsto (Exp.Lvar pvar, Sil.Eexp (e, _), _) when Pvar.is_return pvar -> Prover.check_equal (Prop.normalize prop) e Sil.exp_zero | _ -> false) (Prop.get_sigma prop) in @@ -905,7 +905,7 @@ let mk_posts ret_ids prop callee_pname callee_attrs posts = let prop_normal = Prop.normalize prop in let prop' = Prop.add_or_replace_attribute prop_normal - (Apred (Ataint { taint_source = callee_pname; taint_kind; }, [Sil.Var ret_id])) + (Apred (Ataint { taint_source = callee_pname; taint_kind; }, [Exp.Var ret_id])) |> Prop.expose in (prop', path) in IList.map taint_retval posts @@ -1091,7 +1091,7 @@ let exe_spec let remove_constant_string_class prop = let filter = function - | Sil.Hpointsto (Sil.Const (Const.Cstr _ | Const.Cclass _), _, _) -> false + | Sil.Hpointsto (Exp.Const (Const.Cstr _ | Const.Cclass _), _, _) -> false | _ -> true in let sigma = IList.filter filter (Prop.get_sigma prop) in let sigmafp = IList.filter filter (Prop.get_sigma_footprint prop) in @@ -1259,7 +1259,7 @@ let exe_call_postprocess ret_ids trace_call callee_pname callee_attrs loc result match ret_ids with | [ret_id] when should_add_ret_attr ()-> (* add attribute to remember what function call a return id came from *) - let ret_var = Sil.Var ret_id in + let ret_var = Exp.Var ret_id in let mark_id_as_retval (p, path) = let att_retval = Sil.Aretval (callee_pname, ret_annot) in Prop.set_attribute p att_retval [ret_var], path in @@ -1310,9 +1310,9 @@ let check_splitting_precondition sub1 sub2 = let rng2 = Sil.sub_range sub2 in let overlap = IList.exists (fun id -> IList.exists (Ident.equal id) dom1) dom2 in if overlap then begin - L.d_str "Dom(Sub1): "; Sil.d_exp_list (IList.map (fun id -> Sil.Var id) dom1); 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 "Ran(Sub1): "; Sil.d_exp_list rng1; L.d_ln (); - L.d_str "Dom(Sub2): "; Sil.d_exp_list (IList.map (fun id -> Sil.Var id) dom2); 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 "Ran(Sub2): "; Sil.d_exp_list rng2; L.d_ln (); assert false end diff --git a/infer/src/backend/tabulation.mli b/infer/src/backend/tabulation.mli index 14c67851d..f86a8c309 100644 --- a/infer/src/backend/tabulation.mli +++ b/infer/src/backend/tabulation.mli @@ -28,7 +28,7 @@ val find_dereference_without_null_check_in_sexp : Sil.strexp -> (int * Sil.path_ (** raise a cast exception *) val raise_cast_exception : - Logging.ml_loc -> Procname.t option -> Sil.exp -> Sil.exp -> Sil.exp -> 'a + Logging.ml_loc -> Procname.t option -> Exp.t -> Exp.t -> Exp.t -> 'a (** check if a prop is an exception *) val prop_is_exn : Procname.t -> 'a Prop.t -> bool @@ -45,5 +45,5 @@ val d_splitting : splitting -> unit (** Execute the function call and return the list of results with return value *) val exe_function_call: ProcAttributes.t -> Tenv.t -> Ident.t list -> Cfg.Procdesc.t -> Procname.t -> Location.t -> - (Sil.exp * Typ.t) list -> Prop.normal Prop.t -> Paths.Path.t -> + (Exp.t * Typ.t) list -> Prop.normal Prop.t -> Paths.Path.t -> (Prop.normal Prop.t * Paths.Path.t) list diff --git a/infer/src/backend/taint.ml b/infer/src/backend/taint.ml index b5cbc2776..e3152ed38 100644 --- a/infer/src/backend/taint.ml +++ b/infer/src/backend/taint.ml @@ -375,7 +375,7 @@ let add_tainting_attribute att pvar_param prop = IList.fold_left (fun prop_acc hpred -> match hpred with - | Sil.Hpointsto (Sil.Lvar pvar, (Sil.Eexp (rhs, _)), _) + | Sil.Hpointsto (Exp.Lvar pvar, (Sil.Eexp (rhs, _)), _) when Pvar.equal pvar pvar_param -> L.d_strln ("TAINT ANALYSIS: setting taint/untaint attribute of parameter " ^ (Pvar.to_string pvar)); diff --git a/infer/src/checkers/accessPath.ml b/infer/src/checkers/accessPath.ml index e0c6a55a0..7fc69816b 100644 --- a/infer/src/checkers/accessPath.ml +++ b/infer/src/checkers/accessPath.ml @@ -83,18 +83,18 @@ let of_exp exp typ ~(f_resolve_id : Ident.t -> raw option) = (* [typ] is the type of the last element of the access path (e.g., typeof(g) for x.f.g) *) let rec of_exp_ exp typ accesses = match exp with - | Sil.Var id -> + | Exp.Var id -> begin match f_resolve_id id with | Some (base, base_accesses) -> Some (base, base_accesses @ accesses) | None -> Some (base_of_id id typ, accesses) end - | Sil.Lvar pvar -> + | Exp.Lvar pvar -> Some (base_of_pvar pvar typ, accesses) - | Sil.Lfield (root_exp, fld, root_exp_typ) -> + | Exp.Lfield (root_exp, fld, root_exp_typ) -> let field_access = FieldAccess (fld, typ) in of_exp_ root_exp root_exp_typ (field_access :: accesses) - | Sil.Lindex (root_exp, _) -> + | Exp.Lindex (root_exp, _) -> let array_access = ArrayAccess typ in let array_typ = Typ.Tarray (typ, None) in of_exp_ root_exp array_typ (array_access :: accesses) diff --git a/infer/src/checkers/accessPath.mli b/infer/src/checkers/accessPath.mli index 1cb14eef5..e0ffbf840 100644 --- a/infer/src/checkers/accessPath.mli +++ b/infer/src/checkers/accessPath.mli @@ -48,7 +48,7 @@ val of_pvar : Pvar.t -> Typ.t -> raw val of_id : Ident.t -> Typ.t -> raw (** convert [exp] to a raw access path, resolving identifiers using [f_resolve_id] *) -val of_exp : Sil.exp -> Typ.t -> f_resolve_id:(Ident.t -> raw option) -> raw option +val of_exp : Exp.t -> Typ.t -> f_resolve_id:(Ident.t -> raw option) -> raw option (** append a new access to an existing access path; e.g., `append_access g x.f` produces `x.f.g` *) val append : raw -> access -> raw diff --git a/infer/src/checkers/addressTaken.ml b/infer/src/checkers/addressTaken.ml index 86a1f45d8..6fb700461 100644 --- a/infer/src/checkers/addressTaken.ml +++ b/infer/src/checkers/addressTaken.ml @@ -23,17 +23,17 @@ module TransferFunctions (CFG : ProcCfg.S) = struct type extras = ProcData.no_extras let rec add_address_taken_pvars exp astate = match exp with - | Sil.Lvar pvar -> + | Exp.Lvar pvar -> Domain.add pvar astate - | Sil.Cast (_, e) | UnOp (_, e, _) | Lfield (e, _, _) -> + | Exp.Cast (_, e) | UnOp (_, e, _) | Lfield (e, _, _) -> add_address_taken_pvars e astate - | Sil.BinOp (_, e1, e2) | Lindex (e1, e2) -> + | Exp.BinOp (_, e1, e2) | Lindex (e1, e2) -> add_address_taken_pvars e1 astate |> add_address_taken_pvars e2 - | Sil.Exn _ - | Sil.Closure _ - | Sil.Const (Cint _ | Cfun _ | Cstr _ | Cfloat _ | Cclass _ | Cptr_to_fld _) - | Sil.Var _ | Sil.Sizeof _ -> + | Exp.Exn _ + | Exp.Closure _ + | Exp.Const (Cint _ | Cfun _ | Cstr _ | Cfloat _ | Cclass _ | Cptr_to_fld _) + | Exp.Var _ | Exp.Sizeof _ -> astate let exec_instr astate _ _ = function diff --git a/infer/src/checkers/annotationReachability.ml b/infer/src/checkers/annotationReachability.ml index 44ea952aa..16f368824 100644 --- a/infer/src/checkers/annotationReachability.ml +++ b/infer/src/checkers/annotationReachability.ml @@ -287,15 +287,15 @@ module TransferFunctions (CFG : ProcCfg.S) = struct | _ -> false let is_tracking_exp astate = function - | Sil.Var id -> Domain.is_tracked_var (Var.of_id id) astate - | Sil.Lvar pvar -> Domain.is_tracked_var (Var.of_pvar pvar) astate + | Exp.Var id -> Domain.is_tracked_var (Var.of_id id) astate + | Exp.Lvar pvar -> Domain.is_tracked_var (Var.of_pvar pvar) astate | _ -> false let prunes_tracking_var astate = function - | Sil.BinOp (Binop.Eq, lhs, rhs) + | Exp.BinOp (Binop.Eq, lhs, rhs) when is_tracking_exp astate lhs -> Sil.exp_equal rhs Sil.exp_one - | Sil.UnOp (Unop.LNot, Sil.BinOp (Binop.Eq, lhs, rhs), _) + | Exp.UnOp (Unop.LNot, Exp.BinOp (Binop.Eq, lhs, rhs), _) when is_tracking_exp astate lhs -> Sil.exp_equal rhs Sil.exp_zero | _ -> @@ -349,10 +349,10 @@ module TransferFunctions (CFG : ProcCfg.S) = struct | Sil.Letderef (id, exp, _, _) when is_tracking_exp astate exp -> Domain.add_tracking_var (Var.of_id id) astate - | Sil.Set (Sil.Lvar pvar, _, exp, _) + | Sil.Set (Exp.Lvar pvar, _, exp, _) when is_tracking_exp astate exp -> Domain.add_tracking_var (Var.of_pvar pvar) astate - | Sil.Set (Sil.Lvar pvar, _, _, _) -> + | Sil.Set (Exp.Lvar pvar, _, _, _) -> Domain.remove_tracking_var (Var.of_pvar pvar) astate | Sil.Prune (exp, _, _, _) when prunes_tracking_var astate exp -> diff --git a/infer/src/checkers/checkTraceCallSequence.ml b/infer/src/checkers/checkTraceCallSequence.ml index 1d3b2b33e..d32496b45 100644 --- a/infer/src/checkers/checkTraceCallSequence.ml +++ b/infer/src/checkers/checkTraceCallSequence.ml @@ -210,7 +210,7 @@ module Automaton = struct (** Transfer function for an instruction. *) let do_instr pn pd (instr : Sil.instr) (state : State.t) : State.t = match instr with - | Sil.Call (_, Sil.Const (Const.Cfun callee_pn), _, loc, _) -> + | Sil.Call (_, Exp.Const (Const.Cfun callee_pn), _, loc, _) -> do_call pn pd callee_pn state loc | _ -> state @@ -232,7 +232,7 @@ module BooleanVars = struct (** Check if the expression exp is one of the listed boolean variables. *) let exp_boolean_var exp = match exp with - | Sil.Lvar pvar when Pvar.is_local pvar -> + | Exp.Lvar pvar when Pvar.is_local pvar -> let name = Mangled.to_string (Pvar.get_name pvar) in if IList.mem string_equal name boolean_variables then Some name @@ -244,10 +244,10 @@ module BooleanVars = struct (* Normalize a boolean condition. *) let normalize_condition cond_e = match cond_e with - | Sil.UnOp (Unop.LNot, Sil.BinOp (Binop.Eq, e1, e2), _) -> - Sil.BinOp (Binop.Ne, e1, e2) - | Sil.UnOp (Unop.LNot, Sil.BinOp (Binop.Ne, e1, e2), _) -> - Sil.BinOp (Binop.Eq, e1, e2) + | Exp.UnOp (Unop.LNot, Exp.BinOp (Binop.Eq, e1, e2), _) -> + Exp.BinOp (Binop.Ne, e1, e2) + | Exp.UnOp (Unop.LNot, Exp.BinOp (Binop.Ne, e1, e2), _) -> + Exp.BinOp (Binop.Eq, e1, e2) | _ -> cond_e in (* Normalize an instruction. *) @@ -258,7 +258,7 @@ module BooleanVars = struct | instr -> instr in match normalize_instr instr with - | Sil.Prune (Sil.BinOp (Binop.Eq, _cond_e, Sil.Const (Const.Cint i)), _, _, _) + | Sil.Prune (Exp.BinOp (Binop.Eq, _cond_e, Exp.Const (Const.Cint i)), _, _, _) when IntLit.iszero i -> let cond_e = Idenv.expand_expr idenv _cond_e in let state' = match exp_boolean_var cond_e with @@ -267,7 +267,7 @@ module BooleanVars = struct State.prune state name false | None -> state in state' - | Sil.Prune (Sil.BinOp (Binop.Ne, _cond_e, Sil.Const (Const.Cint i)), _, _, _) + | Sil.Prune (Exp.BinOp (Binop.Ne, _cond_e, Exp.Const (Const.Cint i)), _, _, _) when IntLit.iszero i -> let cond_e = Idenv.expand_expr idenv _cond_e in let state' = match exp_boolean_var cond_e with @@ -281,7 +281,7 @@ module BooleanVars = struct let state' = match exp_boolean_var e1 with | Some name -> let b_opt = match e2 with - | Sil.Const (Const.Cint i) -> Some (not (IntLit.iszero i)) + | Exp.Const (Const.Cint i) -> Some (not (IntLit.iszero i)) | _ -> None in if verbose then begin diff --git a/infer/src/checkers/checkers.ml b/infer/src/checkers/checkers.ml index d84403d63..3fe5ea04c 100644 --- a/infer/src/checkers/checkers.ml +++ b/infer/src/checkers/checkers.ml @@ -282,7 +282,7 @@ let callback_check_write_to_parcel_java check_match (r_call_descs, w_call_descs) in let do_instr _ instr = match instr with - | Sil.Call (_, Sil.Const (Const.Cfun _), (_this_exp, this_type):: _, _, _) -> + | Sil.Call (_, Exp.Const (Const.Cfun _), (_this_exp, this_type):: _, _, _) -> let this_exp = Idenv.expand_expr idenv _this_exp in if is_write_to_parcel this_exp this_type then begin if !verbose then @@ -327,7 +327,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } = IList.filter is_class_type formals in IList.map fst class_formals) in let equal_formal_param exp formal_name = match exp with - | Sil.Lvar pvar -> + | Exp.Lvar pvar -> let name = Pvar.get_name pvar in Mangled.equal name formal_name | _ -> false in @@ -373,7 +373,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } = end in let do_instr _ instr = match instr with - | Sil.Call (_, Sil.Const (Const.Cfun pn), (_arg1, _):: _, _, _) when is_nullcheck pn -> + | Sil.Call (_, Exp.Const (Const.Cfun pn), (_arg1, _):: _, _, _) when is_nullcheck pn -> let arg1 = Idenv.expand_expr idenv _arg1 in if is_formal_param arg1 then handle_check_of_formal arg1; if !verbose then @@ -427,24 +427,24 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p match get_proc_desc proc_name' with Some proc_desc' -> let is_return_instr = function - | Sil.Set (Sil.Lvar p, _, _, _) + | Sil.Set (Exp.Lvar p, _, _, _) when Pvar.equal p (Cfg.Procdesc.get_ret_var proc_desc') -> true | _ -> false in (match reverse_find_instr is_return_instr (Cfg.Procdesc.get_exit_node proc_desc') with - | Some (Sil.Set (_, _, Sil.Const (Const.Cclass n), _)) -> Ident.name_to_string n + | Some (Sil.Set (_, _, Exp.Const (Const.Cclass n), _)) -> Ident.name_to_string n | _ -> "<" ^ (Procname.to_string proc_name') ^ ">") | None -> "?" in let get_actual_arguments node instr = match instr with - | Sil.Call (_, Sil.Const (Const.Cfun _), _:: args, _, _) -> + | Sil.Call (_, Exp.Const (Const.Cfun _), _:: args, _, _) -> (try let find_const exp = let expanded = Idenv.expand_expr idenv exp in match expanded with - | Sil.Const (Const.Cclass n) -> Ident.name_to_string n - | Sil.Lvar _ -> ( + | Exp.Const (Const.Cclass n) -> Ident.name_to_string n + | Exp.Lvar _ -> ( let is_call_instr set call = match set, call with - | Sil.Set (_, _, Sil.Var (i1), _), Sil.Call (i2::[], _, _, _, _) + | Sil.Set (_, _, Exp.Var (i1), _), Sil.Call (i2::[], _, _, _, _) when Ident.equal i1 i2 -> true | _ -> false in let is_set_instr = function @@ -455,7 +455,7 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p | Some s -> ( match reverse_find_instr (is_call_instr s) node with (* Look for tmp := foo() *) - | Some (Sil.Call (_, Sil.Const (Const.Cfun pn), _, _, _)) -> + | Some (Sil.Call (_, Exp.Const (Const.Cfun pn), _, _, _)) -> get_return_const pn | _ -> "?") | _ -> "?") @@ -500,26 +500,26 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p (** Check field accesses. *) let callback_check_field_access { Callbacks.proc_desc } = let rec do_exp is_read = function - | Sil.Var _ -> () - | Sil.UnOp (_, e, _) -> + | Exp.Var _ -> () + | Exp.UnOp (_, e, _) -> do_exp is_read e - | Sil.BinOp (_, e1, e2) -> + | Exp.BinOp (_, e1, e2) -> do_exp is_read e1; do_exp is_read e2 - | Sil.Exn _ -> () - | Sil.Closure _ -> () - | Sil.Const _ -> () - | Sil.Cast (_, e) -> + | Exp.Exn _ -> () + | Exp.Closure _ -> () + | Exp.Const _ -> () + | Exp.Cast (_, e) -> do_exp is_read e - | Sil.Lvar _ -> () - | Sil.Lfield (e, fn, _) -> + | Exp.Lvar _ -> () + | Exp.Lfield (e, fn, _) -> if not (Ident.java_fieldname_is_outer_instance fn) then L.stdout "field %s %s@." (Ident.fieldname_to_string fn) (if is_read then "reading" else "writing"); do_exp is_read e - | Sil.Lindex (e1, e2) -> + | Exp.Lindex (e1, e2) -> do_exp is_read e1; do_exp is_read e2 - | Sil.Sizeof _ -> () in + | Exp.Sizeof _ -> () in let do_read_exp = do_exp true in let do_write_exp = do_exp false in let do_instr _ = function @@ -544,7 +544,7 @@ let callback_check_field_access { Callbacks.proc_desc } = (** Print c method calls. *) let callback_print_c_method_calls { Callbacks.proc_desc; proc_name } = let do_instr node = function - | Sil.Call (_, Sil.Const (Const.Cfun pn), (e, _):: _, loc, _) + | Sil.Call (_, Exp.Const (Const.Cfun pn), (e, _):: _, loc, _) when Procname.is_c_method pn -> let receiver = match Errdesc.exp_rv_dexp node e with | Some de -> DecompiledExp.to_string de @@ -557,7 +557,7 @@ let callback_print_c_method_calls { Callbacks.proc_desc; proc_name } = "CHECKERS_PRINT_OBJC_METHOD_CALLS" loc description - | Sil.Call (_, Sil.Const (Const.Cfun pn), _, loc, _) -> + | Sil.Call (_, Exp.Const (Const.Cfun pn), _, loc, _) -> let description = Printf.sprintf "call to %s" (Procname.to_string pn) in ST.report_error @@ -583,9 +583,9 @@ let callback_print_access_to_globals { Callbacks.proc_desc; proc_name } = loc description in let rec get_global_var = function - | Sil.Lvar pvar when Pvar.is_global pvar -> + | Exp.Lvar pvar when Pvar.is_global pvar -> Some pvar - | Sil.Lfield (e, _, _) -> + | Exp.Lfield (e, _, _) -> get_global_var e | _ -> None in diff --git a/infer/src/checkers/codeQuery.ml b/infer/src/checkers/codeQuery.ml index bc33714eb..505b98b67 100644 --- a/infer/src/checkers/codeQuery.ml +++ b/infer/src/checkers/codeQuery.ml @@ -69,7 +69,7 @@ end module Match = struct type value = | Vfun of Procname.t - | Vval of Sil.exp + | Vval of Exp.t let pp_value fmt = function | Vval e -> F.fprintf fmt "%a" (Sil.pp_exp pe_text) e @@ -123,14 +123,14 @@ module Match = struct | _ -> false let rec cond_match env idenv cond (ae1, op, ae2) = match cond with - | Sil.BinOp (bop, _e1, _e2) -> + | Exp.BinOp (bop, _e1, _e2) -> let e1 = Idenv.expand_expr idenv _e1 in let e2 = Idenv.expand_expr idenv _e2 in binop_match bop op && exp_match env ae1 (Vval e1) && exp_match env ae2 (Vval e2) - | Sil.UnOp (Unop.LNot, (Sil.BinOp (Binop.Eq, e1, e2)), _) -> - cond_match env idenv (Sil.BinOp (Binop.Ne, e1, e2)) (ae1, op, ae2) - | Sil.UnOp (Unop.LNot, (Sil.BinOp (Binop.Ne, e1, e2)), _) -> - cond_match env idenv (Sil.BinOp (Binop.Eq, e1, e2)) (ae1, op, ae2) + | Exp.UnOp (Unop.LNot, (Exp.BinOp (Binop.Eq, e1, e2)), _) -> + cond_match env idenv (Exp.BinOp (Binop.Ne, e1, e2)) (ae1, op, ae2) + | Exp.UnOp (Unop.LNot, (Exp.BinOp (Binop.Ne, e1, e2)), _) -> + cond_match env idenv (Exp.BinOp (Binop.Eq, e1, e2)) (ae1, op, ae2) | _ -> false (** Iterate over the instructions of the linearly succ nodes. *) @@ -161,7 +161,7 @@ module Match = struct let rec match_query show env idenv caller_pn (rule, action) proc_name node instr = match rule, instr with - | CodeQueryAst.Call (ae1, ae2), Sil.Call (_, Sil.Const (Const.Cfun pn), _, loc, _) -> + | CodeQueryAst.Call (ae1, ae2), Sil.Call (_, Exp.Const (Const.Cfun pn), _, loc, _) -> if exp_match env ae1 (Vfun caller_pn) && exp_match env ae2 (Vfun pn) then begin if show then print_action env action proc_name node loc; @@ -170,7 +170,7 @@ module Match = struct else false | CodeQueryAst.Call _, _ -> false | CodeQueryAst.MethodCall (ae1, ae2, ael_opt), - Sil.Call (_, Sil.Const (Const.Cfun pn), (_e1, _) :: params, + Sil.Call (_, Exp.Const (Const.Cfun pn), (_e1, _) :: params, loc, { CallFlags.cf_virtual = true }) -> let e1 = Idenv.expand_expr idenv _e1 in let vl = IList.map (function _e, _ -> Vval (Idenv.expand_expr idenv _e)) params in diff --git a/infer/src/checkers/constantPropagation.ml b/infer/src/checkers/constantPropagation.ml index 3fa6bb212..d586b89f4 100644 --- a/infer/src/checkers/constantPropagation.ml +++ b/infer/src/checkers/constantPropagation.ml @@ -69,33 +69,33 @@ module ConstantFlow = Dataflow.MakeDF(struct false in match instr with - | Sil.Letderef (i, Sil.Lvar p, _, _) -> (* tmp = var *) - update (Sil.Var i) (ConstantMap.find (Sil.Lvar p) constants) constants + | Sil.Letderef (i, Exp.Lvar p, _, _) -> (* tmp = var *) + update (Exp.Var i) (ConstantMap.find (Exp.Lvar p) constants) constants - | Sil.Set (Sil.Lvar p, _, Sil.Const c, _) -> (* var = const *) - update (Sil.Lvar p) (Some c) constants + | Sil.Set (Exp.Lvar p, _, Exp.Const c, _) -> (* var = const *) + update (Exp.Lvar p) (Some c) constants - | Sil.Set (Sil.Lvar p, _, Sil.Var i, _) -> (* var = tmp *) - update (Sil.Lvar p) (ConstantMap.find (Sil.Var i) constants) constants + | Sil.Set (Exp.Lvar p, _, Exp.Var i, _) -> (* var = tmp *) + update (Exp.Lvar p) (ConstantMap.find (Exp.Var i) constants) constants (* Handle propagation of string with StringBuilder. Does not handle null case *) - | Sil.Call (_, Sil.Const (Const.Cfun pn), (Sil.Var sb, _):: [], _, _) + | Sil.Call (_, Exp.Const (Const.Cfun pn), (Exp.Var sb, _):: [], _, _) when has_class pn "java.lang.StringBuilder" && has_method pn "" -> (* StringBuilder. *) - update (Sil.Var sb) (Some (Const.Cstr "")) constants + update (Exp.Var sb) (Some (Const.Cstr "")) constants - | Sil.Call (i:: [], Sil.Const (Const.Cfun pn), (Sil.Var i1, _):: [], _, _) + | Sil.Call (i:: [], Exp.Const (Const.Cfun pn), (Exp.Var i1, _):: [], _, _) when has_class pn "java.lang.StringBuilder" && has_method pn "toString" -> (* StringBuilder.toString *) - update (Sil.Var i) (ConstantMap.find (Sil.Var i1) constants) constants + update (Exp.Var i) (ConstantMap.find (Exp.Var i1) constants) constants | Sil.Call - (i:: [], Sil.Const (Const.Cfun pn), (Sil.Var i1, _):: (Sil.Var i2, _):: [], _, _) + (i:: [], Exp.Const (Const.Cfun pn), (Exp.Var i1, _):: (Exp.Var i2, _):: [], _, _) when has_class pn "java.lang.StringBuilder" && has_method pn "append" -> (* StringBuilder.append *) (match - ConstantMap.find (Sil.Var i1) constants, - ConstantMap.find (Sil.Var i2) constants with + ConstantMap.find (Exp.Var i1) constants, + ConstantMap.find (Exp.Var i2) constants with | Some (Const.Cstr s1), Some (Const.Cstr s2) -> begin let s = s1 ^ s2 in @@ -104,7 +104,7 @@ module ConstantFlow = Dataflow.MakeDF(struct Some (Const.Cstr s) else None in - update (Sil.Var i) u constants + update (Exp.Var i) u constants end | _ -> constants) @@ -136,7 +136,7 @@ let run tenv proc_desc = | ConstantFlow.Dead_state -> ConstantMap.empty in get_constants -type const_map = Cfg.Node.t -> Sil.exp -> Const.t option +type const_map = Cfg.Node.t -> Exp.t -> Const.t option (** Build a const map lazily. *) let build_const_map tenv pdesc = diff --git a/infer/src/checkers/constantPropagation.mli b/infer/src/checkers/constantPropagation.mli index 15cbed6c1..04cdb7348 100644 --- a/infer/src/checkers/constantPropagation.mli +++ b/infer/src/checkers/constantPropagation.mli @@ -9,7 +9,7 @@ open! Utils -type const_map = Cfg.Node.t -> Sil.exp -> Const.t option +type const_map = Cfg.Node.t -> Exp.t -> Const.t option (** Build a const map lazily. *) val build_const_map : Tenv.t -> Cfg.Procdesc.t -> const_map diff --git a/infer/src/checkers/copyPropagation.ml b/infer/src/checkers/copyPropagation.ml index 7d5d19540..8547f78dd 100644 --- a/infer/src/checkers/copyPropagation.ml +++ b/infer/src/checkers/copyPropagation.ml @@ -86,11 +86,11 @@ module TransferFunctions (CFG : ProcCfg.S) = struct type extras = ProcData.no_extras let exec_instr astate _ _ = function - | Sil.Letderef (lhs_id, Sil.Lvar rhs_pvar, _, _) when not (Pvar.is_global rhs_pvar) -> + | Sil.Letderef (lhs_id, Exp.Lvar rhs_pvar, _, _) when not (Pvar.is_global rhs_pvar) -> Domain.gen (Var.of_id lhs_id) (Var.of_pvar rhs_pvar) astate - | Sil.Set (Sil.Lvar lhs_pvar, _, Sil.Var rhs_id, _) when not (Pvar.is_global lhs_pvar) -> + | Sil.Set (Exp.Lvar lhs_pvar, _, Exp.Var rhs_id, _) when not (Pvar.is_global lhs_pvar) -> Domain.kill_then_gen (Var.of_pvar lhs_pvar) (Var.of_id rhs_id) astate - | Sil.Set (Sil.Lvar lhs_pvar, _, _, _) -> + | Sil.Set (Exp.Lvar lhs_pvar, _, _, _) -> (* non-copy assignment; can only kill *) Domain.kill_copies_with_var (Var.of_pvar lhs_pvar) astate | Sil.Letderef _ @@ -103,7 +103,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let kill_ret_ids astate_acc id = Domain.kill_copies_with_var (Var.of_id id) astate_acc in let kill_actuals_by_ref astate_acc = function - | (Sil.Lvar pvar, Typ.Tptr _) -> Domain.kill_copies_with_var (Var.of_pvar pvar) astate_acc + | (Exp.Lvar pvar, Typ.Tptr _) -> Domain.kill_copies_with_var (Var.of_pvar pvar) astate_acc | _ -> astate_acc in let astate' = IList.fold_left kill_ret_ids astate ret_ids in if !Config.curr_language = Config.Java diff --git a/infer/src/checkers/dataflow.ml b/infer/src/checkers/dataflow.ml index 5163a7de7..3d7510542 100644 --- a/infer/src/checkers/dataflow.ml +++ b/infer/src/checkers/dataflow.ml @@ -54,15 +54,15 @@ let node_throws node (proc_throws : Procname.t -> throws) : throws = let ret_pvar = Cfg.Procdesc.get_ret_var pdesc in Pvar.equal pvar ret_pvar in match instr with - | Sil.Set (Sil.Lvar pvar, _, Sil.Exn _, _) when is_return pvar -> + | Sil.Set (Exp.Lvar pvar, _, Exp.Exn _, _) when is_return pvar -> (* assignment to return variable is an artifact of a throw instruction *) Throws - | Sil.Call (_, Sil.Const (Const.Cfun callee_pn), _, _, _) + | Sil.Call (_, Exp.Const (Const.Cfun callee_pn), _, _, _) when Builtin.is_registered callee_pn -> if Procname.equal callee_pn ModelBuiltins.__cast then DontKnow else DoesNotThrow - | Sil.Call (_, Sil.Const (Const.Cfun callee_pn), _, _, _) -> + | Sil.Call (_, Exp.Const (Const.Cfun callee_pn), _, _, _) -> proc_throws callee_pn | _ -> DoesNotThrow in diff --git a/infer/src/checkers/idenv.ml b/infer/src/checkers/idenv.ml index 2c60cc0ca..2a62eab9c 100644 --- a/infer/src/checkers/idenv.ml +++ b/infer/src/checkers/idenv.ml @@ -13,7 +13,7 @@ open! Utils Lazy implementation: only created when actually used. *) -type t = (Sil.exp Ident.IdentHash.t) Lazy.t +type t = (Exp.t Ident.IdentHash.t) Lazy.t let create_ proc_desc = let map = Ident.IdentHash.create 1 in @@ -41,7 +41,7 @@ let lookup map_ id = with Not_found -> None let expand_expr idenv e = match e with - | Sil.Var id -> + | Exp.Var id -> (match lookup idenv id with | Some e' -> e' | None -> e) @@ -50,16 +50,16 @@ let expand_expr idenv e = match e with let expand_expr_temps idenv node _exp = let exp = expand_expr idenv _exp in match exp with - | Sil.Lvar pvar when Pvar.is_frontend_tmp pvar -> + | Exp.Lvar pvar when Pvar.is_frontend_tmp pvar -> (match Errdesc.find_program_variable_assignment node pvar with | None -> exp | Some (_, id) -> - expand_expr idenv (Sil.Var id)) + expand_expr idenv (Exp.Var id)) | _ -> exp (** Return true if the expression is a temporary variable introduced by the front-end. *) let exp_is_temp idenv e = match expand_expr idenv e with - | Sil.Lvar pvar -> + | Exp.Lvar pvar -> Pvar.is_frontend_tmp pvar | _ -> false diff --git a/infer/src/checkers/idenv.mli b/infer/src/checkers/idenv.mli index c168db5c1..55ee9f41d 100644 --- a/infer/src/checkers/idenv.mli +++ b/infer/src/checkers/idenv.mli @@ -17,10 +17,10 @@ type t val create : Cfg.Procdesc.t -> t val create_from_idenv : t -> Cfg.Procdesc.t -> t -val lookup : t -> Ident.t -> Sil.exp option -val expand_expr : t -> Sil.exp -> Sil.exp +val lookup : t -> Ident.t -> Exp.t option +val expand_expr : t -> Exp.t -> Exp.t -val exp_is_temp : t -> Sil.exp -> bool +val exp_is_temp : t -> Exp.t -> bool (** Stronger version of expand_expr which also expands a temporary variable. *) -val expand_expr_temps : t -> Cfg.Node.t -> Sil.exp -> Sil.exp +val expand_expr_temps : t -> Cfg.Node.t -> Exp.t -> Exp.t diff --git a/infer/src/checkers/patternMatch.ml b/infer/src/checkers/patternMatch.ml index 8ed8dc411..784bc2d86 100644 --- a/infer/src/checkers/patternMatch.ml +++ b/infer/src/checkers/patternMatch.ml @@ -178,8 +178,8 @@ let get_vararg_type_names (* Is this the node creating ivar? *) let rec initializes_array instrs = match instrs with - | Sil.Call ([t1], Sil.Const (Const.Cfun pn), _, _, _):: - Sil.Set (Sil.Lvar iv, _, Sil.Var t2, _):: is -> + | Sil.Call ([t1], Exp.Const (Const.Cfun pn), _, _, _):: + Sil.Set (Exp.Lvar iv, _, Exp.Var t2, _):: is -> (Pvar.equal ivar iv && Ident.equal t1 t2 && Procname.equal pn (Procname.from_string_c_fun "__new_array")) || initializes_array is @@ -190,7 +190,7 @@ let get_vararg_type_names let added_type_name node = let rec nvar_type_name nvar instrs = match instrs with - | Sil.Letderef (nv, Sil.Lfield (_, id, t), _, _):: _ + | Sil.Letderef (nv, Exp.Lfield (_, id, t), _, _):: _ when Ident.equal nv nvar -> get_field_type_name t id | Sil.Letderef (nv, _, t, _):: _ when Ident.equal nv nvar -> @@ -199,15 +199,15 @@ let get_vararg_type_names | _ -> None in let rec added_nvar array_nvar instrs = match instrs with - | Sil.Set (Sil.Lindex (Sil.Var iv, _), _, Sil.Var nvar, _):: _ + | Sil.Set (Exp.Lindex (Exp.Var iv, _), _, Exp.Var nvar, _):: _ when Ident.equal iv array_nvar -> nvar_type_name nvar (Cfg.Node.get_instrs node) - | Sil.Set (Sil.Lindex (Sil.Var iv, _), _, Sil.Const c, _):: _ + | Sil.Set (Exp.Lindex (Exp.Var iv, _), _, Exp.Const c, _):: _ when Ident.equal iv array_nvar -> Some (java_get_const_type_name c) | _:: is -> added_nvar array_nvar is | _ -> None in let rec array_nvar instrs = match instrs with - | Sil.Letderef (nv, Sil.Lvar iv, _, _):: _ + | Sil.Letderef (nv, Exp.Lvar iv, _, _):: _ when Pvar.equal iv ivar -> added_nvar nv instrs | _:: is -> array_nvar is @@ -245,14 +245,14 @@ let is_setter pname_java = (** Returns the signature of a field access (class name, field name, field type name) *) let get_java_field_access_signature = function - | Sil.Letderef (_, Sil.Lfield (_, fn, ft), bt, _) -> + | Sil.Letderef (_, Exp.Lfield (_, fn, ft), bt, _) -> Some (get_type_name bt, Ident.java_fieldname_get_field fn, get_type_name ft) | _ -> None (** Returns the formal signature (class name, method name, argument type names and return type name) *) let get_java_method_call_formal_signature = function - | Sil.Call (_, Sil.Const (Const.Cfun pn), (_, tt):: args, _, _) -> + | 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 @@ -317,8 +317,8 @@ let method_is_initializer let java_get_vararg_values node pvar idenv = let values = ref [] in let do_instr = function - | Sil.Set (Sil.Lindex (array_exp, _), _, content_exp, _) - when Sil.exp_equal (Sil.Lvar pvar) (Idenv.expand_expr idenv array_exp) -> + | Sil.Set (Exp.Lindex (array_exp, _), _, content_exp, _) + when Sil.exp_equal (Exp.Lvar pvar) (Idenv.expand_expr idenv array_exp) -> (* Each vararg argument is an assigment to a pvar denoting an array of objects. *) values := content_exp :: !values | _ -> () in @@ -333,7 +333,7 @@ let java_get_vararg_values node pvar idenv = let proc_calls resolve_attributes pdesc filter : (Procname.t * ProcAttributes.t) list = let res = ref [] in let do_instruction _ instr = match instr with - | Sil.Call (_, Sil.Const (Const.Cfun callee_pn), _, _, _) -> + | Sil.Call (_, Exp.Const (Const.Cfun callee_pn), _, _, _) -> begin match resolve_attributes callee_pn with | Some callee_attributes -> @@ -387,7 +387,7 @@ let proc_iter_overridden_methods f tenv proc_name = let get_fields_nullified procdesc = (* walk through the instructions and look for instance fields that are assigned to null *) let collect_nullified_flds (nullified_flds, this_ids) _ = function - | Sil.Set (Sil.Lfield (Sil.Var lhs, fld, _), _, rhs, _) + | Sil.Set (Exp.Lfield (Exp.Var lhs, fld, _), _, rhs, _) when Sil.exp_is_null_literal rhs && Ident.IdentSet.mem lhs this_ids -> (Ident.FieldSet.add fld nullified_flds, this_ids) | Sil.Letderef (id, rhs, _, _) when Sil.exp_is_this rhs -> diff --git a/infer/src/checkers/patternMatch.mli b/infer/src/checkers/patternMatch.mli index d3155e9c8..4a6ed3879 100644 --- a/infer/src/checkers/patternMatch.mli +++ b/infer/src/checkers/patternMatch.mli @@ -69,7 +69,7 @@ val strict_supertype_exists : Tenv.t -> (Typ.struct_typ -> bool) -> Typ.struct_t val java_get_const_type_name : Const.t -> string (** Get the values of a vararg parameter given the pvar used to assign the elements. *) -val java_get_vararg_values : Cfg.Node.t -> Pvar.t -> Idenv.t -> Sil.exp list +val java_get_vararg_values : Cfg.Node.t -> Pvar.t -> Idenv.t -> Exp.t list val java_proc_name_with_class_method : Procname.java -> string -> string -> bool diff --git a/infer/src/checkers/printfArgs.ml b/infer/src/checkers/printfArgs.ml index 592327f4b..5e28ef0f9 100644 --- a/infer/src/checkers/printfArgs.ml +++ b/infer/src/checkers/printfArgs.ml @@ -85,10 +85,10 @@ let format_type_matches_given_type (* The format string and the nvar for the fixed arguments and the nvar of the varargs array *) let format_arguments (printf: printf_signature) - (args: (Sil.exp * Typ.t) list): (string option * (Sil.exp list) * (Sil.exp option)) = + (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 - | Sil.Const (Const.Cstr fmt), _ -> Some fmt + | Exp.Const (Const.Cstr fmt), _ -> Some fmt | _ -> None in let fixed_nvars = IList.map @@ -158,24 +158,24 @@ let check_printf_args_ok (* Get the array ivar for a given nvar *) let rec array_ivar instrs nvar = match instrs, nvar with - | Sil.Letderef (id, Sil.Lvar iv, _, _):: _, Sil.Var nid + | Sil.Letderef (id, Exp.Lvar iv, _, _):: _, Exp.Var nid when Ident.equal id nid -> iv | _:: is, _ -> array_ivar is nvar | _ -> raise Not_found in let rec fixed_nvar_type_name instrs nvar = match nvar with - | Sil.Var nid -> ( + | Exp.Var nid -> ( match instrs with - | Sil.Letderef (id, Sil.Lvar _, t, _):: _ + | Sil.Letderef (id, Exp.Lvar _, t, _):: _ when Ident.equal id nid -> PatternMatch.get_type_name t | _:: is -> fixed_nvar_type_name is nvar | _ -> raise Not_found) - | Sil.Const c -> PatternMatch.java_get_const_type_name c + | Exp.Const c -> PatternMatch.java_get_const_type_name c | _ -> raise (Failure "Could not resolve fixed type name") in match instr with - | Sil.Call (_, Sil.Const (Const.Cfun pn), args, cl, _) -> ( + | Sil.Call (_, Exp.Const (Const.Cfun pn), args, cl, _) -> ( match printf_like_function pn with | Some printf -> ( try diff --git a/infer/src/checkers/repeatedCallsChecker.ml b/infer/src/checkers/repeatedCallsChecker.ml index 692e0faa4..18645f64b 100644 --- a/infer/src/checkers/repeatedCallsChecker.ml +++ b/infer/src/checkers/repeatedCallsChecker.ml @@ -73,7 +73,7 @@ struct Procname.equal pn ModelBuiltins.__new_array in let do_instr instr = match instr with - | Sil.Call (_, Sil.Const (Const.Cfun pn), _, loc, _) when proc_is_new pn -> + | Sil.Call (_, Exp.Const (Const.Cfun pn), _, loc, _) when proc_is_new pn -> found := Some loc | _ -> () in IList.iter do_instr (Cfg.Node.get_instrs node); @@ -111,18 +111,18 @@ struct (* Arguments are not temporary variables. *) let arguments_not_temp args = let filter_arg (e, _) = match e with - | Sil.Lvar pvar -> + | Exp.Lvar pvar -> (* same temporary variable does not imply same value *) not (Pvar.is_frontend_tmp pvar) | _ -> true in IList.for_all filter_arg args in match instr with - | Sil.Call (ret_ids, Sil.Const (Const.Cfun callee_pname), _, loc, call_flags) + | Sil.Call (ret_ids, Exp.Const (Const.Cfun callee_pname), _, loc, call_flags) when ret_ids <> [] && arguments_not_temp normalized_etl -> let instr_normalized_args = Sil.Call ( ret_ids, - Sil.Const (Const.Cfun callee_pname), + Exp.Const (Const.Cfun callee_pname), normalized_etl, loc, call_flags) in diff --git a/infer/src/checkers/sqlChecker.ml b/infer/src/checkers/sqlChecker.ml index 7014d5df5..8203bd23b 100644 --- a/infer/src/checkers/sqlChecker.ml +++ b/infer/src/checkers/sqlChecker.ml @@ -33,8 +33,8 @@ let callback_sql { Callbacks.proc_desc; proc_name; tenv } = && Procname.java_get_method pn_java = "append" then begin - let rvar1 = Sil.Var i1 in - let rvar2 = Sil.Var i2 in + let rvar1 = Exp.Var i1 in + let rvar2 = Exp.Var i2 in begin let matches s r = Str.string_match r s 0 in match const_map node rvar1, const_map node rvar2 with @@ -53,7 +53,7 @@ let callback_sql { Callbacks.proc_desc; proc_name; tenv } = end in match instr with - | Sil.Call (_, Sil.Const (Const.Cfun pn), (Sil.Var i1, _):: (Sil.Var i2, _):: [], l, _) -> + | Sil.Call (_, Exp.Const (Const.Cfun pn), (Exp.Var i1, _):: (Exp.Var i2, _):: [], l, _) -> begin match pn with | Procname.Java pn_java -> diff --git a/infer/src/checkers/var.ml b/infer/src/checkers/var.ml index 796be9ba7..3bc19a977 100644 --- a/infer/src/checkers/var.ml +++ b/infer/src/checkers/var.ml @@ -22,8 +22,8 @@ let of_pvar pvar = ProgramVar pvar let to_exp = function - | ProgramVar pvar -> Sil.Lvar pvar - | LogicalVar id -> Sil.Var id + | ProgramVar pvar -> Exp.Lvar pvar + | LogicalVar id -> Exp.Var id let compare v1 v2 = match v1, v2 with | ProgramVar pv1, ProgramVar pv2 -> Pvar.compare pv1 pv2 diff --git a/infer/src/checkers/var.mli b/infer/src/checkers/var.mli index 0a6da80f3..737d17778 100644 --- a/infer/src/checkers/var.mli +++ b/infer/src/checkers/var.mli @@ -17,7 +17,7 @@ val of_id : Ident.t -> t val of_pvar : Pvar.t -> t -val to_exp : t -> Sil.exp +val to_exp : t -> Exp.t val equal : t -> t -> bool diff --git a/infer/src/clang/cArithmetic_trans.ml b/infer/src/clang/cArithmetic_trans.ml index cbea96f1e..e75251729 100644 --- a/infer/src/clang/cArithmetic_trans.ml +++ b/infer/src/clang/cArithmetic_trans.ml @@ -26,7 +26,7 @@ let assignment_arc_mode e1 typ e2 loc rhs_owning_method is_e1_decl = let release_pname = ModelBuiltins.__objc_release in let autorelease_pname = ModelBuiltins.__set_autorelease_attribute in let mk_call procname e t = - let bi_retain = Sil.Const (Const.Cfun procname) in + let bi_retain = Exp.Const (Const.Cfun procname) in Sil.Call([], bi_retain, [(e, t)], loc, CallFlags.default) in match typ with | Typ.Tptr (_, Typ.Pk_pointer) when not rhs_owning_method && not is_e1_decl -> @@ -35,7 +35,7 @@ let assignment_arc_mode e1 typ e2 loc rhs_owning_method is_e1_decl = let retain = mk_call retain_pname e2 typ in let id = Ident.create_fresh Ident.knormal in let tmp_assign = Sil.Letderef(id, e1, typ, loc) in - let release = mk_call release_pname (Sil.Var id) typ in + let release = mk_call release_pname (Exp.Var id) typ in (e1,[retain; tmp_assign; assign; release]) | Typ.Tptr (_, Typ.Pk_pointer) when not rhs_owning_method && is_e1_decl -> (* for A __strong *e1 = e2 the semantics is*) @@ -62,34 +62,34 @@ let compound_assignment_binary_operation_instruction boi e1 typ e2 loc = let instr1 = Sil.Letderef (id, e1, typ, loc) in let e_res, instr_op = match boi.Clang_ast_t.boi_kind with | `AddAssign -> - let e1_plus_e2 = Sil.BinOp(Binop.PlusA, Sil.Var id, e2) in + let e1_plus_e2 = Exp.BinOp(Binop.PlusA, Exp.Var id, e2) in (e1, [Sil.Set (e1, typ, e1_plus_e2, loc)]) | `SubAssign -> - let e1_sub_e2 = Sil.BinOp(Binop.MinusA, Sil.Var id, e2) in + let e1_sub_e2 = Exp.BinOp(Binop.MinusA, Exp.Var id, e2) in (e1, [Sil.Set (e1, typ, e1_sub_e2, loc)]) | `MulAssign -> - let e1_mul_e2 = Sil.BinOp(Binop.Mult, Sil.Var id, e2) in + let e1_mul_e2 = Exp.BinOp(Binop.Mult, Exp.Var id, e2) in (e1, [Sil.Set (e1, typ, e1_mul_e2, loc)]) | `DivAssign -> - let e1_div_e2 = Sil.BinOp(Binop.Div, Sil.Var id, e2) in + let e1_div_e2 = Exp.BinOp(Binop.Div, Exp.Var id, e2) in (e1, [Sil.Set (e1, typ, e1_div_e2, loc)]) | `ShlAssign -> - let e1_shl_e2 = Sil.BinOp(Binop.Shiftlt, Sil.Var id, e2) in + let e1_shl_e2 = Exp.BinOp(Binop.Shiftlt, Exp.Var id, e2) in (e1, [Sil.Set (e1, typ, e1_shl_e2, loc)]) | `ShrAssign -> - let e1_shr_e2 = Sil.BinOp(Binop.Shiftrt, Sil.Var id, e2) in + let e1_shr_e2 = Exp.BinOp(Binop.Shiftrt, Exp.Var id, e2) in (e1, [Sil.Set (e1, typ, e1_shr_e2, loc)]) | `RemAssign -> - let e1_mod_e2 = Sil.BinOp(Binop.Mod, Sil.Var id, e2) in + let e1_mod_e2 = Exp.BinOp(Binop.Mod, Exp.Var id, e2) in (e1, [Sil.Set (e1, typ, e1_mod_e2, loc)]) | `AndAssign -> - let e1_and_e2 = Sil.BinOp(Binop.BAnd, Sil.Var id, e2) in + let e1_and_e2 = Exp.BinOp(Binop.BAnd, Exp.Var id, e2) in (e1, [Sil.Set (e1, typ, e1_and_e2, loc)]) | `OrAssign -> - let e1_or_e2 = Sil.BinOp(Binop.BOr, Sil.Var id, e2) in + let e1_or_e2 = Exp.BinOp(Binop.BOr, Exp.Var id, e2) in (e1, [Sil.Set (e1, typ, e1_or_e2, loc)]) | `XorAssign -> - let e1_xor_e2 = Sil.BinOp(Binop.BXor, Sil.Var id, e2) in + let e1_xor_e2 = Exp.BinOp(Binop.BXor, Exp.Var id, e2) in (e1, [Sil.Set (e1, typ, e1_xor_e2, loc)]) | _ -> assert false in (e_res, instr1:: instr_op) @@ -99,7 +99,7 @@ let compound_assignment_binary_operation_instruction boi e1 typ e2 loc = (* empty when the binary operator is actually a statement like an *) (* assignment. *) let binary_operation_instruction context boi e1 typ e2 loc rhs_owning_method = - let binop_exp op = Sil.BinOp(op, e1, e2) in + let binop_exp op = Exp.BinOp(op, e1, e2) in match boi.Clang_ast_t.boi_kind with | `Add -> (binop_exp (Binop.PlusA), []) | `Mul -> (binop_exp (Binop.Mult), []) @@ -139,17 +139,17 @@ let binary_operation_instruction context boi e1 typ e2 loc rhs_owning_method = let unary_operation_instruction uoi e typ loc = let uok = Clang_ast_j.string_of_unary_operator_kind (uoi.Clang_ast_t.uoi_kind) in let un_exp op = - Sil.UnOp(op, e, Some typ) in + Exp.UnOp(op, e, Some typ) in match uoi.Clang_ast_t.uoi_kind with | `PostInc -> let id = Ident.create_fresh Ident.knormal in let instr1 = Sil.Letderef (id, e, typ, loc) in - let e_plus_1 = Sil.BinOp(Binop.PlusA, Sil.Var id, Sil.Const(Const.Cint (IntLit.one))) in - (Sil.Var id, instr1::[Sil.Set (e, typ, e_plus_1, loc)]) + let e_plus_1 = Exp.BinOp(Binop.PlusA, Exp.Var id, Exp.Const(Const.Cint (IntLit.one))) in + (Exp.Var id, instr1::[Sil.Set (e, typ, e_plus_1, loc)]) | `PreInc -> let id = Ident.create_fresh Ident.knormal in let instr1 = Sil.Letderef (id, e, typ, loc) in - let e_plus_1 = Sil.BinOp(Binop.PlusA, Sil.Var id, Sil.Const(Const.Cint (IntLit.one))) in + let e_plus_1 = Exp.BinOp(Binop.PlusA, Exp.Var id, Exp.Const(Const.Cint (IntLit.one))) in let exp = if General_utils.is_cpp_translation Config.clang_lang then e else @@ -158,12 +158,12 @@ let unary_operation_instruction uoi e typ loc = | `PostDec -> let id = Ident.create_fresh Ident.knormal in let instr1 = Sil.Letderef (id, e, typ, loc) in - let e_minus_1 = Sil.BinOp(Binop.MinusA, Sil.Var id, Sil.Const(Const.Cint (IntLit.one))) in - (Sil.Var id, instr1::[Sil.Set (e, typ, e_minus_1, loc)]) + let e_minus_1 = Exp.BinOp(Binop.MinusA, Exp.Var id, Exp.Const(Const.Cint (IntLit.one))) in + (Exp.Var id, instr1::[Sil.Set (e, typ, e_minus_1, loc)]) | `PreDec -> let id = Ident.create_fresh Ident.knormal in let instr1 = Sil.Letderef (id, e, typ, loc) in - let e_minus_1 = Sil.BinOp(Binop.MinusA, Sil.Var id, Sil.Const(Const.Cint (IntLit.one))) in + let e_minus_1 = Exp.BinOp(Binop.MinusA, Exp.Var id, Exp.Const(Const.Cint (IntLit.one))) in let exp = if General_utils.is_cpp_translation Config.clang_lang then e else @@ -219,6 +219,6 @@ let bin_op_to_string boi = let sil_const_plus_one const = match const with - | Sil.Const (Const.Cint n) -> - Sil.Const (Const.Cint (IntLit.add n IntLit.one)) - | _ -> Sil.BinOp (Binop.PlusA, const, Sil.Const (Const.Cint (IntLit.one))) + | Exp.Const (Const.Cint n) -> + Exp.Const (Const.Cint (IntLit.add n IntLit.one)) + | _ -> Exp.BinOp (Binop.PlusA, const, Exp.Const (Const.Cint (IntLit.one))) diff --git a/infer/src/clang/cArithmetic_trans.mli b/infer/src/clang/cArithmetic_trans.mli index b2bbe14ce..82f6233bd 100644 --- a/infer/src/clang/cArithmetic_trans.mli +++ b/infer/src/clang/cArithmetic_trans.mli @@ -14,13 +14,13 @@ open! Utils val bin_op_to_string : Clang_ast_t.binary_operator_info -> string val binary_operation_instruction : - CContext.t -> Clang_ast_t.binary_operator_info -> Sil.exp -> Typ.t -> Sil.exp -> - Location.t -> bool -> Sil.exp * Sil.instr list + CContext.t -> Clang_ast_t.binary_operator_info -> Exp.t -> Typ.t -> Exp.t -> + Location.t -> bool -> Exp.t * Sil.instr list val unary_operation_instruction : - Clang_ast_t.unary_operator_info -> Sil.exp -> Typ.t -> Location.t -> Sil.exp * Sil.instr list + Clang_ast_t.unary_operator_info -> Exp.t -> Typ.t -> Location.t -> Exp.t * Sil.instr list val assignment_arc_mode : - Sil.exp -> Typ.t -> Sil.exp -> Location.t -> bool -> bool -> Sil.exp * Sil.instr list + Exp.t -> Typ.t -> Exp.t -> Location.t -> bool -> bool -> Exp.t * Sil.instr list -val sil_const_plus_one : Sil.exp -> Sil.exp +val sil_const_plus_one : Exp.t -> Exp.t diff --git a/infer/src/clang/cFrontend_config.mli b/infer/src/clang/cFrontend_config.mli index 257f9b639..f32b659b0 100644 --- a/infer/src/clang/cFrontend_config.mli +++ b/infer/src/clang/cFrontend_config.mli @@ -76,7 +76,7 @@ val void : string (** Global state *) (** Map from enum constants pointers to their predecesor and their sil value *) -val enum_map : (Clang_ast_t.pointer option * Sil.exp option) Clang_ast_main.PointerMap.t ref +val enum_map : (Clang_ast_t.pointer option * Exp.t option) Clang_ast_main.PointerMap.t ref val global_translation_unit_decls : Clang_ast_t.decl list ref val ivar_to_property_index : Clang_ast_t.decl Clang_ast_main.PointerMap.t ref val json : string ref diff --git a/infer/src/clang/cFrontend_utils.mli b/infer/src/clang/cFrontend_utils.mli index 164adbb24..a532f3605 100644 --- a/infer/src/clang/cFrontend_utils.mli +++ b/infer/src/clang/cFrontend_utils.mli @@ -90,11 +90,11 @@ sig val update_sil_types_map : Clang_ast_t.type_ptr -> Typ.t -> unit - val update_enum_map : Clang_ast_t.pointer -> Sil.exp -> unit + val update_enum_map : Clang_ast_t.pointer -> Exp.t -> unit val add_enum_constant : Clang_ast_t.pointer -> Clang_ast_t.pointer option -> unit - val get_enum_constant_exp : Clang_ast_t.pointer -> Clang_ast_t.pointer option * Sil.exp option + val get_enum_constant_exp : Clang_ast_t.pointer -> Clang_ast_t.pointer option * Exp.t option (** returns sanitized, fully qualified name given name info *) val get_qualified_name : Clang_ast_t.named_decl_info -> string @@ -182,7 +182,7 @@ sig (Mangled.t * Typ.t) list -> (Mangled.t * Typ.t) list -> (Mangled.t * Typ.t) list val append_no_duplicateds : - (Sil.exp * Typ.t) list -> (Sil.exp * Typ.t) list -> (Sil.exp * Typ.t) list + (Exp.t * Typ.t) list -> (Exp.t * Typ.t) list -> (Exp.t * Typ.t) list val sort_fields : (Ident.fieldname * Typ.t * Typ.item_annotation) list -> diff --git a/infer/src/clang/cMethod_trans.mli b/infer/src/clang/cMethod_trans.mli index 2679084d4..0f2c01cc2 100644 --- a/infer/src/clang/cMethod_trans.mli +++ b/infer/src/clang/cMethod_trans.mli @@ -32,7 +32,7 @@ val get_objc_method_data : Clang_ast_t.obj_c_message_expr_info -> (string * Clang_ast_t.pointer option * method_call_type) val get_class_name_method_call_from_receiver_kind : CContext.t -> - Clang_ast_t.obj_c_message_expr_info -> (Sil.exp * Typ.t) list -> string + Clang_ast_t.obj_c_message_expr_info -> (Exp.t * Typ.t) list -> string val get_class_name_method_call_from_clang : Tenv.t -> Clang_ast_t.obj_c_message_expr_info -> string option diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index ed45322aa..2ca00efb9 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -85,7 +85,7 @@ struct let ret_id = Ident.create_fresh Ident.knormal in let stmt_call = Sil.Call - ([ret_id], Sil.Const (Const.Cfun fname), [(exp, typ)], sil_loc, CallFlags.default) in + ([ret_id], Exp.Const (Const.Cfun fname), [(exp, typ)], sil_loc, CallFlags.default) in [stmt_call] else [] @@ -142,19 +142,19 @@ struct CTrans_utils.alloc_trans trans_state loc (Ast_expressions.dummy_stmt_info ()) block_type true None in let id_block = match trans_res.exps with - | [(Sil.Var id, _)] -> id + | [(Exp.Var id, _)] -> id | _ -> assert false in let block_var = Pvar.mk mblock procname in let declare_block_local = Sil.Declare_locals ([(block_var, Typ.Tptr (block_type, Typ.Pk_pointer))], loc) in - let set_instr = Sil.Set (Sil.Lvar block_var, block_type, Sil.Var id_block, loc) in + let set_instr = Sil.Set (Exp.Lvar block_var, block_type, Exp.Var id_block, loc) in let create_field_exp (var, typ) = let id = Ident.create_fresh Ident.knormal in - id, Sil.Letderef (id, Sil.Lvar var, typ, loc) in + id, Sil.Letderef (id, Exp.Lvar var, typ, loc) in let ids, captured_instrs = IList.split (IList.map create_field_exp captured_vars) in let fields_ids = IList.combine fields ids in let set_fields = IList.map (fun ((f, t, _), id) -> - Sil.Set (Sil.Lfield (Sil.Var id_block, f, block_type), t, Sil.Var id, loc)) fields_ids in + Sil.Set (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] @ captured_instrs @ @@ -167,15 +167,15 @@ struct let make_function_name typ bn = let bn'= Procname.to_string bn in let bn''= Mangled.from_string bn' in - let block = Sil.Lvar (Pvar.mk bn'' procname) in + let block = Exp.Lvar (Pvar.mk bn'' procname) in let id = Ident.create_fresh Ident.knormal in insts := Sil.Letderef (id, block, typ, loc) :: !insts; - (Sil.Var id, typ) in + (Exp.Var id, typ) in let make_arg typ (id, _, _) = (id, typ) in let rec f es = match es with | [] -> [] - | (Sil.Closure {name; captured_vars}, + | (Exp.Closure {name; captured_vars}, (Typ.Tptr((Typ.Tfun _), _ ) as t)) :: es' -> let app = let function_name = make_function_name t name in @@ -215,7 +215,7 @@ struct CTypes_decl.objc_class_name_to_sil_type trans_state.context.CContext.tenv class_name in let expanded_type = CTypes.expand_structured_type trans_state.context.CContext.tenv typ in { empty_res_trans with - exps = [(Sil.Sizeof(expanded_type, None, Subtype.exact), Typ.Tint Typ.IULong)] } + exps = [(Exp.Sizeof(expanded_type, None, Subtype.exact), Typ.Tint Typ.IULong)] } let add_reference_if_glvalue typ expr_info = (* glvalue definition per C++11:*) @@ -276,7 +276,7 @@ struct let (pvar, typ) = mk_temp_sil_var_for_expr context.CContext.tenv procdesc var_name expr_info in Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, typ)]; - Sil.Lvar pvar, typ + Exp.Lvar pvar, typ let create_call_instr trans_state return_type function_sil params_sil sil_loc call_flags ~is_objc_method = @@ -292,7 +292,7 @@ struct let procdesc = trans_state.context.CContext.procdesc in let pvar = mk_temp_sil_var procdesc "__temp_return_" in Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, return_type)]; - Sil.Lvar pvar in + Exp.Lvar pvar in (* It is very confusing - same expression has two different types in two contexts:*) (* 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue *) (* 2. for return expression it's RETURN_TYPE since backend allows to treat it as lvalue*) @@ -310,7 +310,7 @@ struct let ret_param = (var_exp, param_type) in let ret_exp = (var_exp, return_type) in [], params_sil @ [ret_param], [var_exp], [ret_exp] - else ret_id, params_sil, [], match ret_id with [x] -> [(Sil.Var x, return_type)] | _ -> [] in + else ret_id, params_sil, [], match ret_id with [x] -> [(Exp.Var x, return_type)] | _ -> [] in let call_instr = Sil.Call (ret_id', function_sil, params, sil_loc, call_flags) in { empty_res_trans with instrs = [call_instr]; @@ -329,7 +329,7 @@ struct let stringLiteral_trans trans_state expr_info str = let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.CContext.tenv in - let exp = Sil.Const (Const.Cstr (str)) in + let exp = Exp.Const (Const.Cstr (str)) in { empty_res_trans with exps = [(exp, typ)]} (* FROM CLANG DOCS: "Implements the GNU __null extension, @@ -342,7 +342,7 @@ struct So we implement it as the constant zero *) let gNUNullExpr_trans trans_state expr_info = let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.CContext.tenv in - let exp = Sil.Const (Const.Cint (IntLit.zero)) in + let exp = Exp.Const (Const.Cint (IntLit.zero)) in { empty_res_trans with exps = [(exp, typ)]} let nullPtrExpr_trans trans_state expr_info = @@ -363,7 +363,7 @@ struct let characterLiteral_trans trans_state expr_info n = let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.CContext.tenv in - let exp = Sil.Const (Const.Cint (IntLit.of_int n)) in + let exp = Exp.Const (Const.Cint (IntLit.of_int n)) in { empty_res_trans with exps = [(exp, typ)]} let booleanValue_trans trans_state expr_info b = @@ -371,7 +371,7 @@ struct let floatingLiteral_trans trans_state expr_info float_string = let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.CContext.tenv in - let exp = Sil.Const (Const.Cfloat (float_of_string float_string)) in + let exp = Exp.Const (Const.Cfloat (float_of_string float_string)) in { empty_res_trans with exps = [(exp, typ)]} (* Note currently we don't have support for different qual *) @@ -387,7 +387,7 @@ struct | Failure _ -> (* Parse error: return a nondeterministic value *) let id = Ident.create_fresh Ident.knormal in - Sil.Var id in + Exp.Var id in { empty_res_trans with exps = [(exp, typ)]; } @@ -398,7 +398,7 @@ struct let zero_opt = match typ with | Typ.Tfloat _ | Typ.Tptr _ | Typ.Tint _ -> Some (Sil.zero_value_of_numerical_type typ) | Typ.Tvoid -> None - | _ -> Some (Sil.Const (Const.Cint IntLit.zero)) in + | _ -> Some (Exp.Const (Const.Cint IntLit.zero)) in match zero_opt with | Some zero -> { empty_res_trans with exps = [(zero, typ)] } | _ -> empty_res_trans @@ -427,7 +427,7 @@ struct | Some tp -> CTypes_decl.type_ptr_to_sil_type tenv tp | None -> typ (* Some default type since the type is missing *) in { empty_res_trans with - exps = [(Sil.Sizeof (sizeof_typ, None, Subtype.exact), sizeof_typ)] } + exps = [(Exp.Sizeof (sizeof_typ, None, Subtype.exact), sizeof_typ)] } | k -> Printing.log_stats "\nWARNING: Missing translation of Uniry_Expression_Or_Trait of kind: \ %s . Expression ignored, returned -1... \n" @@ -465,11 +465,11 @@ struct else Procname.from_string_c_fun name in let is_builtin = Builtin.is_registered non_mangled_func_name in if is_builtin then (* malloc, free, exit, scanf, ... *) - { empty_res_trans with exps = [(Sil.Const (Const.Cfun non_mangled_func_name), typ)] } + { empty_res_trans with exps = [(Exp.Const (Const.Cfun non_mangled_func_name), typ)] } else begin if address_of_function then Cfg.set_procname_priority context.cfg pname; - { empty_res_trans with exps = [(Sil.Const (Const.Cfun pname), typ)] } + { empty_res_trans with exps = [(Exp.Const (Const.Cfun pname), typ)] } end let var_deref_trans trans_state stmt_info decl_ref = @@ -487,7 +487,7 @@ struct let sil_loc = CLocation.get_sil_location stmt_info context in let pvar = CVar_decl.sil_var_of_decl_ref context decl_ref procname in CContext.add_block_static_var context procname (pvar, typ); - let e = Sil.Lvar pvar in + let e = Exp.Lvar pvar in let exps = if Self.is_var_self pvar (CContext.is_objc_method context) then let curr_class = CContext.get_curr_class context in if (CTypes.is_class typ) then @@ -523,7 +523,7 @@ struct | t -> t in Printing.log_out "Type is '%s' @." (Typ.to_string class_typ); let field_name = General_utils.mk_class_field_name name_info in - let field_exp = Sil.Lfield (obj_sil, field_name, class_typ) in + let field_exp = Exp.Lfield (obj_sil, field_name, class_typ) in (* In certain cases, there is be no LValueToRValue cast, but backend needs dereference*) (* there either way:*) (* 1. Class is not a pointer type - it means that it's rvalue struct most likely coming from*) @@ -536,7 +536,7 @@ struct let exp, deref_instrs = if should_add_deref then let id = Ident.create_fresh Ident.knormal in let deref_instr = Sil.Letderef (id, field_exp, field_typ, sil_loc) in - Sil.Var id, [deref_instr] + Exp.Var id, [deref_instr] else field_exp, [] in let instrs = pre_trans_result.instrs @ deref_instrs in @@ -586,7 +586,7 @@ struct (* unlike field access, for method calls there is no need to expand class type *) let pname = CMethod_trans.create_procdesc_with_pointer context decl_ptr (Some class_name) method_name in - let method_exp = (Sil.Const (Const.Cfun pname), method_typ) in + let method_exp = (Exp.Const (Const.Cfun pname), method_typ) in Cfg.set_procname_priority context.CContext.cfg pname; { pre_trans_result with is_cpp_call_virtual = is_cpp_virtual; @@ -610,7 +610,7 @@ struct let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in let name = CFrontend_config.this in let pvar = Pvar.mk (Mangled.from_string name) procname in - let exp = Sil.Lvar pvar in + let exp = Exp.Lvar pvar in let typ = CTypes_decl.type_ptr_to_sil_type context.CContext.tenv class_type_ptr in let exps = [(exp, typ)] in (* there is no cast operation in AST, but backend needs it *) @@ -678,7 +678,7 @@ struct (* get the sil value of the enum constant from the map or by evaluating it *) and get_enum_constant_expr context enum_constant_pointer = - let zero = Sil.Const (Const.Cint IntLit.zero) in + let zero = Exp.Const (Const.Cint IntLit.zero) in try let (prev_enum_constant_opt, sil_exp_opt) = Ast_utils.get_enum_constant_exp enum_constant_pointer in @@ -709,7 +709,7 @@ struct "WARNING: In ArraySubscriptExpr there was a problem in translating array exp.\n" in let (i_exp, _) = extract_exp_from_list res_trans_idx.exps "WARNING: In ArraySubscriptExpr there was a problem in translating index exp.\n" in - let array_exp = Sil.Lindex (a_exp, i_exp) in + let array_exp = Exp.Lindex (a_exp, i_exp) in let root_nodes = if res_trans_a.root_nodes <> [] @@ -788,7 +788,7 @@ struct (* As no node is created here ids are passed to the parent *) let id = Ident.create_fresh Ident.knormal in let res_instr = Sil.Letderef (id, var_exp, var_exp_typ, sil_loc) in - [res_instr], Sil.Var id + [res_instr], Exp.Var id ) else ( [], exp_op) in let binop_res_trans = { empty_res_trans with @@ -821,7 +821,7 @@ struct Returning -1. NEED TO BE FIXED" in let callee_pname_opt = match sil_fe with - | Sil.Const (Const.Cfun pn) -> + | Exp.Const (Const.Cfun pn) -> Some pn | _ -> None (* function pointer *) in (* we cannot translate the arguments of __builtin_object_size because preprocessing copies @@ -854,10 +854,10 @@ struct NEED TO BE FIXED\n\n"; fix_param_exps_mismatch params_stmt params) in let act_params = if is_cf_retain_release then - (Sil.Const (Const.Cint IntLit.one), Typ.Tint Typ.IBool) :: act_params + (Exp.Const (Const.Cint IntLit.one), Typ.Tint Typ.IBool) :: act_params else act_params in let sil_fe' = match callee_pname_opt' with - | Some pn -> Sil.Const (Const.Cfun pn) + | Some pn -> Exp.Const (Const.Cfun pn) | _ -> sil_fe in let res_trans_call = let cast_trans_fun = cast_trans context act_params sil_loc function_type in @@ -894,7 +894,7 @@ struct let (sil_method, _) = IList.hd result_trans_callee.exps in let callee_pname = match sil_method with - | Sil.Const (Const.Cfun pn) -> pn + | Exp.Const (Const.Cfun pn) -> pn | _ -> assert false (* method pointer not implemented, this shouldn't happen *) in (* As we may have nodes coming from different parameters we need to *) (* call instruction for each parameter and collect the results *) @@ -954,7 +954,7 @@ struct let pvar = Pvar.mk_tmp "__temp_construct_" (Cfg.Procdesc.get_proc_name procdesc) in let class_type = CTypes_decl.get_type_from_expr_info ei context.CContext.tenv in Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, class_type)]; - Sil.Lvar pvar, class_type in + Exp.Lvar pvar, class_type in let this_type = Typ.Tptr (class_type, Typ.Pk_pointer) in let this_res_trans = { empty_res_trans with exps = [(var_exp, this_type)]; @@ -1053,7 +1053,7 @@ struct instrs = instr_block_param; } in let call_flags = { CallFlags.default with CallFlags.cf_virtual = is_virtual; } in - let method_sil = Sil.Const (Const.Cfun callee_name) in + let method_sil = Exp.Const (Const.Cfun callee_name) in let res_trans_call = create_call_instr trans_state method_type method_sil param_exps sil_loc call_flags ~is_objc_method:true in let selector = obj_c_message_expr_info.Clang_ast_t.omei_selector in @@ -1093,7 +1093,7 @@ struct let (e', _) = extract_exp_from_list res_trans_b.exps "\nWARNING: Missing branch expression for Conditional operator. Need to be fixed\n" in let set_temp_var = [ - Sil.Set (Sil.Lvar pvar, var_typ, e', sil_loc) + Sil.Set (Exp.Lvar pvar, var_typ, e', sil_loc) ] in let tmp_var_res_trans = { empty_res_trans with instrs = set_temp_var } in let trans_state'' = { trans_state' with succ_nodes = [join_node] } in @@ -1120,12 +1120,12 @@ struct do_branch true exp1 var_typ res_trans_cond.leaf_nodes join_node pvar; do_branch false exp2 var_typ res_trans_cond.leaf_nodes join_node pvar; let id = Ident.create_fresh Ident.knormal in - let instrs = [Sil.Letderef (id, Sil.Lvar pvar, var_typ, sil_loc)] in + let instrs = [Sil.Letderef (id, Exp.Lvar pvar, var_typ, sil_loc)] in { empty_res_trans with root_nodes = res_trans_cond.root_nodes; leaf_nodes = [join_node]; instrs = instrs; - exps = [(Sil.Var id, typ)]; + exps = [(Exp.Var id, typ)]; initd_exps = []; (* TODO we should get exps from branches+cond *) } | _ -> assert false) @@ -1173,7 +1173,7 @@ struct Printing.log_out " No short-circuit condition\n"; let res_trans_cond = if is_null_stmt cond then { - empty_res_trans with exps = [(Sil.Const (Const.Cint IntLit.one), (Typ.Tint Typ.IBool))] + empty_res_trans with exps = [(Exp.Const (Const.Cint IntLit.one), (Typ.Tint Typ.IBool))] } (* Assumption: If it's a null_stmt, it is a loop with no bound, so we set condition to 1 *) else @@ -1224,7 +1224,7 @@ struct else res_trans_s1.root_nodes in let (exp1, typ1) = extract_exp res_trans_s1.exps in let (exp2, _) = extract_exp res_trans_s2.exps in - let e_cond = Sil.BinOp (binop, exp1, exp2) in + let e_cond = Exp.BinOp (binop, exp1, exp2) in { empty_res_trans with root_nodes = root_nodes_to_parent; leaf_nodes = prune_to_short_c@res_trans_s2.leaf_nodes; @@ -1386,7 +1386,7 @@ struct match e_const with | [(head, _)] -> head | _ -> assert false in - let sil_eq_cond = Sil.BinOp (Binop.Eq, switch_e_cond', e_const') in + let sil_eq_cond = Exp.BinOp (Binop.Eq, switch_e_cond', e_const') in let sil_loc = CLocation.get_sil_location stmt_info context in let true_prune_node = create_prune_node true [(sil_eq_cond, switch_e_cond'_typ)] @@ -1685,7 +1685,7 @@ struct let typ = CTypes_decl.type_ptr_to_sil_type context.CContext.tenv type_ptr in CVar_decl.add_var_to_locals procdesc var_decl typ pvar; let trans_state' = { trans_state with succ_nodes = next_node } in - init_expr_trans trans_state' (Sil.Lvar pvar, typ) stmt_info vdi.Clang_ast_t.vdi_init_expr in + init_expr_trans trans_state' (Exp.Lvar pvar, typ) stmt_info vdi.Clang_ast_t.vdi_init_expr in match var_decls with | [] -> { empty_res_trans with root_nodes = next_nodes } @@ -1861,11 +1861,11 @@ struct let procname = Cfg.Procdesc.get_proc_name procdesc in let pvar = Pvar.mk (Mangled.from_string name) procname in let id = Ident.create_fresh Ident.knormal in - let instr = Sil.Letderef (id, Sil.Lvar pvar, ret_param_typ, sil_loc) in + let instr = Sil.Letderef (id, Exp.Lvar pvar, ret_param_typ, sil_loc) in let ret_typ = match ret_param_typ with Typ.Tptr (t, _) -> t | _ -> assert false in - Sil.Var id, ret_typ, [instr] + Exp.Var id, ret_typ, [instr] | None -> - Sil.Lvar (Cfg.Procdesc.get_ret_var procdesc), ret_type, [] in + Exp.Lvar (Cfg.Procdesc.get_ret_var procdesc), ret_type, [] in let trans_state' = { trans_state_pri with succ_nodes = []; var_exp_typ = Some (ret_exp, ret_typ) } in @@ -1962,7 +1962,7 @@ struct let ret_id = Ident.create_fresh Ident.knormal in let autorelease_pool_vars = CVar_decl.compute_autorelease_pool_vars context stmts in let stmt_call = - Sil.Call([ret_id], (Sil.Const (Const.Cfun fname)), + Sil.Call([ret_id], (Exp.Const (Const.Cfun fname)), autorelease_pool_vars, sil_loc, CallFlags.default) in let node_kind = Cfg.Node.Stmt_node ("Release the autorelease pool") in let call_node = create_node node_kind [stmt_call] sil_loc context in @@ -1989,7 +1989,7 @@ struct (* Given a captured var, return the instruction to assign it to a temp *) let assign_captured_var (cvar, typ) = let id = Ident.create_fresh Ident.knormal in - let instr = Sil.Letderef (id, (Sil.Lvar cvar), typ, loc) in + let instr = Sil.Letderef (id, (Exp.Lvar cvar), typ, loc) in (id, instr) in match decl with | Clang_ast_t.BlockDecl (_, block_decl_info) -> @@ -2008,8 +2008,8 @@ struct F.function_decl context.tenv context.cfg context.cg decl (Some block_data); Cfg.set_procname_priority context.cfg block_pname; let captured_vars = - IList.map2 (fun id (pvar, typ) -> (Sil.Var id, pvar, typ)) ids captureds in - let closure = Sil.Closure { name=block_pname; captured_vars } in + IList.map2 (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 let captured_static_vars = captureds @ static_vars in @@ -2024,9 +2024,9 @@ struct and initListExpr_initializers_trans trans_state var_exp n stmts typ is_dyn_array stmt_info = let (var_exp_inside, typ_inside) = match typ with | Typ.Tarray (t, _) when Typ.is_array_of_cpp_class typ -> - Sil.Lindex (var_exp, Sil.Const (Const.Cint (IntLit.of_int n))), t + Exp.Lindex (var_exp, Exp.Const (Const.Cint (IntLit.of_int n))), t | _ when is_dyn_array -> - Sil.Lindex (var_exp, Sil.Const (Const.Cint (IntLit.of_int n))), typ + Exp.Lindex (var_exp, Exp.Const (Const.Cint (IntLit.of_int n))), typ | _ -> var_exp, typ in let trans_state' = { trans_state with var_exp_typ = Some (var_exp_inside, typ_inside) } in match stmts with @@ -2059,7 +2059,7 @@ struct (* defining procedure. We add an edge in the call graph.*) Cg.add_edge context.cg procname lambda_pname; let captured_vars = [] in (* TODO *) - let closure = Sil.Closure { name = lambda_pname; captured_vars } in + let closure = Exp.Closure { name = lambda_pname; captured_vars } in { empty_res_trans with exps = [(closure, typ)] } and cxxNewExpr_trans trans_state stmt_info expr_info cxx_new_expr_info = @@ -2077,7 +2077,7 @@ struct (match res_trans_size.exps with | [(exp, _)] -> Some exp, res_trans_size | _ -> None, empty_res_trans) - | None -> Some (Sil.Const (Const.Cint (IntLit.minus_one))), empty_res_trans + | None -> Some (Exp.Const (Const.Cint (IntLit.minus_one))), empty_res_trans else None, empty_res_trans in let res_trans_new = cpp_new_trans trans_state_pri sil_loc typ size_exp_opt in let stmt_opt = Ast_utils.get_stmt_opt cxx_new_expr_info.Clang_ast_t.xnei_initializer_expr in @@ -2093,8 +2093,8 @@ struct if is_dyn_array && Typ.is_pointer_to_cpp_class typ then let rec create_stmts stmt_opt size_exp_opt = match stmt_opt, size_exp_opt with - | Some stmt, Some (Sil.Const (Const.Cint n)) when not (IntLit.iszero n) -> - let n_minus_1 = Some ((Sil.Const (Const.Cint (IntLit.sub n IntLit.one)))) in + | Some stmt, Some (Exp.Const (Const.Cint n)) when not (IntLit.iszero n) -> + let n_minus_1 = Some ((Exp.Const (Const.Cint (IntLit.sub n IntLit.one)))) in stmt :: create_stmts stmt_opt n_minus_1 | _ -> [] in let stmts = create_stmts stmt_opt size_exp_opt in @@ -2123,7 +2123,7 @@ struct let exp = extract_exp_from_list result_trans_param.exps "WARNING: There should be one expression to delete. \n" in let call_instr = - Sil.Call ([], Sil.Const (Const.Cfun fname), [exp], sil_loc, CallFlags.default) in + Sil.Call ([], Exp.Const (Const.Cfun fname), [exp], sil_loc, CallFlags.default) in let call_res_trans = { empty_res_trans with instrs = [call_instr] } in let all_res_trans = if false then (* FIXME (t10135167): call destructor on deleted pointer if it's not null *) @@ -2153,7 +2153,7 @@ struct "SIL_materialize_temp__" expr_info in let temp_exp = match stmt_list with [p] -> p | _ -> assert false in Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, typ)]; - let var_exp_typ = (Sil.Lvar pvar, typ) in + let var_exp_typ = (Exp.Lvar pvar, typ) in let res_trans = init_expr_trans trans_state var_exp_typ stmt_info (Some temp_exp) in { res_trans with exps = [var_exp_typ] } @@ -2175,16 +2175,16 @@ struct let sil_loc = CLocation.get_sil_location stmt_info context in let cast_type = CTypes_decl.type_ptr_to_sil_type tenv cast_type_ptr in let sizeof_expr = match cast_type with - | Typ.Tptr (typ, _) -> Sil.Sizeof (typ, None, subtypes) + | Typ.Tptr (typ, _) -> Exp.Sizeof (typ, None, subtypes) | _ -> assert false in - let builtin = Sil.Const (Const.Cfun ModelBuiltins.__cast) in + let builtin = Exp.Const (Const.Cfun ModelBuiltins.__cast) in let stmt = match stmts with [stmt] -> stmt | _ -> assert false in let res_trans_stmt = exec_with_glvalue_as_reference instruction trans_state' stmt in let exp = match res_trans_stmt.exps with | [e] -> e | _ -> assert false in let args = [exp; (sizeof_expr, Typ.Tvoid)] in let ret_id = Ident.create_fresh Ident.knormal in let call = Sil.Call ([ret_id], builtin, args, sil_loc, CallFlags.default) in - let res_ex = Sil.Var ret_id in + let res_ex = Exp.Var ret_id in let res_trans_dynamic_cast = { empty_res_trans with instrs = [call]; } in let all_res_trans = [ res_trans_stmt; res_trans_dynamic_cast ] in let nname = "CxxDynamicCast" in @@ -2204,7 +2204,7 @@ struct let res_trans_subexpr_list = IList.map (exec_with_glvalue_as_reference instruction trans_state_param) stmts in let params = collect_exprs res_trans_subexpr_list in - let sil_fun = Sil.Const (Const.Cfun pname) in + let sil_fun = Exp.Const (Const.Cfun pname) in let call_instr = Sil.Call ([], sil_fun, params, sil_loc, CallFlags.default) in let res_trans_call = { empty_res_trans with instrs = [call_instr]; @@ -2222,7 +2222,7 @@ struct and cxxPseudoDestructorExpr_trans () = let fun_name = Procname.from_string_c_fun CFrontend_config.infer_skip_fun in - { empty_res_trans with exps = [(Sil.Const (Const.Cfun fun_name), Typ.Tvoid)] } + { empty_res_trans with exps = [(Exp.Const (Const.Cfun fun_name), Typ.Tvoid)] } and cxxTypeidExpr_trans trans_state stmt_info stmts expr_info = let tenv = trans_state.context.CContext.tenv in @@ -2236,13 +2236,13 @@ struct instruction trans_state_param stmt | _ -> empty_res_trans in let fun_name = ModelBuiltins.__cxx_typeid in - let sil_fun = Sil.Const (Const.Cfun fun_name) in + let sil_fun = Exp.Const (Const.Cfun fun_name) in let ret_id = Ident.create_fresh Ident.knormal in - let type_info_objc = (Sil.Sizeof (typ, None, Subtype.exact), Typ.Tvoid) in + let type_info_objc = (Exp.Sizeof (typ, None, Subtype.exact), Typ.Tvoid) in let field_name_decl = Ast_utils.make_qual_name_decl ["type_info"; "std"] "__type_name" in let field_name = General_utils.mk_class_field_name field_name_decl in - let ret_exp = Sil.Var ret_id in - let field_exp = Sil.Lfield (ret_exp, field_name, typ) in + let ret_exp = Exp.Var ret_id in + let field_exp = Exp.Lfield (ret_exp, field_name, typ) in let args = [type_info_objc; (field_exp, Typ.Tvoid)] @ res_trans_subexpr.exps in let call_instr = Sil.Call ([ret_id], sil_fun, args, sil_loc, CallFlags.default) in let res_trans_call = { empty_res_trans with @@ -2264,9 +2264,9 @@ struct 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 params = collect_exprs res_trans_subexpr_list in - let sil_fun = Sil.Const (Const.Cfun fun_name) in + let sil_fun = Exp.Const (Const.Cfun fun_name) in let ret_id = Ident.create_fresh Ident.knormal in - let ret_exp = Sil.Var ret_id in + let ret_exp = Exp.Var ret_id in let call_instr = Sil.Call ([ret_id], sil_fun, params, sil_loc, CallFlags.default) in let res_trans_call = { empty_res_trans with instrs = [call_instr]; diff --git a/infer/src/clang/cTrans_utils.ml b/infer/src/clang/cTrans_utils.ml index 5177b5992..f30276833 100644 --- a/infer/src/clang/cTrans_utils.ml +++ b/infer/src/clang/cTrans_utils.ml @@ -61,9 +61,9 @@ struct "\nWARNING: Missing expression for Conditional operator. Need to be fixed" in let e_cond'' = if branch then - Sil.BinOp(Binop.Ne, e_cond', Sil.exp_zero) + Exp.BinOp(Binop.Ne, e_cond', Sil.exp_zero) else - Sil.BinOp(Binop.Eq, e_cond', Sil.exp_zero) in + Exp.BinOp(Binop.Eq, e_cond', Sil.exp_zero) in let instrs_cond'= instrs_cond @ [Sil.Prune(e_cond'', loc, branch, ik)] in create_node (prune_kind branch) instrs_cond' loc context @@ -130,8 +130,8 @@ type trans_state = { succ_nodes: Cfg.Node.t list; (* successor nodes in the cfg *) continuation: continuation option; (* current continuation *) priority: priority_node; - var_exp_typ: (Sil.exp * Typ.t) option; - opaque_exp: (Sil.exp * Typ.t) option; + var_exp_typ: (Exp.t * Typ.t) option; + opaque_exp: (Exp.t * Typ.t) option; obj_bridged_cast_typ : Typ.t option } @@ -140,8 +140,8 @@ type trans_result = { root_nodes: Cfg.Node.t list; (* Top cfg nodes (root) created by the translation *) leaf_nodes: Cfg.Node.t list; (* Bottom cfg nodes (leaf) created by the translate *) instrs: Sil.instr list; (* list of SIL instruction that need to be placed in cfg nodes of the parent*) - exps: (Sil.exp * Typ.t) list; (* SIL expressions resulting from translation of clang stmt *) - initd_exps: Sil.exp list; + exps: (Exp.t * Typ.t) list; (* SIL expressions resulting from translation of clang stmt *) + initd_exps: Exp.t list; is_cpp_call_virtual : bool; } @@ -155,7 +155,7 @@ let empty_res_trans = { is_cpp_call_virtual = false; } -let undefined_expression () = Sil.Var (Ident.create_fresh Ident.knormal) +let undefined_expression () = Exp.Var (Ident.create_fresh Ident.knormal) (** Collect the results of translating a list of instructions, and link up the nodes created. *) let collect_res_trans cfg l = @@ -298,19 +298,19 @@ let create_alloc_instrs context sil_loc function_type fname size_exp_opt procnam function_type, styp | _ -> Typ.Tptr (function_type, Typ.Pk_pointer), function_type in let function_type_np = CTypes.expand_structured_type context.CContext.tenv function_type_np in - let sizeof_exp_ = Sil.Sizeof (function_type_np, None, Subtype.exact) in + let sizeof_exp_ = Exp.Sizeof (function_type_np, None, Subtype.exact) in let sizeof_exp = match size_exp_opt with - | Some exp -> Sil.BinOp (Binop.Mult, sizeof_exp_, exp) + | Some exp -> Exp.BinOp (Binop.Mult, sizeof_exp_, exp) | None -> sizeof_exp_ in let exp = (sizeof_exp, Typ.Tint Typ.IULong) in let procname_arg = match procname_opt with - | Some procname -> [Sil.Const (Const.Cfun (procname)), Typ.Tvoid] + | Some procname -> [Exp.Const (Const.Cfun (procname)), Typ.Tvoid] | None -> [] in let args = exp :: procname_arg in let ret_id = Ident.create_fresh Ident.knormal in let stmt_call = - Sil.Call([ret_id], Sil.Const (Const.Cfun fname), args, sil_loc, CallFlags.default) in - (function_type, stmt_call, Sil.Var ret_id) + Sil.Call([ret_id], Exp.Const (Const.Cfun fname), args, sil_loc, CallFlags.default) in + (function_type, stmt_call, Exp.Var ret_id) let alloc_trans trans_state loc stmt_info function_type is_cf_non_null_alloc procname_opt = let fname = if is_cf_non_null_alloc then @@ -338,13 +338,13 @@ let objc_new_trans trans_state loc stmt_info cls_name function_type = CMethod_trans.create_external_procdesc trans_state.context.CContext.cfg pname is_instance None; let args = [(alloc_ret_exp, alloc_ret_type)] in let init_stmt_call = - Sil.Call ([init_ret_id], Sil.Const (Const.Cfun pname), args, loc, call_flags) in + Sil.Call ([init_ret_id], Exp.Const (Const.Cfun pname), args, loc, call_flags) in let instrs = [alloc_stmt_call; init_stmt_call] in let res_trans_tmp = { empty_res_trans with instrs = instrs } in let res_trans = let nname = "Call objC new" in PriorityNode.compute_results_to_parent trans_state loc nname stmt_info [res_trans_tmp] in - { res_trans with exps = [(Sil.Var init_ret_id, alloc_ret_type)]} + { res_trans with exps = [(Exp.Var init_ret_id, alloc_ret_type)]} let new_or_alloc_trans trans_state loc stmt_info type_ptr class_name_opt selector = let tenv = trans_state.context.CContext.tenv in @@ -372,12 +372,12 @@ let create_cast_instrs context exp cast_from_typ cast_to_typ sil_loc = let ret_id = Ident.create_fresh Ident.knormal in let typ = CTypes.remove_pointer_to_typ cast_to_typ in let cast_typ_no_pointer = CTypes.expand_structured_type context.CContext.tenv typ in - let sizeof_exp = Sil.Sizeof (cast_typ_no_pointer, None, Subtype.exact) in + let sizeof_exp = Exp.Sizeof (cast_typ_no_pointer, None, Subtype.exact) in let pname = ModelBuiltins.__objc_cast in let args = [(exp, cast_from_typ); (sizeof_exp, Typ.Tint Typ.IULong)] in let stmt_call = - Sil.Call ([ret_id], Sil.Const (Const.Cfun pname), args, sil_loc, CallFlags.default) in - (stmt_call, Sil.Var ret_id) + Sil.Call ([ret_id], Exp.Const (Const.Cfun pname), args, sil_loc, CallFlags.default) in + (stmt_call, Exp.Var ret_id) let cast_trans context exps sil_loc function_type pname = if CTrans_models.is_toll_free_bridging pname then @@ -390,7 +390,7 @@ let cast_trans context exps sil_loc function_type pname = let dereference_var_sil (exp, typ) sil_loc = let id = Ident.create_fresh Ident.knormal in let sil_instr = Sil.Letderef (id, exp, typ, sil_loc) in - ([sil_instr], Sil.Var id) + ([sil_instr], Exp.Var id) (** Given trans_result with ONE expression, create temporary variable with value of an expression assigned to it *) @@ -439,8 +439,8 @@ let cast_operation trans_state cast_kind exps cast_typ sil_loc is_objc_bridged = ([], (exp, cast_typ)) let trans_assertion_failure sil_loc context = - let assert_fail_builtin = Sil.Const (Const.Cfun ModelBuiltins.__infer_fail) in - let args = [Sil.Const (Const.Cstr Config.default_failure_name), Typ.Tvoid] in + let assert_fail_builtin = Exp.Const (Const.Cfun ModelBuiltins.__infer_fail) in + let args = [Exp.Const (Const.Cstr Config.default_failure_name), Typ.Tvoid] in let call_instr = Sil.Call ([], assert_fail_builtin, args, sil_loc, CallFlags.default) in let exit_node = Cfg.Procdesc.get_exit_node (CContext.get_procdesc context) and failure_node = @@ -488,10 +488,10 @@ let cxx_method_builtin_trans trans_state loc pname = let define_condition_side_effects e_cond instrs_cond sil_loc = let (e', typ) = extract_exp_from_list e_cond "\nWARNING: Missing expression in IfStmt. Need to be fixed\n" in match e' with - | Sil.Lvar pvar -> + | Exp.Lvar pvar -> let id = Ident.create_fresh Ident.knormal in - [(Sil.Var id, typ)], - [Sil.Letderef (id, Sil.Lvar pvar, typ, sil_loc)] + [(Exp.Var id, typ)], + [Sil.Letderef (id, Exp.Lvar pvar, typ, sil_loc)] | _ -> [(e', typ)], instrs_cond let fix_param_exps_mismatch params_stmt exps_param = @@ -569,9 +569,9 @@ struct let t' = CTypes.add_pointer_to_typ (CTypes_decl.get_type_curr_class_objc context.CContext.tenv context.CContext.curr_class) in - let e = Sil.Lvar (Pvar.mk (Mangled.from_string CFrontend_config.self) procname) in + let e = Exp.Lvar (Pvar.mk (Mangled.from_string CFrontend_config.self) procname) in let id = Ident.create_fresh Ident.knormal in - t', Sil.Var id, [Sil.Letderef (id, e, t', loc)] in + t', Exp.Var id, [Sil.Letderef (id, e, t', loc)] in { empty_res_trans with exps = [(self_expr, typ)]; instrs = ins } @@ -704,7 +704,7 @@ let var_or_zero_in_init_list tenv e typ ~return_zero:return_zero = | _ -> [[(e, typ)]] (*This case is an error, shouldn't happen.*)) | Typ.Tstruct { Typ.instance_fields } as type_struct -> let lh_exprs = IList.map ( fun (fieldname, _, _) -> - Sil.Lfield (e, fieldname, type_struct) ) instance_fields in + Exp.Lfield (e, fieldname, type_struct) ) instance_fields in let lh_types = IList.map ( fun (_, fieldtype, _) -> fieldtype) instance_fields in let exp_types = zip lh_exprs lh_types in IList.map (fun (e, t) -> @@ -713,9 +713,9 @@ 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 -> (Sil.Const (Const.Cint (IntLit.of_int i)))) indices in + IList.map (fun i -> (Exp.Const (Const.Cint (IntLit.of_int i)))) indices in let lh_exprs = - IList.map (fun index_expr -> Sil.Lindex (e, index_expr)) index_constants in + IList.map (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) -> diff --git a/infer/src/clang/cTrans_utils.mli b/infer/src/clang/cTrans_utils.mli index ae132f446..7d38998fc 100644 --- a/infer/src/clang/cTrans_utils.mli +++ b/infer/src/clang/cTrans_utils.mli @@ -26,8 +26,8 @@ type trans_state = { succ_nodes: Cfg.Node.t list; continuation: continuation option; priority: priority_node; - var_exp_typ: (Sil.exp * Typ.t) option; - opaque_exp: (Sil.exp * Typ.t) option; + var_exp_typ: (Exp.t * Typ.t) option; + opaque_exp: (Exp.t * Typ.t) option; obj_bridged_cast_typ : Typ.t option } @@ -35,18 +35,18 @@ type trans_result = { root_nodes: Cfg.Node.t list; leaf_nodes: Cfg.Node.t list; instrs: Sil.instr list; - exps: (Sil.exp * Typ.t) list; - initd_exps: Sil.exp list; + exps: (Exp.t * Typ.t) list; + initd_exps: Exp.t list; is_cpp_call_virtual : bool; } val empty_res_trans: trans_result -val undefined_expression: unit -> Sil.exp +val undefined_expression: unit -> Exp.t val collect_res_trans : Cfg.cfg -> trans_result list -> trans_result -val extract_var_exp_or_fail : trans_state -> Sil.exp * Typ.t +val extract_var_exp_or_fail : trans_state -> Exp.t * Typ.t val is_return_temp: continuation option -> bool @@ -58,15 +58,15 @@ val mk_cond_continuation : continuation option -> continuation option val extract_item_from_singleton : 'a list -> string -> 'a -> 'a -val extract_exp_from_list : (Sil.exp * Typ.t) list -> string -> (Sil.exp * Typ.t) +val extract_exp_from_list : (Exp.t * Typ.t) list -> string -> (Exp.t * Typ.t) -val fix_param_exps_mismatch : 'a list -> (Sil.exp * Typ.t) list -> (Sil.exp * Typ.t)list +val fix_param_exps_mismatch : 'a list -> (Exp.t * Typ.t) list -> (Exp.t * Typ.t)list val get_selector_receiver : Clang_ast_t.obj_c_message_expr_info -> string * Clang_ast_t.receiver_kind val define_condition_side_effects : - (Sil.exp * Typ.t) list -> Sil.instr list -> Location.t -> - (Sil.exp * Typ.t) list * Sil.instr list + (Exp.t * Typ.t) list -> Sil.instr list -> Location.t -> + (Exp.t * Typ.t) list * Sil.instr list val extract_stmt_from_singleton : Clang_ast_t.stmt list -> string -> Clang_ast_t.stmt @@ -83,8 +83,8 @@ val get_type_from_exp_stmt : Clang_ast_t.stmt -> Clang_ast_t.type_ptr val dereference_value_from_result : Location.t -> trans_result -> strip_pointer:bool -> trans_result val cast_operation : - trans_state -> Clang_ast_t.cast_kind -> (Sil.exp * Typ.t) list -> Typ.t -> Location.t -> - bool -> Sil.instr list * (Sil.exp * Typ.t) + trans_state -> Clang_ast_t.cast_kind -> (Exp.t * Typ.t) list -> Typ.t -> Location.t -> + bool -> Sil.instr list * (Exp.t * Typ.t) val trans_assertion: trans_state -> Location.t -> trans_result @@ -111,13 +111,13 @@ val alloc_trans : val new_or_alloc_trans : trans_state -> Location.t -> Clang_ast_t.stmt_info -> Clang_ast_t.type_ptr -> string option -> string -> trans_result -val cpp_new_trans : trans_state -> Location.t -> Typ.t -> Sil.exp option -> trans_result +val cpp_new_trans : trans_state -> Location.t -> Typ.t -> Exp.t option -> trans_result val cast_trans : - CContext.t -> (Sil.exp * Typ.t) list -> Location.t -> Typ.t -> Procname.t -> - (Sil.instr * Sil.exp) option + CContext.t -> (Exp.t * Typ.t) list -> Location.t -> Typ.t -> Procname.t -> + (Sil.instr * Exp.t) option -val dereference_var_sil : Sil.exp * Typ.t -> Location.t -> Sil.instr list * Sil.exp +val dereference_var_sil : Exp.t * Typ.t -> Location.t -> Sil.instr list * Exp.t (** Module for creating cfg nodes and other utility functions related to them. *) module Nodes : @@ -131,7 +131,7 @@ sig val is_join_node : Cfg.Node.t -> bool val create_prune_node : - bool -> (Sil.exp * Typ.t) list -> Sil.instr list -> Location.t -> Sil.if_kind -> + bool -> (Exp.t * Typ.t) list -> Sil.instr list -> Location.t -> Sil.if_kind -> CContext.t -> Cfg.Node.t val is_prune_node : Cfg.Node.t -> bool @@ -218,5 +218,5 @@ val is_dispatch_function : Clang_ast_t.stmt list -> int option val is_block_enumerate_function : Clang_ast_t.obj_c_message_expr_info -> bool -val var_or_zero_in_init_list : Tenv.t -> Sil.exp -> Typ.t -> return_zero:bool -> - (Sil.exp * Typ.t) list +val var_or_zero_in_init_list : Tenv.t -> Exp.t -> Typ.t -> return_zero:bool -> + (Exp.t * Typ.t) list diff --git a/infer/src/clang/cVar_decl.ml b/infer/src/clang/cVar_decl.ml index 45c002e5c..b87d0831e 100644 --- a/infer/src/clang/cVar_decl.ml +++ b/infer/src/clang/cVar_decl.ml @@ -71,7 +71,7 @@ let rec compute_autorelease_pool_vars context stmts = let typ = CTypes_decl.type_ptr_to_sil_type context.CContext.tenv type_ptr in let pvar = sil_var_of_decl_ref context decl_ref procname in if Pvar.is_local pvar then - General_utils.append_no_duplicateds [(Sil.Lvar pvar, typ)] res + General_utils.append_no_duplicateds [(Exp.Lvar pvar, typ)] res else res | _ -> res) | _ -> res) diff --git a/infer/src/clang/cVar_decl.mli b/infer/src/clang/cVar_decl.mli index 76203e043..373160e29 100644 --- a/infer/src/clang/cVar_decl.mli +++ b/infer/src/clang/cVar_decl.mli @@ -18,7 +18,7 @@ val sil_var_of_decl_ref : CContext.t -> Clang_ast_t.decl_ref -> Procname.t -> Pv val add_var_to_locals : Cfg.Procdesc.t -> Clang_ast_t.decl -> Typ.t -> Pvar.t -> unit -val compute_autorelease_pool_vars : CContext.t -> Clang_ast_t.stmt list -> (Sil.exp * Typ.t) list +val compute_autorelease_pool_vars : CContext.t -> Clang_ast_t.stmt list -> (Exp.t * Typ.t) list val captured_vars_from_block_info : CContext.t -> Clang_ast_t.block_captured_variable list -> (Pvar.t * Typ.t) list diff --git a/infer/src/eradicate/eradicate.mli b/infer/src/eradicate/eradicate.mli index 9963c7fb5..ee03385a5 100644 --- a/infer/src/eradicate/eradicate.mli +++ b/infer/src/eradicate/eradicate.mli @@ -17,7 +17,7 @@ val callback_check_return_type : TypeCheck.check_return_type -> Callbacks.proc_c (** Parameters of a call. *) -type parameters = (Sil.exp * Typ.t) list +type parameters = (Exp.t * Typ.t) list (** Type for a module that provides a main callback function *) diff --git a/infer/src/eradicate/eradicateChecks.ml b/infer/src/eradicate/eradicateChecks.ml index 1083172bf..4e9c01409 100644 --- a/infer/src/eradicate/eradicateChecks.ml +++ b/infer/src/eradicate/eradicateChecks.ml @@ -140,7 +140,7 @@ let check_condition case_zero find_canonical_duplicate curr_pname Mangled.equal c throwable_class | _ -> false in let do_instr = function - | Sil.Call (_, Sil.Const (Const.Cfun pn), [_; (Sil.Sizeof(t, _, _), _)], _, _) when + | Sil.Call (_, Exp.Const (Const.Cfun pn), [_; (Exp.Sizeof(t, _, _), _)], _, _) when Procname.equal pn ModelBuiltins.__instanceof && typ_is_throwable t -> throwable_found := true | _ -> () in diff --git a/infer/src/eradicate/typeCheck.ml b/infer/src/eradicate/typeCheck.ml index d93504f52..99a9b47f0 100644 --- a/infer/src/eradicate/typeCheck.ml +++ b/infer/src/eradicate/typeCheck.ml @@ -162,30 +162,30 @@ type checks = let rec typecheck_expr find_canonical_duplicate visited checks node instr_ref curr_pname typestate e tr_default loc : TypeState.range = match e with - | Sil.Lvar pvar -> + | Exp.Lvar pvar -> (match TypeState.lookup_pvar pvar typestate with | Some tr -> TypeState.range_add_locs tr [loc] | None -> tr_default) - | Sil.Var id -> + | Exp.Var id -> (match TypeState.lookup_id id typestate with | Some tr -> TypeState.range_add_locs tr [loc] | None -> tr_default) - | Sil.Const (Const.Cint i) when IntLit.iszero i -> + | Exp.Const (Const.Cint i) when IntLit.iszero i -> let (typ, _, locs) = tr_default in if PatternMatch.type_is_class typ then (typ, TypeAnnotation.const Annotations.Nullable true (TypeOrigin.Const loc), locs) else let t, ta, ll = tr_default in (t, TypeAnnotation.with_origin ta (TypeOrigin.Const loc), ll) - | Sil.Exn e1 -> + | Exp.Exn e1 -> typecheck_expr find_canonical_duplicate visited checks node instr_ref curr_pname typestate e1 tr_default loc - | Sil.Const _ -> + | Exp.Const _ -> let (typ, _, locs) = tr_default in (typ, TypeAnnotation.const Annotations.Nullable false (TypeOrigin.Const loc), locs) - | Sil.Lfield (exp, fn, typ) -> + | Exp.Lfield (exp, fn, typ) -> let _, _, locs = tr_default in let (_, ta, locs') = typecheck_expr @@ -203,7 +203,7 @@ let rec typecheck_expr EradicateChecks.check_field_access find_canonical_duplicate curr_pname node instr_ref exp fn ta loc; tr_new - | Sil.Lindex (array_exp, index_exp) -> + | Exp.Lindex (array_exp, index_exp) -> let (_, ta, _) = typecheck_expr find_canonical_duplicate @@ -260,20 +260,20 @@ let typecheck_instr Some (TypeAnnotation.get_origin ta) | None -> None in let handle_temporary e = match Idenv.expand_expr idenv e with - | Sil.Lvar pvar when name_is_temporary (Pvar.to_string pvar) -> + | Exp.Lvar pvar when name_is_temporary (Pvar.to_string pvar) -> begin match pvar_get_origin pvar with | Some (TypeOrigin.Formal s) -> let pvar' = Pvar.mk s curr_pname in - Some (Sil.Lvar pvar') + Some (Exp.Lvar pvar') | _ -> None end | _ -> None in match exp with - | Sil.Lfield (e, fn, typ) -> + | Exp.Lfield (e, fn, typ) -> let exp' = match handle_temporary e with | Some e' -> - Sil.Lfield (e', fn, typ) + Exp.Lfield (e', fn, typ) | None -> exp in exp' | _ -> exp in @@ -303,7 +303,7 @@ let typecheck_instr (* Convert a function call to a pvar. *) let handle_function_call call_node id = match Errdesc.find_normal_variable_funcall call_node id with - | Some (Sil.Const (Const.Cfun pn), _, _, _) + | Some (Exp.Const (Const.Cfun pn), _, _, _) when not (ComplexExpressions.procname_used_in_condition pn) -> begin match ComplexExpressions.exp_to_string node' exp with @@ -319,16 +319,16 @@ let typecheck_instr if is_assignment && already_defined_in_typestate then default (* Don't overwrite pvar representing result of function call. *) - else Sil.Lvar pvar, typestate + else Exp.Lvar pvar, typestate end | _ -> default in match exp with - | Sil.Var id when + | Exp.Var id when ComplexExpressions.functions_idempotent () && Errdesc.find_normal_variable_funcall node' id <> None -> handle_function_call node' id - | Sil.Lvar pvar when + | Exp.Lvar pvar when ComplexExpressions.functions_idempotent () && Pvar.is_frontend_tmp pvar -> let frontend_variable_assignment = Errdesc.find_program_variable_assignment node pvar in @@ -340,9 +340,9 @@ let typecheck_instr | _ -> default end - | Sil.Lvar _ -> + | Exp.Lvar _ -> default - | Sil.Lfield (_exp, fn, typ) when ComplexExpressions.parameter_and_static_field () -> + | Exp.Lfield (_exp, fn, typ) when ComplexExpressions.parameter_and_static_field () -> let exp' = Idenv.expand_expr_temps idenv node _exp in let is_parameter_field pvar = (* parameter.field *) @@ -354,29 +354,29 @@ let typecheck_instr Pvar.is_global pvar in let pvar_to_str pvar = - if Sil.exp_is_this (Sil.Lvar pvar) then "" + if Sil.exp_is_this (Exp.Lvar pvar) then "" else Pvar.to_string pvar ^ "_" in let res = match exp' with - | Sil.Lvar pv when is_parameter_field pv || is_static_field pv -> + | Exp.Lvar pv when is_parameter_field pv || is_static_field pv -> let fld_name = pvar_to_str pv ^ Ident.fieldname_to_string fn in let pvar = Pvar.mk (Mangled.from_string fld_name) curr_pname in let typestate' = update_typestate_fld pvar fn typ in - (Sil.Lvar pvar, typestate') - | Sil.Lfield (_exp', fn', _) when Ident.java_fieldname_is_outer_instance fn' -> + (Exp.Lvar pvar, typestate') + | Exp.Lfield (_exp', fn', _) when Ident.java_fieldname_is_outer_instance fn' -> (* handle double dereference when accessing a field from an outer class *) let fld_name = Ident.fieldname_to_string fn' ^ "_" ^ Ident.fieldname_to_string fn in let pvar = Pvar.mk (Mangled.from_string fld_name) curr_pname in let typestate' = update_typestate_fld pvar fn typ in - (Sil.Lvar pvar, typestate') - | Sil.Lvar _ | Sil.Lfield _ when ComplexExpressions.all_nested_fields () -> + (Exp.Lvar pvar, typestate') + | Exp.Lvar _ | Exp.Lfield _ when ComplexExpressions.all_nested_fields () -> (* treat var.field1. ... .fieldn as a constant *) begin match ComplexExpressions.exp_to_string node' exp with | Some exp_str -> let pvar = Pvar.mk (Mangled.from_string exp_str) curr_pname in let typestate' = update_typestate_fld pvar fn typ in - (Sil.Lvar pvar, typestate') + (Exp.Lvar pvar, typestate') | None -> default end @@ -449,10 +449,10 @@ let typecheck_instr typestate' | Some (node', id) -> (* handle the case where pvar is a frontend-generated program variable *) - let exp = Idenv.expand_expr idenv (Sil.Var id) in + let exp = Idenv.expand_expr idenv (Exp.Var id) in begin match convert_complex_exp_to_pvar node' false exp typestate' loc with - | Sil.Lvar pvar', _ -> handle_pvar typestate' pvar' + | Exp.Lvar pvar', _ -> handle_pvar typestate' pvar' | _ -> typestate' end in @@ -482,14 +482,14 @@ let typecheck_instr TypeState.add_id id (typecheck_expr_simple typestate' e' typ TypeOrigin.Undef loc) typestate' - | Sil.Set (Sil.Lvar pvar, _, Sil.Exn _, _) when is_return pvar -> + | Sil.Set (Exp.Lvar pvar, _, Exp.Exn _, _) when is_return pvar -> (* skip assignment to return variable where it is an artifact of a throw instruction *) typestate | Sil.Set (e1, typ, e2, loc) -> typecheck_expr_for_errors typestate e1 loc; let e1', typestate1 = convert_complex_exp_to_pvar node true e1 typestate loc in let check_field_assign () = match e1 with - | Sil.Lfield (_, fn, f_typ) -> + | Exp.Lfield (_, fn, f_typ) -> let t_ia_opt = EradicateChecks.get_field_annotation fn f_typ in if checks.eradicate then EradicateChecks.check_field_assignment @@ -499,25 +499,25 @@ let typecheck_instr | _ -> () in let typestate2 = match e1' with - | Sil.Lvar pvar -> + | Exp.Lvar pvar -> TypeState.add pvar (typecheck_expr_simple typestate1 e2 typ TypeOrigin.Undef loc) typestate1 - | Sil.Lfield _ -> + | Exp.Lfield _ -> typestate1 | _ -> typestate1 in check_field_assign (); typestate2 - | Sil.Call ([id], Sil.Const (Const.Cfun pn), [(_, typ)], loc, _) + | Sil.Call ([id], Exp.Const (Const.Cfun pn), [(_, typ)], loc, _) when Procname.equal pn ModelBuiltins.__new || Procname.equal pn ModelBuiltins.__new_array -> TypeState.add_id id (typ, TypeAnnotation.const Annotations.Nullable false TypeOrigin.New, [loc]) typestate (* new never returns null *) - | Sil.Call ([id], Sil.Const (Const.Cfun pn), (e, typ):: _, loc, _) + | Sil.Call ([id], Exp.Const (Const.Cfun pn), (e, typ):: _, loc, _) when Procname.equal pn ModelBuiltins.__cast -> typecheck_expr_for_errors typestate e loc; let e', typestate' = @@ -526,7 +526,7 @@ let typecheck_instr TypeState.add_id id (typecheck_expr_simple typestate' e' typ TypeOrigin.ONone loc) typestate' - | Sil.Call ([id], Sil.Const (Const.Cfun pn), [(array_exp, t)], loc, _) + | Sil.Call ([id], Exp.Const (Const.Cfun pn), [(array_exp, t)], loc, _) when Procname.equal pn ModelBuiltins.__get_array_length -> let (_, ta, _) = typecheck_expr find_canonical_duplicate @@ -558,11 +558,11 @@ let typecheck_instr [loc] ) typestate - | Sil.Call (_, Sil.Const (Const.Cfun pn), _, _, _) when Builtin.is_registered pn -> + | Sil.Call (_, Exp.Const (Const.Cfun pn), _, _, _) when Builtin.is_registered pn -> typestate (* skip othe builtins *) | Sil.Call (ret_ids, - Sil.Const (Const.Cfun ((Procname.Java callee_pname_java) as callee_pname)), + Exp.Const (Const.Cfun ((Procname.Java callee_pname_java) as callee_pname)), etl_, loc, cflags) @@ -651,7 +651,7 @@ let typecheck_instr not (TypeAnnotation.origin_is_fun_library ta) in if checks.eradicate && should_report then begin - let cond = Sil.BinOp (Binop.Ne, Sil.Lvar pvar, Sil.exp_null) in + let cond = Exp.BinOp (Binop.Ne, Exp.Lvar pvar, Sil.exp_null) in EradicateChecks.report_error find_canonical_duplicate node @@ -668,7 +668,7 @@ let typecheck_instr typestate' in let rec find_parameter n eetl1 = match n, eetl1 with | n, _ :: eetl2 when n > 1 -> find_parameter (n -1) eetl2 - | 1, ((_, Sil.Lvar pvar), typ):: _ -> Some (pvar, typ) + | 1, ((_, Exp.Lvar pvar), typ):: _ -> Some (pvar, typ) | _ -> None in match find_parameter parameter_num call_params with @@ -676,7 +676,7 @@ let typecheck_instr if is_vararg then let do_vararg_value e ts = match Idenv.expand_expr idenv e with - | Sil.Lvar pvar1 -> + | Exp.Lvar pvar1 -> pvar_apply loc clear_nullable_flag ts pvar1 | _ -> ts in let vararg_values = PatternMatch.java_get_vararg_values node pvar idenv in @@ -705,13 +705,13 @@ let typecheck_instr let handle_negated_condition cond_node = let do_instr = function - | Sil.Prune (Sil.BinOp (Binop.Eq, _cond_e, Sil.Const (Const.Cint i)), _, _, _) - | Sil.Prune (Sil.BinOp (Binop.Eq, Sil.Const (Const.Cint i), _cond_e), _, _, _) + | Sil.Prune (Exp.BinOp (Binop.Eq, _cond_e, Exp.Const (Const.Cint i)), _, _, _) + | Sil.Prune (Exp.BinOp (Binop.Eq, Exp.Const (Const.Cint i), _cond_e), _, _, _) when IntLit.iszero i -> let cond_e = Idenv.expand_expr_temps idenv cond_node _cond_e in begin match convert_complex_exp_to_pvar cond_node false cond_e typestate' loc with - | Sil.Lvar pvar', _ -> + | Exp.Lvar pvar', _ -> set_flag pvar' Annotations.Nullable false | _ -> () end @@ -719,11 +719,11 @@ let typecheck_instr IList.iter do_instr (Cfg.Node.get_instrs cond_node) in let handle_optional_isPresent node' e = match convert_complex_exp_to_pvar node' false e typestate' loc with - | Sil.Lvar pvar', _ -> + | Exp.Lvar pvar', _ -> set_flag pvar' Annotations.Present true | _ -> () in match call_params with - | ((_, Sil.Lvar pvar), _):: _ -> + | ((_, Exp.Lvar pvar), _):: _ -> (* temporary variable for the value of the boolean condition *) begin let curr_node = TypeErr.InstrRef.get_node instr_ref in @@ -741,7 +741,7 @@ let typecheck_instr () | Some (node', id) -> let () = match Errdesc.find_normal_variable_funcall node' id with - | Some (Sil.Const (Const.Cfun pn), [e], _, _) + | Some (Exp.Const (Const.Cfun pn), [e], _, _) when ComplexExpressions.procname_optional_isPresent pn -> handle_optional_isPresent node' e | _ -> () in @@ -763,7 +763,7 @@ let typecheck_instr object_t) parameters in match call_params with - | ((_, Sil.Lvar pv_map), _) :: + | ((_, Exp.Lvar pv_map), _) :: ((_, exp_key), _) :: ((_, exp_value), typ_value) :: _ -> (* Convert the dexp for k to the dexp for m.get(k) *) @@ -867,12 +867,12 @@ let typecheck_instr | Sil.Prune (cond, loc, true_branch, _) -> let rec check_condition node' c : _ TypeState.t = (* check if the expression is coming from a call, and return the argument *) - let from_call filter_callee e : Sil.exp option = + let from_call filter_callee e : Exp.t option = match e with - | Sil.Var id -> + | Exp.Var id -> begin match Errdesc.find_normal_variable_funcall node' id with - | Some (Sil.Const (Const.Cfun pn), e1:: _, _, _) when + | Some (Exp.Const (Const.Cfun pn), e1:: _, _, _) when filter_callee pn -> Some e1 | _ -> None @@ -880,23 +880,23 @@ let typecheck_instr | _ -> None in (* check if the expression is coming from instanceof *) - let from_instanceof e : Sil.exp option = + let from_instanceof e : Exp.t option = from_call ComplexExpressions.procname_instanceof e in (* check if the expression is coming from Optional.isPresent *) - let from_optional_isPresent e : Sil.exp option = + let from_optional_isPresent e : Exp.t option = from_call ComplexExpressions.procname_optional_isPresent e in (* check if the expression is coming from a procedure returning false on null *) - let from_is_false_on_null e : Sil.exp option = + let from_is_false_on_null e : Exp.t option = from_call ComplexExpressions.procname_is_false_on_null e in (* check if the expression is coming from a procedure returning true on null *) - let from_is_true_on_null e : Sil.exp option = + let from_is_true_on_null e : Exp.t option = from_call ComplexExpressions.procname_is_true_on_null e in (* check if the expression is coming from Map.containsKey *) - let from_containsKey e : Sil.exp option = + let from_containsKey e : Exp.t option = from_call ComplexExpressions.procname_containsKey e in (* Turn x.containsKey(e) into the pvar for x.get(e) *) @@ -919,7 +919,7 @@ let typecheck_instr | Some e_str -> let pvar = Pvar.mk (Mangled.from_string e_str) curr_pname in - let e1 = Sil.Lvar pvar in + let e1 = Exp.Lvar pvar in let (typ, ta, _) = typecheck_expr_simple typestate e1 Typ.Tvoid TypeOrigin.ONone loc in let range = (typ, ta, [loc]) in @@ -939,13 +939,13 @@ let typecheck_instr else typestate' | None -> typestate' in match e' with - | Sil.Lvar pvar -> + | Exp.Lvar pvar -> pvar_apply loc handle_pvar typestate2 pvar | _ -> typestate2 in match c with - | Sil.BinOp (Binop.Eq, Sil.Const (Const.Cint i), e) - | Sil.BinOp (Binop.Eq, e, Sil.Const (Const.Cint i)) when IntLit.iszero i -> + | Exp.BinOp (Binop.Eq, Exp.Const (Const.Cint i), e) + | Exp.BinOp (Binop.Eq, e, Exp.Const (Const.Cint i)) when IntLit.iszero i -> typecheck_expr_for_errors typestate e loc; let typestate1, e1, from_call = match from_is_true_on_null e with | Some e1 -> @@ -973,8 +973,8 @@ let typecheck_instr typestate2 end - | Sil.BinOp (Binop.Ne, Sil.Const (Const.Cint i), e) - | Sil.BinOp (Binop.Ne, e, Sil.Const (Const.Cint i)) when IntLit.iszero i -> + | Exp.BinOp (Binop.Ne, Exp.Const (Const.Cint i), e) + | Exp.BinOp (Binop.Ne, e, Exp.Const (Const.Cint i)) when IntLit.iszero i -> typecheck_expr_for_errors typestate e loc; let typestate1, e1, from_call = match from_instanceof e with | Some e1 -> (* (e1 instanceof C) implies (e1 != null) *) @@ -1023,10 +1023,10 @@ let typecheck_instr else typestate2 end - | Sil.UnOp (Unop.LNot, (Sil.BinOp (Binop.Eq, e1, e2)), _) -> - check_condition node' (Sil.BinOp (Binop.Ne, e1, e2)) - | Sil.UnOp (Unop.LNot, (Sil.BinOp (Binop.Ne, e1, e2)), _) -> - check_condition node' (Sil.BinOp (Binop.Eq, e1, e2)) + | Exp.UnOp (Unop.LNot, (Exp.BinOp (Binop.Eq, e1, e2)), _) -> + check_condition node' (Exp.BinOp (Binop.Ne, e1, e2)) + | Exp.UnOp (Unop.LNot, (Exp.BinOp (Binop.Ne, e1, e2)), _) -> + check_condition node' (Exp.BinOp (Binop.Eq, e1, e2)) | _ -> typestate in (* Handle assigment fron a temp pvar in a condition. @@ -1037,7 +1037,7 @@ let typecheck_instr let found = ref None in let do_instr i = match i with | Sil.Set (e, _, e', _) - when Sil.exp_equal (Sil.Lvar pvar) (Idenv.expand_expr idenv e') -> + when Sil.exp_equal (Exp.Lvar pvar) (Idenv.expand_expr idenv e') -> found := Some e | _ -> () in IList.iter do_instr (Cfg.Node.get_instrs prev_node); @@ -1046,22 +1046,22 @@ let typecheck_instr (* Normalize the condition by resolving temp variables. *) let rec normalize_cond _node _cond = match _cond with - | Sil.UnOp (Unop.LNot, c, top) -> + | Exp.UnOp (Unop.LNot, c, top) -> let node', c' = normalize_cond _node c in - node', Sil.UnOp (Unop.LNot, c', top) - | Sil.BinOp (bop, c1, c2) -> + node', Exp.UnOp (Unop.LNot, c', top) + | Exp.BinOp (bop, c1, c2) -> let node', c1' = normalize_cond _node c1 in let node'', c2' = normalize_cond node' c2 in - node'', Sil.BinOp (bop, c1', c2') - | Sil.Var _ -> + node'', Exp.BinOp (bop, c1', c2') + | Exp.Var _ -> let c' = Idenv.expand_expr idenv _cond in if not (Sil.exp_equal c' _cond) then normalize_cond _node c' else _node, c' - | Sil.Lvar pvar when Pvar.is_frontend_tmp pvar -> + | Exp.Lvar pvar when Pvar.is_frontend_tmp pvar -> (match handle_assignment_in_condition pvar with | None -> (match Errdesc.find_program_variable_assignment _node pvar with - | Some (node', id) -> node', Sil.Var id + | Some (node', id) -> node', Exp.Var id | None -> _node, _cond) | Some e2 -> _node, e2) | c -> _node, c in @@ -1081,7 +1081,7 @@ let typecheck_node let typestates_exn = ref [] in let handle_exceptions typestate instr = match instr with - | Sil.Call (_, Sil.Const (Const.Cfun callee_pname), _, _, _) -> + | Sil.Call (_, Exp.Const (Const.Cfun callee_pname), _, _, _) -> let callee_attributes_opt = Specs.proc_resolve_attributes callee_pname in (* check if the call might throw an exception *) @@ -1091,7 +1091,7 @@ let typecheck_node | None -> false in if has_exceptions then typestates_exn := typestate :: !typestates_exn - | Sil.Set (Sil.Lvar pv, _, _, _) when + | Sil.Set (Exp.Lvar pv, _, _, _) when Pvar.is_return pv && Cfg.Node.get_kind node = Cfg.Node.throw_kind -> (* throw instruction *) diff --git a/infer/src/eradicate/typeState.ml b/infer/src/eradicate/typeState.ml index 3965d98e4..a745c65e7 100644 --- a/infer/src/eradicate/typeState.ml +++ b/infer/src/eradicate/typeState.ml @@ -16,7 +16,7 @@ module P = Printf (** Module for typestates: maps from expressions to annotated types, with extensions. *) (** Parameters of a call. *) -type parameters = (Sil.exp * Typ.t) list +type parameters = (Exp.t * Typ.t) list type get_proc_desc = Procname.t -> Cfg.Procdesc.t option @@ -34,7 +34,7 @@ type 'a ext = module M = Map.Make (struct - type t = Sil.exp + type t = Exp.t let compare = Sil.exp_compare end) type range = Typ.t * TypeAnnotation.t * (Location.t list) @@ -130,25 +130,25 @@ let join ext t1 t2 = } let lookup_id id typestate = - try Some (M.find (Sil.Var id) typestate.map) + try Some (M.find (Exp.Var id) typestate.map) with Not_found -> None let lookup_pvar pvar typestate = - try Some (M.find (Sil.Lvar pvar) typestate.map) + try Some (M.find (Exp.Lvar pvar) typestate.map) with Not_found -> None let add_id id range typestate = - let map' = M.add (Sil.Var id) range typestate.map in + let map' = M.add (Exp.Var id) range typestate.map in if map' == typestate.map then typestate else { typestate with map = map' } let add pvar range typestate = - let map' = M.add (Sil.Lvar pvar) range typestate.map in + let map' = M.add (Exp.Lvar pvar) range typestate.map in if map' == typestate.map then typestate else { typestate with map = map' } let remove_id id typestate = - let map' = M.remove (Sil.Var id) typestate.map in + let map' = M.remove (Exp.Var id) typestate.map in if map' == typestate.map then typestate else { typestate with map = map' } diff --git a/infer/src/eradicate/typeState.mli b/infer/src/eradicate/typeState.mli index 32c2fe7d8..f35b3f646 100644 --- a/infer/src/eradicate/typeState.mli +++ b/infer/src/eradicate/typeState.mli @@ -12,7 +12,7 @@ open! Utils (** Module for typestates: maps from expressions to annotated types, with extensions. *) (** Parameters of a call. *) -type parameters = (Sil.exp * Typ.t) list +type parameters = (Exp.t * Typ.t) list type get_proc_desc = Procname.t -> Cfg.Procdesc.t option diff --git a/infer/src/harness/inhabit.ml b/infer/src/harness/inhabit.ml index deff9514d..014027ca8 100644 --- a/infer/src/harness/inhabit.ml +++ b/infer/src/harness/inhabit.ml @@ -24,7 +24,7 @@ type lifecycle_trace = (Procname.t * Typ.t option) list (** list of instrs and temporary variables created during inhabitation and a cache of types that * have already been inhabited *) type env = { instrs : Sil.instr list; - cache : Sil.exp TypMap.t; + cache : Exp.t TypMap.t; (* set of types currently being inhabited. consult to prevent infinite recursion *) cur_inhabiting : TypSet.t; pc : Location.t; @@ -52,7 +52,7 @@ let env_add_instr instr env = (** call flags for an allocation or call to a constructor *) let cf_alloc = CallFlags.default -let fun_exp_from_name proc_name = Sil.Const (Const.Cfun (proc_name)) +let fun_exp_from_name proc_name = Exp.Const (Const.Cfun (proc_name)) let local_name_cntr = ref 0 @@ -70,10 +70,10 @@ let get_non_receiver_formals formals = tl_or_empty formals * component but the size component of ret_typ is always -1. *) let inhabit_alloc sizeof_typ sizeof_len ret_typ alloc_kind env = let retval = Ident.create_fresh Ident.knormal in - let inhabited_exp = Sil.Var retval in + let inhabited_exp = Exp.Var retval in let call_instr = let fun_new = fun_exp_from_name alloc_kind in - let sizeof_exp = Sil.Sizeof (sizeof_typ, sizeof_len, Subtype.exact) in + let sizeof_exp = Exp.Sizeof (sizeof_typ, sizeof_len, Subtype.exact) in let args = [(sizeof_exp, Typ.Tptr (ret_typ, Typ.Pk_pointer))] in Sil.Call ([retval], fun_new, args, env.pc, cf_alloc) in (inhabited_exp, env_add_instr call_instr env) @@ -85,7 +85,7 @@ let rec inhabit_typ typ cfg env = with Not_found -> let inhabit_internal typ env = match typ with | Typ.Tptr (Typ.Tarray (inner_typ, Some _), Typ.Pk_pointer) -> - let len = Sil.Const (Const.Cint (IntLit.one)) in + let len = Exp.Const (Const.Cint (IntLit.one)) in let arr_typ = Typ.Tarray (inner_typ, Some IntLit.one) in inhabit_alloc arr_typ (Some len) typ ModelBuiltins.__new_array env | Typ.Tptr (typ, Typ.Pk_pointer) as ptr_to_typ -> @@ -123,15 +123,15 @@ let rec inhabit_typ typ cfg env = * both fresh. the only point of this is to add a descriptive local name that makes error * reports from the harness look nicer -- it's not necessary to make symbolic execution work *) let fresh_local_exp = - Sil.Lvar (Pvar.mk typ_class_name (Procname.Java env.harness_name)) in + Exp.Lvar (Pvar.mk typ_class_name (Procname.Java env.harness_name)) in let write_to_local_instr = Sil.Set (fresh_local_exp, ptr_to_typ, allocated_obj_exp, env.pc) in let env' = env_add_instr write_to_local_instr env in let fresh_id = Ident.create_fresh Ident.knormal in let read_from_local_instr = Sil.Letderef (fresh_id, fresh_local_exp, ptr_to_typ, env'.pc) in - (Sil.Var fresh_id, env_add_instr read_from_local_instr env') - | Typ.Tint (_) -> (Sil.Const (Const.Cint (IntLit.zero)), env) - | Typ.Tfloat (_) -> (Sil.Const (Const.Cfloat 0.0), env) + (Exp.Var fresh_id, env_add_instr read_from_local_instr env') + | Typ.Tint (_) -> (Exp.Const (Const.Cint (IntLit.zero)), env) + | Typ.Tfloat (_) -> (Exp.Const (Const.Cfloat 0.0), env) | typ -> L.err "Couldn't inhabit typ: %a@." (Typ.pp pe_text) typ; assert false in diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index fcf187245..d8aa690a5 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -398,10 +398,10 @@ let use_static_final_fields context = (not Config.no_static_final) && (JContext.get_meth_kind context) <> JContext.Init let builtin_new = - Sil.Const (Const.Cfun ModelBuiltins.__new) + Exp.Const (Const.Cfun ModelBuiltins.__new) let builtin_get_array_length = - Sil.Const (Const.Cfun ModelBuiltins.__get_array_length) + Exp.Const (Const.Cfun ModelBuiltins.__get_array_length) let create_sil_deref exp typ loc = let no_id = Ident.create_none () in @@ -417,8 +417,8 @@ let rec expression context pc expr = let type_of_expr = JTransType.expr_type context expr in let trans_var pvar = let id = Ident.create_fresh Ident.knormal in - let sil_instr = Sil.Letderef (id, Sil.Lvar pvar, type_of_expr, loc) in - ([sil_instr], Sil.Var id, type_of_expr) in + let sil_instr = Sil.Letderef (id, Exp.Lvar pvar, type_of_expr, loc) in + ([sil_instr], Exp.Var id, type_of_expr) in match expr with | JBir.Var (_, var) -> let pvar = (JContext.set_pvar context var type_of_expr) in @@ -431,14 +431,14 @@ let rec expression context pc expr = let procname = (Cfg.Procdesc.get_proc_name (JContext.get_procdesc context)) in let pvar = Pvar.mk varname procname in trans_var pvar - | _ -> ([], Sil.Const (get_constant c), type_of_expr) + | _ -> ([], Exp.Const (get_constant c), type_of_expr) end | JBir.Unop (unop, ex) -> let type_of_ex = JTransType.expr_type context ex in let (instrs, sil_ex, _) = expression context pc ex in begin match unop with - | JBir.Neg _ -> (instrs, Sil.UnOp (Unop.Neg, sil_ex, Some type_of_expr), type_of_expr) + | JBir.Neg _ -> (instrs, Exp.UnOp (Unop.Neg, sil_ex, Some type_of_expr), type_of_expr) | JBir.ArrayLength -> let array_typ_no_ptr = match type_of_ex with @@ -449,9 +449,9 @@ let rec expression context pc expr = let ret_id = Ident.create_fresh Ident.knormal in let call_instr = Sil.Call ([ret_id], builtin_get_array_length, args, loc, CallFlags.default) in - (instrs @ [deref; call_instr], Sil.Var ret_id, type_of_expr) + (instrs @ [deref; call_instr], Exp.Var ret_id, type_of_expr) | JBir.Conv conv -> - let cast_ex = Sil.Cast (JTransType.cast_type conv, sil_ex) in + let cast_ex = Exp.Cast (JTransType.cast_type conv, sil_ex) in (instrs, cast_ex, type_of_expr) | JBir.InstanceOf ot | JBir.Cast ot -> let subtypes = @@ -463,13 +463,13 @@ let rec expression context pc expr = JTransType.sizeof_of_object_type program tenv ot subtypes in let builtin = (match unop with - | JBir.InstanceOf _ -> Sil.Const (Const.Cfun ModelBuiltins.__instanceof) - | JBir.Cast _ -> Sil.Const (Const.Cfun ModelBuiltins.__cast) + | JBir.InstanceOf _ -> Exp.Const (Const.Cfun ModelBuiltins.__instanceof) + | JBir.Cast _ -> Exp.Const (Const.Cfun ModelBuiltins.__cast) | _ -> assert false) in let args = [(sil_ex, type_of_ex); (sizeof_expr, Typ.Tvoid)] in let ret_id = Ident.create_fresh Ident.knormal in let call = Sil.Call([ret_id], builtin, args, loc, CallFlags.default) in - let res_ex = Sil.Var ret_id in + let res_ex = Exp.Var ret_id in (instrs @ [call], res_ex, type_of_expr) end | JBir.Binop (binop, ex1, ex2) -> @@ -483,27 +483,27 @@ let rec expression context pc expr = let deref_array_instr = create_sil_deref sil_ex1 array_typ loc in let id = Ident.create_fresh Ident.knormal in let letderef_instr = - Sil.Letderef (id, Sil.Lindex (sil_ex1, sil_ex2), type_of_expr, loc) in + Sil.Letderef (id, Exp.Lindex (sil_ex1, sil_ex2), type_of_expr, loc) in let instrs = (instrs1 @ (deref_array_instr :: instrs2)) @ [letderef_instr] in - instrs, Sil.Var id, type_of_expr + instrs, Exp.Var id, type_of_expr | other_binop -> let sil_binop = get_binop other_binop in - let sil_expr = Sil.BinOp (sil_binop, sil_ex1, sil_ex2) in + let sil_expr = Exp.BinOp (sil_binop, sil_ex1, sil_ex2) in ((instrs1 @ instrs2), sil_expr, type_of_expr) end | JBir.Field (ex, cn, fs) -> let (instrs, sil_expr, _) = expression context pc ex in let field_name = get_field_name program false tenv cn fs in let sil_type = JTransType.get_class_type_no_pointer program tenv cn in - let sil_expr = Sil.Lfield (sil_expr, field_name, sil_type) in + let sil_expr = Exp.Lfield (sil_expr, field_name, sil_type) in let tmp_id = Ident.create_fresh Ident.knormal in let lderef_instr = Sil.Letderef (tmp_id, sil_expr, sil_type, loc) in - (instrs @ [lderef_instr], Sil.Var tmp_id, type_of_expr) + (instrs @ [lderef_instr], Exp.Var tmp_id, type_of_expr) | JBir.StaticField (cn, fs) -> let class_exp = let classname = Mangled.from_string (JBasics.cn_name cn) in let var_name = Pvar.mk_global classname in - Sil.Lvar var_name in + Exp.Lvar var_name in let (instrs, sil_expr) = [], class_exp in let field_name = get_field_name program true tenv cn fs in let sil_type = JTransType.get_class_type_no_pointer program tenv cn in @@ -527,10 +527,10 @@ let rec expression context pc expr = (* Infer to understand the assert keyword in the expected way *) (instrs, Sil.exp_zero, type_of_expr) else - let sil_expr = Sil.Lfield (sil_expr, field_name, sil_type) in + let sil_expr = Exp.Lfield (sil_expr, field_name, sil_type) in let tmp_id = Ident.create_fresh Ident.knormal in let lderef_instr = Sil.Letderef (tmp_id, sil_expr, sil_type, loc) in - (instrs @ [lderef_instr], Sil.Var tmp_id, type_of_expr) + (instrs @ [lderef_instr], Exp.Var tmp_id, type_of_expr) let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_code method_kind = (* This function tries to recursively search for the classname of the class *) @@ -571,7 +571,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_ | I_Special -> false | _ -> true in match sil_obj_expr with - | Sil.Var _ when is_non_constructor_call && not Config.report_runtime_exceptions -> + | Exp.Var _ when is_non_constructor_call && not Config.report_runtime_exceptions -> let obj_typ_no_ptr = match sil_obj_type with | Typ.Tptr (typ, _) -> typ @@ -593,7 +593,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_ then proc else Procname.Java (JTransType.get_method_procname cn' ms method_kind) in let call_instrs = - let callee_fun = Sil.Const (Const.Cfun callee_procname) in + let callee_fun = Exp.Const (Const.Cfun callee_procname) in let return_type = match JBasics.ms_rtype ms with | None -> Typ.Tvoid @@ -601,7 +601,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_ let call_ret_instrs sil_var = let ret_id = Ident.create_fresh Ident.knormal in let call_instr = Sil.Call ([ret_id], callee_fun, call_args, loc, call_flags) in - let set_instr = Sil.Set (Sil.Lvar sil_var, return_type, Sil.Var ret_id, loc) in + let set_instr = Sil.Set (Exp.Lvar sil_var, return_type, Exp.Var ret_id, loc) in (instrs @ [call_instr; set_instr]) in match var_opt with | None -> @@ -619,7 +619,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_ | (_, typ) as exp :: _ when Procname.is_constructor callee_procname && JTransType.is_closeable program tenv typ -> let set_file_attr = - let set_builtin = Sil.Const (Const.Cfun ModelBuiltins.__set_file_attribute) in + let set_builtin = Exp.Const (Const.Cfun ModelBuiltins.__set_file_attribute) in Sil.Call ([], set_builtin, [exp], loc, CallFlags.default) in (* Exceptions thrown in the constructor should prevent adding the resource attribute *) call_instrs @ [set_file_attr] @@ -628,7 +628,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_ | (_, typ) as exp :: [] when Procname.java_is_close callee_procname && JTransType.is_closeable program tenv typ -> let set_mem_attr = - let set_builtin = Sil.Const (Const.Cfun ModelBuiltins.__set_mem_attribute) in + let set_builtin = Exp.Const (Const.Cfun ModelBuiltins.__set_mem_attribute) in Sil.Call ([], set_builtin, [exp], loc, CallFlags.default) in (* Exceptions thrown in the close method should not prevent the resource from being *) (* considered as closed *) @@ -649,7 +649,7 @@ let get_array_length context pc expr_list content_type = (Typ.Tarray (content_type, None), Some sil_len_expr) in let array_type, array_len = IList.fold_right get_array_type_len sil_len_exprs (content_type, None) in - let array_size = Sil.Sizeof (array_type, array_len, Subtype.exact) in + let array_size = Exp.Sizeof (array_type, array_len, Subtype.exact) in (instrs, array_size) let detect_loop entry_pc impl = @@ -759,9 +759,9 @@ let is_this expr = let assume_not_null loc sil_expr = - let builtin_infer_assume = Sil.Const (Const.Cfun ModelBuiltins.__infer_assume) in + let builtin_infer_assume = Exp.Const (Const.Cfun ModelBuiltins.__infer_assume) in let not_null_expr = - Sil.BinOp (Binop.Ne, sil_expr, Sil.exp_null) in + Exp.BinOp (Binop.Ne, sil_expr, Sil.exp_null) in let assume_call_flag = { CallFlags.default with CallFlags.cf_noreturn = true; } in let call_args = [(not_null_expr, Typ.Tint Typ.IBool)] in Sil.Call ([], builtin_infer_assume, call_args, loc, assume_call_flag) @@ -793,7 +793,7 @@ let rec instruction context pc instr : translation = JTransType.never_returning_null in let trans_monitor_enter_exit context expr pc loc builtin node_desc = let instrs, sil_expr, sil_type = expression context pc expr in - let builtin_const = Sil.Const (Const.Cfun builtin) in + let builtin_const = Exp.Const (Const.Cfun builtin) in let instr = Sil.Call ([], builtin_const, [(sil_expr, sil_type)], loc, CallFlags.default) in let typ_no_ptr = match sil_type with | Typ.Tptr (typ, _) -> typ @@ -806,7 +806,7 @@ let rec instruction context pc instr : translation = | JBir.AffectVar (var, expr) -> let (stml, sil_expr, sil_type) = expression context pc expr in let pvar = (JContext.set_pvar context var sil_type) in - let sil_instr = Sil.Set (Sil.Lvar pvar, sil_type, sil_expr, loc) in + let sil_instr = Sil.Set (Exp.Lvar pvar, sil_type, sil_expr, loc) in let node_kind = Cfg.Node.Stmt_node "method_body" in let node = create_node node_kind (stml @ [sil_instr]) in Instr node @@ -819,7 +819,7 @@ let rec instruction context pc instr : translation = | Some expr -> let (stml, sil_expr, _) = expression context pc expr in let sil_instrs = - let return_instr = Sil.Set (Sil.Lvar ret_var, ret_type, sil_expr, loc) in + let return_instr = Sil.Set (Exp.Lvar ret_var, ret_type, sil_expr, loc) in if return_not_null () then [assume_not_null loc sil_expr; return_instr] else @@ -832,7 +832,8 @@ let rec instruction context pc instr : translation = and (instrs_index, sil_expr_index, _) = expression context pc index_ex and (instrs_value, sil_expr_value, _) = expression context pc value_ex in let arr_type_np = JTransType.extract_cn_type_np arr_type in - let sil_instr = Sil.Set (Sil.Lindex (sil_expr_array, sil_expr_index), arr_type_np, sil_expr_value, loc) in + let sil_instr = + Sil.Set (Exp.Lindex (sil_expr_array, sil_expr_index), arr_type_np, sil_expr_value, loc) in let final_instrs = instrs_array @ instrs_index @ instrs_value @ [sil_instr] in let node_kind = Cfg.Node.Stmt_node "method_body" in let node = create_node node_kind final_instrs in @@ -843,7 +844,7 @@ let rec instruction context pc instr : translation = let field_name = get_field_name program false tenv cn fs in let type_of_the_surrounding_class = JTransType.get_class_type_no_pointer program tenv cn in let type_of_the_root_of_e_lhs = type_of_the_surrounding_class in - let expr_off = Sil.Lfield(sil_expr_lhs, field_name, type_of_the_surrounding_class) in + let expr_off = Exp.Lfield(sil_expr_lhs, field_name, type_of_the_surrounding_class) in let sil_instr = Sil.Set (expr_off, type_of_the_root_of_e_lhs, sil_expr_rhs, loc) in let node_kind = Cfg.Node.Stmt_node "method_body" in let node = create_node node_kind (stml1 @ stml2 @ [sil_instr]) in @@ -852,13 +853,13 @@ let rec instruction context pc instr : translation = let class_exp = let classname = Mangled.from_string (JBasics.cn_name cn) in let var_name = Pvar.mk_global classname in - Sil.Lvar var_name in + Exp.Lvar var_name in let (stml1, sil_expr_lhs) = [], class_exp in let (stml2, sil_expr_rhs, _) = expression context pc e_rhs in let field_name = get_field_name program true tenv cn fs in let type_of_the_surrounding_class = JTransType.get_class_type_no_pointer program tenv cn in let type_of_the_root_of_e_lhs = type_of_the_surrounding_class in - let expr_off = Sil.Lfield(sil_expr_lhs, field_name, type_of_the_surrounding_class) in + let expr_off = Exp.Lfield(sil_expr_lhs, field_name, type_of_the_surrounding_class) in let sil_instr = Sil.Set (expr_off, type_of_the_root_of_e_lhs, sil_expr_rhs, loc) in let node_kind = Cfg.Node.Stmt_node "method_body" in let node = create_node node_kind (stml1 @ stml2 @ [sil_instr]) in @@ -872,8 +873,8 @@ let rec instruction context pc instr : translation = let (instrs1, sil_ex1, _) = expression context pc e1 and (instrs2, sil_ex2, _) = expression context pc e2 in let sil_op = get_test_operator op in - let sil_test_false = Sil.BinOp (sil_op, sil_ex1, sil_ex2) in - let sil_test_true = Sil.UnOp(Unop.LNot, sil_test_false, None) in + let sil_test_false = Exp.BinOp (sil_op, sil_ex1, sil_ex2) in + let sil_test_true = Exp.UnOp(Unop.LNot, sil_test_false, None) in let sil_instrs_true = Sil.Prune (sil_test_true, loc, true, Sil.Ik_if) in let sil_instrs_false = Sil.Prune (sil_test_false, loc, false, Sil.Ik_if) in let node_kind_true = Cfg.Node.Prune_node (true, Sil.Ik_if, "method_body") in @@ -890,26 +891,26 @@ let rec instruction context pc instr : translation = Prune (prune_node_true, prune_node_false) | JBir.Throw expr -> let (instrs, sil_expr, _) = expression context pc expr in - let sil_exn = Sil.Exn sil_expr in - let sil_instr = Sil.Set (Sil.Lvar ret_var, ret_type, sil_exn, loc) in + let sil_exn = Exp.Exn sil_expr in + let sil_instr = Sil.Set (Exp.Lvar ret_var, ret_type, sil_exn, loc) in let node = create_node Cfg.Node.throw_kind (instrs @ [sil_instr]) in JContext.add_goto_jump context pc JContext.Exit; Instr node | JBir.New (var, cn, constr_type_list, constr_arg_list) -> - let builtin_new = Sil.Const (Const.Cfun ModelBuiltins.__new) in + let builtin_new = Exp.Const (Const.Cfun ModelBuiltins.__new) in let class_type = JTransType.get_class_type program tenv cn in let class_type_np = JTransType.get_class_type_no_pointer program tenv cn in - let sizeof_exp = Sil.Sizeof (class_type_np, None, Subtype.exact) in + let sizeof_exp = Exp.Sizeof (class_type_np, None, Subtype.exact) in let args = [(sizeof_exp, class_type)] in let ret_id = Ident.create_fresh Ident.knormal in let new_instr = Sil.Call([ret_id], builtin_new, args, loc, CallFlags.default) in let constr_ms = JBasics.make_ms JConfig.constructor_name constr_type_list None in let constr_procname, call_instrs = - let ret_opt = Some (Sil.Var ret_id, class_type) in + let ret_opt = Some (Exp.Var ret_id, class_type) in method_invocation context loc pc None cn constr_ms ret_opt constr_arg_list I_Special Procname.Non_Static in let pvar = JContext.set_pvar context var class_type in - let set_instr = Sil.Set (Sil.Lvar pvar, class_type, Sil.Var ret_id, loc) in + let set_instr = Sil.Set (Exp.Lvar pvar, class_type, Exp.Var ret_id, loc) in let instrs = (new_instr :: call_instrs) @ [set_instr] in let node_kind = Cfg.Node.Stmt_node ("Call "^(Procname.to_string constr_procname)) in let node = create_node node_kind instrs in @@ -917,7 +918,7 @@ let rec instruction context pc instr : translation = Cg.add_edge cg caller_procname constr_procname; Instr node | JBir.NewArray (var, vt, expr_list) -> - let builtin_new_array = Sil.Const (Const.Cfun ModelBuiltins.__new_array) in + let builtin_new_array = Exp.Const (Const.Cfun ModelBuiltins.__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_name = JContext.set_pvar context var array_type in @@ -925,7 +926,7 @@ let rec instruction context pc instr : translation = let call_args = [(array_size, array_type)] in let ret_id = Ident.create_fresh Ident.knormal in let call_instr = Sil.Call([ret_id], builtin_new_array, call_args, loc, CallFlags.default) in - let set_instr = Sil.Set (Sil.Lvar array_name, array_type, Sil.Var ret_id, loc) in + let set_instr = Sil.Set (Exp.Lvar array_name, array_type, Exp.Var ret_id, loc) in let node_kind = Cfg.Node.Stmt_node "method_body" in let node = create_node node_kind (instrs @ [call_instr; set_instr]) in Instr node @@ -1002,27 +1003,27 @@ let rec instruction context pc instr : translation = | JBir.Check (JBir.CheckNullPointer expr) when Config.report_runtime_exceptions -> let (instrs, sil_expr, _) = expression context pc expr in let not_null_node = - let sil_not_null = Sil.BinOp (Binop.Ne, sil_expr, Sil.exp_null) in + let sil_not_null = Exp.BinOp (Binop.Ne, sil_expr, Sil.exp_null) in let sil_prune_not_null = Sil.Prune (sil_not_null, loc, true, Sil.Ik_if) and not_null_kind = Cfg.Node.Prune_node (true, Sil.Ik_if, "Not null") in create_node not_null_kind (instrs @ [sil_prune_not_null]) in let throw_npe_node = - let sil_is_null = Sil.BinOp (Binop.Eq, sil_expr, Sil.exp_null) in + let sil_is_null = Exp.BinOp (Binop.Eq, sil_expr, Sil.exp_null) in let sil_prune_null = Sil.Prune (sil_is_null, loc, true, Sil.Ik_if) and npe_kind = Cfg.Node.Stmt_node "Throw NPE" and npe_cn = JBasics.make_cn JConfig.npe_cl in let class_type = JTransType.get_class_type program tenv npe_cn and class_type_np = JTransType.get_class_type_no_pointer program tenv npe_cn in - let sizeof_exp = Sil.Sizeof (class_type_np, None, Subtype.exact) in + let sizeof_exp = Exp.Sizeof (class_type_np, None, Subtype.exact) in let args = [(sizeof_exp, class_type)] in let ret_id = Ident.create_fresh Ident.knormal in let new_instr = Sil.Call([ret_id], builtin_new, args, loc, CallFlags.default) in let constr_ms = JBasics.make_ms JConfig.constructor_name [] None in let _, call_instrs = - let ret_opt = Some (Sil.Var ret_id, class_type) in + let ret_opt = Some (Exp.Var ret_id, class_type) in method_invocation context loc pc None npe_cn constr_ms ret_opt [] I_Special Procname.Static in - let sil_exn = Sil.Exn (Sil.Var ret_id) in - let set_instr = Sil.Set (Sil.Lvar ret_var, ret_type, sil_exn, loc) in + let sil_exn = Exp.Exn (Exp.Var ret_id) in + let set_instr = Sil.Set (Exp.Lvar ret_var, ret_type, sil_exn, loc) in let npe_instrs = instrs @ [sil_prune_null] @ (new_instr :: call_instrs) @ [set_instr] in create_node npe_kind npe_instrs in Prune (not_null_node, throw_npe_node) @@ -1045,10 +1046,10 @@ let rec instruction context pc instr : translation = let sil_assume_in_bound = let sil_in_bound = let sil_positive_index = - Sil.BinOp (Binop.Ge, sil_index_expr, Sil.Const (Const.Cint IntLit.zero)) + Exp.BinOp (Binop.Ge, sil_index_expr, Exp.Const (Const.Cint IntLit.zero)) and sil_less_than_length = - Sil.BinOp (Binop.Lt, sil_index_expr, sil_length_expr) in - Sil.BinOp (Binop.LAnd, sil_positive_index, sil_less_than_length) in + Exp.BinOp (Binop.Lt, sil_index_expr, sil_length_expr) in + Exp.BinOp (Binop.LAnd, sil_positive_index, sil_less_than_length) in Sil.Prune (sil_in_bound, loc, true, Sil.Ik_if) in create_node in_bound_node_kind (instrs @ [sil_assume_in_bound]) @@ -1058,15 +1059,15 @@ let rec instruction context pc instr : translation = let sil_assume_out_of_bound = let sil_out_of_bound = let sil_negative_index = - Sil.BinOp (Binop.Lt, sil_index_expr, Sil.Const (Const.Cint IntLit.zero)) + Exp.BinOp (Binop.Lt, sil_index_expr, Exp.Const (Const.Cint IntLit.zero)) and sil_greater_than_length = - Sil.BinOp (Binop.Gt, sil_index_expr, sil_length_expr) in - Sil.BinOp (Binop.LOr, sil_negative_index, sil_greater_than_length) in + Exp.BinOp (Binop.Gt, sil_index_expr, sil_length_expr) in + Exp.BinOp (Binop.LOr, sil_negative_index, sil_greater_than_length) in Sil.Prune (sil_out_of_bound, loc, true, Sil.Ik_if) in let out_of_bound_cn = JBasics.make_cn JConfig.out_of_bound_cl in let class_type = JTransType.get_class_type program tenv out_of_bound_cn and class_type_np = JTransType.get_class_type_no_pointer program tenv out_of_bound_cn in - let sizeof_exp = Sil.Sizeof (class_type_np, None, Subtype.exact) in + let sizeof_exp = Exp.Sizeof (class_type_np, None, Subtype.exact) in let args = [(sizeof_exp, class_type)] in let ret_id = Ident.create_fresh Ident.knormal in let new_instr = Sil.Call([ret_id], builtin_new, args, loc, CallFlags.default) in @@ -1074,9 +1075,9 @@ let rec instruction context pc instr : translation = let _, call_instrs = method_invocation context loc pc None out_of_bound_cn constr_ms - (Some (Sil.Var ret_id, class_type)) [] I_Special Procname.Static in - let sil_exn = Sil.Exn (Sil.Var ret_id) in - let set_instr = Sil.Set (Sil.Lvar ret_var, ret_type, sil_exn, loc) in + (Some (Exp.Var ret_id, class_type)) [] I_Special Procname.Static in + let sil_exn = Exp.Exn (Exp.Var ret_id) in + let set_instr = Sil.Set (Exp.Lvar ret_var, ret_type, sil_exn, loc) in let out_of_bound_instrs = instrs @ [sil_assume_out_of_bound] @ (new_instr :: call_instrs) @ [set_instr] in create_node out_of_bound_node_kind out_of_bound_instrs in @@ -1089,32 +1090,32 @@ let rec instruction context pc instr : translation = and ret_id = Ident.create_fresh Ident.knormal and sizeof_expr = JTransType.sizeof_of_object_type program tenv object_type Subtype.subtypes_instof in - let check_cast = Sil.Const (Const.Cfun ModelBuiltins.__instanceof) in + let check_cast = Exp.Const (Const.Cfun ModelBuiltins.__instanceof) in let args = [(sil_expr, sil_type); (sizeof_expr, Typ.Tvoid)] in let call = Sil.Call([ret_id], check_cast, args, loc, CallFlags.default) in - let res_ex = Sil.Var ret_id in + let res_ex = Exp.Var ret_id in let is_instance_node = - let check_is_false = Sil.BinOp (Binop.Ne, res_ex, Sil.exp_zero) in + let check_is_false = Exp.BinOp (Binop.Ne, res_ex, Sil.exp_zero) in let asssume_instance_of = Sil.Prune (check_is_false, loc, true, Sil.Ik_if) and instance_of_kind = Cfg.Node.Prune_node (true, Sil.Ik_if, "Is instance") in create_node instance_of_kind (instrs @ [call; asssume_instance_of]) and throw_cast_exception_node = - let check_is_true = Sil.BinOp (Binop.Ne, res_ex, Sil.exp_one) in + let check_is_true = Exp.BinOp (Binop.Ne, res_ex, Sil.exp_one) in let asssume_not_instance_of = Sil.Prune (check_is_true, loc, true, Sil.Ik_if) and throw_cast_exception_kind = Cfg.Node.Stmt_node "Class cast exception" and cce_cn = JBasics.make_cn JConfig.cce_cl in let class_type = JTransType.get_class_type program tenv cce_cn and class_type_np = JTransType.get_class_type_no_pointer program tenv cce_cn in - let sizeof_exp = Sil.Sizeof (class_type_np, None, Subtype.exact) in + let sizeof_exp = Exp.Sizeof (class_type_np, None, Subtype.exact) in let args = [(sizeof_exp, class_type)] in let ret_id = Ident.create_fresh Ident.knormal in let new_instr = Sil.Call([ret_id], builtin_new, args, loc, CallFlags.default) in let constr_ms = JBasics.make_ms JConfig.constructor_name [] None in let _, call_instrs = method_invocation context loc pc None cce_cn constr_ms - (Some (Sil.Var ret_id, class_type)) [] I_Special Procname.Static in - let sil_exn = Sil.Exn (Sil.Var ret_id) in - let set_instr = Sil.Set (Sil.Lvar ret_var, ret_type, sil_exn, loc) in + (Some (Exp.Var ret_id, class_type)) [] I_Special Procname.Static in + let sil_exn = Exp.Exn (Exp.Var ret_id) in + let set_instr = Sil.Set (Exp.Lvar ret_var, ret_type, sil_exn, loc) in let cce_instrs = instrs @ [call; asssume_not_instance_of] @ (new_instr :: call_instrs) @ [set_instr] in create_node throw_cast_exception_kind cce_instrs in diff --git a/infer/src/java/jTransExn.ml b/infer/src/java/jTransExn.ml index 9a9738e2a..49bdaf6d9 100644 --- a/infer/src/java/jTransExn.ml +++ b/infer/src/java/jTransExn.ml @@ -38,13 +38,13 @@ let translate_exceptions context exit_nodes get_body_nodes handler_table = (* this is removed in the true branches, and in the false branch of the last handler *) let id_exn_val = Ident.create_fresh Ident.knormal in let create_entry_node loc = - let instr_get_ret_val = Sil.Letderef (id_ret_val, Sil.Lvar ret_var, ret_type, loc) in + let instr_get_ret_val = Sil.Letderef (id_ret_val, Exp.Lvar ret_var, ret_type, loc) in let id_deactivate = Ident.create_fresh Ident.knormal in - let instr_deactivate_exn = Sil.Set (Sil.Lvar ret_var, ret_type, Sil.Var id_deactivate, loc) in + let instr_deactivate_exn = Sil.Set (Exp.Lvar ret_var, ret_type, Exp.Var id_deactivate, loc) in let instr_unwrap_ret_val = - let unwrap_builtin = Sil.Const (Const.Cfun ModelBuiltins.__unwrap_exception) in + let unwrap_builtin = Exp.Const (Const.Cfun ModelBuiltins.__unwrap_exception) in Sil.Call - ([id_exn_val], unwrap_builtin, [(Sil.Var id_ret_val, ret_type)], loc, CallFlags.default) in + ([id_exn_val], unwrap_builtin, [(Exp.Var id_ret_val, ret_type)], loc, CallFlags.default) in create_node loc Cfg.Node.exn_handler_kind @@ -68,20 +68,20 @@ let translate_exceptions context exit_nodes get_body_nodes handler_table = | _ -> assert false in let id_instanceof = Ident.create_fresh Ident.knormal in let instr_call_instanceof = - let instanceof_builtin = Sil.Const (Const.Cfun ModelBuiltins.__instanceof) in + let instanceof_builtin = Exp.Const (Const.Cfun ModelBuiltins.__instanceof) in let args = [ - (Sil.Var id_exn_val, Typ.Tptr(exn_type, Typ.Pk_pointer)); - (Sil.Sizeof (exn_type, None, Subtype.exact), Typ.Tvoid)] in + (Exp.Var id_exn_val, Typ.Tptr(exn_type, Typ.Pk_pointer)); + (Exp.Sizeof (exn_type, None, Subtype.exact), Typ.Tvoid)] in Sil.Call ([id_instanceof], instanceof_builtin, args, loc, CallFlags.default) in let if_kind = Sil.Ik_switch in - let instr_prune_true = Sil.Prune (Sil.Var id_instanceof, loc, true, if_kind) in + let instr_prune_true = Sil.Prune (Exp.Var id_instanceof, loc, true, if_kind) in let instr_prune_false = - Sil.Prune (Sil.UnOp(Unop.LNot, Sil.Var id_instanceof, None), loc, false, if_kind) in + Sil.Prune (Exp.UnOp(Unop.LNot, Exp.Var id_instanceof, None), loc, false, if_kind) in let instr_set_catch_var = let catch_var = JContext.set_pvar context handler.JBir.e_catch_var ret_type in - Sil.Set (Sil.Lvar catch_var, ret_type, Sil.Var id_exn_val, loc) in + Sil.Set (Exp.Lvar catch_var, ret_type, Exp.Var id_exn_val, loc) in let instr_rethrow_exn = - Sil.Set (Sil.Lvar ret_var, ret_type, Sil.Exn (Sil.Var id_exn_val), loc) in + Sil.Set (Exp.Lvar ret_var, ret_type, Exp.Exn (Exp.Var id_exn_val), loc) in let node_kind_true = Cfg.Node.Prune_node (true, if_kind, exn_message) in let node_kind_false = Cfg.Node.Prune_node (false, if_kind, exn_message) in let node_true = diff --git a/infer/src/java/jTransStaticField.ml b/infer/src/java/jTransStaticField.ml index 40ecbf008..4fdfbf1aa 100644 --- a/infer/src/java/jTransStaticField.ml +++ b/infer/src/java/jTransStaticField.ml @@ -185,12 +185,12 @@ let translate_instr_static_field context callee_procdesc fs field_type loc = let ret_id = Ident.create_fresh Ident.knormal in let caller_procname = (Cfg.Procdesc.get_proc_name caller_procdesc) in let callee_procname = Cfg.Procdesc.get_proc_name callee_procdesc in - let callee_fun = Sil.Const (Const.Cfun callee_procname) in - let field_arg = Sil.Const (Const.Cstr (JBasics.fs_name fs)) in + let callee_fun = Exp.Const (Const.Cfun callee_procname) in + let field_arg = Exp.Const (Const.Cstr (JBasics.fs_name fs)) in let call_instr = Sil.Call ([ret_id], callee_fun, [field_arg, field_type], loc, CallFlags.default) in Cg.add_edge cg caller_procname callee_procname; - ([call_instr], Sil.Var ret_id) + ([call_instr], Exp.Var ret_id) let is_static_final_field context cn fs = diff --git a/infer/src/java/jTransStaticField.mli b/infer/src/java/jTransStaticField.mli index bf3bdf432..a31f310da 100644 --- a/infer/src/java/jTransStaticField.mli +++ b/infer/src/java/jTransStaticField.mli @@ -20,7 +20,7 @@ val has_static_final_fields : JCode.jcode Javalib.interface_or_class -> bool val translate_instr_static_field : JContext.t -> Cfg.Procdesc.t -> JBasics.field_signature -> Typ.t -> - Location.t -> Sil.instr list * Sil.exp + Location.t -> Sil.instr list * Exp.t val static_field_init : JCode.jcode Javalib.interface_or_class -> JBasics.class_name -> JBir.instr array -> JBir.instr array diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index aaa08fb4a..231375217 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -391,11 +391,11 @@ and value_type program tenv vt = | JBasics.TObject ot -> object_type program tenv ot -(** Translate object types into Sil.Sizeof expressions *) +(** Translate object types into Exp.Sizeof expressions *) let sizeof_of_object_type program tenv ot subtypes = match object_type program tenv ot with | Typ.Tptr (typ, _) -> - Sil.Sizeof (typ, None, subtypes) + Exp.Sizeof (typ, None, subtypes) | _ -> raise (Type_tranlsation_error "Pointer or array type expected in tenv") diff --git a/infer/src/java/jTransType.mli b/infer/src/java/jTransType.mli index caa2a57de..4d0c39936 100644 --- a/infer/src/java/jTransType.mli +++ b/infer/src/java/jTransType.mli @@ -46,7 +46,7 @@ val object_type : JClasspath.program -> Tenv.t -> JBasics.object_type -> Typ.t (** create sizeof expressions from the object type and the list of subtypes *) val sizeof_of_object_type : JClasspath.program -> Tenv.t -> JBasics.object_type -> Subtype.t - -> Sil.exp + -> Exp.t (** transforms a Java type to a Typ.t. *) val value_type : JClasspath.program -> Tenv.t -> JBasics.value_type -> Typ.t diff --git a/infer/src/llvm/lTrans.ml b/infer/src/llvm/lTrans.ml index 9f5bcd76a..615c0f8f7 100644 --- a/infer/src/llvm/lTrans.ml +++ b/infer/src/llvm/lTrans.ml @@ -21,13 +21,13 @@ let source_only_location () : Location.t = let ident_of_variable (var : LAst.variable) : Ident.t = (* TODO: use unique stamps *) Ident.create_normal (Ident.string_to_name (LAst.string_of_variable var)) 0 -let trans_variable (var : LAst.variable) : Sil.exp = Sil.Var (ident_of_variable var) +let trans_variable (var : LAst.variable) : Exp.t = Exp.Var (ident_of_variable var) -let trans_constant : LAst.constant -> Sil.exp = function - | Cint i -> Sil.Const (Const.Cint (IntLit.of_int i)) +let trans_constant : LAst.constant -> Exp.t = function + | Cint i -> Exp.Const (Const.Cint (IntLit.of_int i)) | Cnull -> Sil.exp_null -let trans_operand : LAst.operand -> Sil.exp = function +let trans_operand : LAst.operand -> Exp.t = function | Var var -> trans_variable var | Const const -> trans_constant const @@ -73,7 +73,7 @@ let rec trans_annotated_instructions let procname = Cfg.Procdesc.get_proc_name procdesc in let ret_var = Pvar.get_ret_pvar procname in let new_sil_instr = - Sil.Set (Sil.Lvar ret_var, trans_typ tp, trans_operand exp, location) in + Sil.Set (Exp.Lvar ret_var, trans_typ tp, trans_operand exp, location) in (new_sil_instr :: sil_instrs, locals) | Load (var, tp, ptr) -> let new_sil_instr = @@ -97,7 +97,7 @@ let rec trans_annotated_instructions | Call (ret_var, func_var, typed_args) -> let new_sil_instr = Sil.Call ( [ident_of_variable ret_var], - Sil.Const (Const.Cfun (procname_of_function_variable func_var)), + Exp.Const (Const.Cfun (procname_of_function_variable func_var)), IList.map (fun (tp, arg) -> (trans_operand arg, trans_typ tp)) typed_args, location, CallFlags.default) in (new_sil_instr :: sil_instrs, locals) diff --git a/infer/src/unit/BoundedCallTreeTests.ml b/infer/src/unit/BoundedCallTreeTests.ml index 56aac69f8..221fc17ba 100644 --- a/infer/src/unit/BoundedCallTreeTests.ml +++ b/infer/src/unit/BoundedCallTreeTests.ml @@ -23,7 +23,7 @@ let tests = let open AnalyzerTester.StructuredSil in let f_proc_name = Procname.from_string_c_fun "f" in let g_proc_name = Procname.from_string_c_fun "g" in - let g_args = [((Sil.Const (Const.Cint (IntLit.one))), (Typ.Tint IInt))] in + let g_args = [((Exp.Const (Const.Cint (IntLit.one))), (Typ.Tint IInt))] in let g_ret_ids = [(ident_of_str "r")] in let class_name = "com.example.SomeClass" in let file_name = "SomeClass.java" in diff --git a/infer/src/unit/accessPathTests.ml b/infer/src/unit/accessPathTests.ml index 9888bd3ed..eee810931 100644 --- a/infer/src/unit/accessPathTests.ml +++ b/infer/src/unit/accessPathTests.ml @@ -94,19 +94,19 @@ let tests = let of_exp_test_ _ = let f_fieldname = make_fieldname "f" in let g_fieldname = make_fieldname "g" in - let x_exp = Sil.Lvar (make_var "x") in + let x_exp = Exp.Lvar (make_var "x") in check_make_ap x_exp x ~f_resolve_id; - let xF_exp = Sil.Lfield (x_exp, f_fieldname, dummy_typ) in + let xF_exp = Exp.Lfield (x_exp, f_fieldname, dummy_typ) in check_make_ap xF_exp xF ~f_resolve_id; - let xFG_exp = Sil.Lfield (xF_exp, g_fieldname, dummy_typ) in + let xFG_exp = Exp.Lfield (xF_exp, g_fieldname, dummy_typ) in check_make_ap xFG_exp xFG ~f_resolve_id; - let xArr_exp = Sil.Lindex (x_exp, Sil.exp_zero) in + let xArr_exp = Exp.Lindex (x_exp, Sil.exp_zero) in check_make_ap xArr_exp xArr ~f_resolve_id; (* make sure [f_resolve_id] works *) let f_resolve_id_to_xF _ = Some xF in let xFG_exp_with_id = - let id_exp = Sil.Var (Ident.create_normal (Ident.string_to_name "") 0) in - Sil.Lfield (id_exp, g_fieldname, dummy_typ) in + let id_exp = Exp.Var (Ident.create_normal (Ident.string_to_name "") 0) in + Exp.Lfield (id_exp, g_fieldname, dummy_typ) in check_make_ap xFG_exp_with_id xFG ~f_resolve_id:f_resolve_id_to_xF; () in "of_exp">::of_exp_test_ in diff --git a/infer/src/unit/addressTakenTests.ml b/infer/src/unit/addressTakenTests.ml index d08df597d..27ac4c84e 100644 --- a/infer/src/unit/addressTakenTests.ml +++ b/infer/src/unit/addressTakenTests.ml @@ -24,10 +24,10 @@ let tests = let int_ptr_typ = Typ.Tptr (int_typ, Pk_pointer) in let fun_ptr_typ = Typ.Tptr (Tfun false, Pk_pointer) in let closure_exp captureds = - let mk_captured_var str = (Sil.Var (ident_of_str str), pvar_of_str str, int_ptr_typ) in + 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 closure = { Sil.name=dummy_procname; captured_vars; } in - Sil.Closure closure in + let closure = { Exp.name=dummy_procname; captured_vars; } in + Exp.Closure closure in let test_list = [ "address_taken_set_instr", [ diff --git a/infer/src/unit/analyzerTester.ml b/infer/src/unit/analyzerTester.ml index f243ceff1..8ca7bb6d0 100644 --- a/infer/src/unit/analyzerTester.ml +++ b/infer/src/unit/analyzerTester.ml @@ -21,8 +21,8 @@ module StructuredSil = struct type structured_instr = | Cmd of Sil.instr - | If of Sil.exp * structured_instr list * structured_instr list - | While of Sil.exp * structured_instr list + | If of Exp.t * structured_instr list * structured_instr list + | While of Exp.t * structured_instr list (* try/catch/finally. note: there is no throw. the semantics are that every command in the try block is assumed to be possibly-excepting, and the catch block captures all exceptions *) | Try of structured_instr list * structured_instr list * structured_instr list @@ -76,7 +76,7 @@ module StructuredSil = struct Pvar.mk (Mangled.from_string str) dummy_procname let var_of_str str = - Sil.Lvar (pvar_of_str str) + Exp.Lvar (pvar_of_str str) let ident_of_str str = Ident.create_normal (Ident.string_to_name str) 0 @@ -91,12 +91,12 @@ module StructuredSil = struct Cmd (Sil.Set (lhs_exp, rhs_typ, rhs_exp, dummy_loc)) let make_call ?(procname=dummy_procname) ret_ids args = - let call_exp = Sil.Const (Const.Cfun procname) in + let call_exp = Exp.Const (Const.Cfun procname) in Cmd (Sil.Call (ret_ids, call_exp, args, dummy_loc, CallFlags.default)) let id_assign_id ?(rhs_typ=dummy_typ) lhs rhs = let lhs_id = ident_of_str lhs in - let rhs_exp = Sil.Var (ident_of_str rhs) in + let rhs_exp = Exp.Var (ident_of_str rhs) in make_letderef ~rhs_typ lhs_id rhs_exp let id_assign_var ?(rhs_typ=dummy_typ) lhs rhs = @@ -105,8 +105,8 @@ module StructuredSil = struct make_letderef ~rhs_typ lhs_id rhs_exp let id_set_id ?(rhs_typ=dummy_typ) lhs_id rhs_id = - let lhs_exp = Sil.Var (ident_of_str lhs_id) in - let rhs_exp = Sil.Var (ident_of_str rhs_id) in + let lhs_exp = Exp.Var (ident_of_str lhs_id) in + let rhs_exp = Exp.Var (ident_of_str rhs_id) in make_set ~rhs_typ ~lhs_exp ~rhs_exp let var_assign_exp ~rhs_typ lhs rhs_exp = @@ -120,7 +120,7 @@ module StructuredSil = struct let var_assign_id ?(rhs_typ=dummy_typ) lhs rhs = let lhs_exp = var_of_str lhs in - let rhs_exp = Sil.Var (ident_of_str rhs) in + let rhs_exp = Exp.Var (ident_of_str rhs) in make_set ~rhs_typ ~lhs_exp ~rhs_exp (* x = &y *) @@ -165,7 +165,7 @@ module Make create_node (Cfg.Node.Prune_node (true_branch, if_kind, "")) [prune_instr] in let true_prune_node = mk_prune_node cond_exp if_kind true in let false_prune_node = - let negated_cond_exp = Sil.UnOp (Unop.LNot, cond_exp, None) in + let negated_cond_exp = Exp.UnOp (Unop.LNot, cond_exp, None) in mk_prune_node negated_cond_exp if_kind false in true_prune_node, false_prune_node in diff --git a/infer/src/unit/livenessTests.ml b/infer/src/unit/livenessTests.ml index 0bbfc5ba8..5f39be30d 100644 --- a/infer/src/unit/livenessTests.ml +++ b/infer/src/unit/livenessTests.ml @@ -22,10 +22,10 @@ let tests = let assert_empty = invariant "{ }" in let fun_ptr_typ = Typ.Tptr (Tfun false, Pk_pointer) in let closure_exp captured_pvars = - let mk_captured_var str = (Sil.Var (ident_of_str str), pvar_of_str str, dummy_typ) in + 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 closure = { Sil.name=dummy_procname; captured_vars; } in - Sil.Closure closure in + let closure = { Exp.name=dummy_procname; captured_vars; } in + Exp.Closure closure in let unknown_cond = (* don't want to use AnalyzerTest.unknown_exp because we'll treat it as a live var! *) Sil.exp_zero in