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

Refactor Sil.exp to Exp.t

Browse Source 
Summary: Create Exp module and refactor Sil.exp to Exp.t

Reviewed By: cristianoc

Differential Revision: D3669394

fbshipit-source-id: 1f52a90
master
Josh Berdine 8 years ago committed by Facebook Github Bot 8
parent 6ffe204252
commit 701eb20f83
86 changed files with 2147 additions and 2086 deletions
Show Stats Download Patch File Download Diff File

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

@ -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;

2
infer/src/IR/Cfg.rei
Unescape View File

@ -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;

52
infer/src/IR/Exp.re
Unescape View File

@ -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;

52
infer/src/IR/Exp.rei
Unescape View File

@ -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;

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

@ -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
}

221
infer/src/IR/Sil.rei
Unescape View File

@ -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;

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

@ -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

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

@ -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

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

@ -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

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

@ -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;
}

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

@ -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;
}

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

@ -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

39
infer/src/backend/dotty.ml
Unescape View File

@ -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

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

@ -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

24
infer/src/backend/errdesc.mli
Unescape View File

@ -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

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

@ -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

16
infer/src/backend/localise.ml
Unescape View File

@ -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 "

4
infer/src/backend/localise.mli
Unescape View File

@ -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

44
infer/src/backend/match.ml
Unescape View File

@ -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)

35
infer/src/backend/match.mli
Unescape View File

@ -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

92
infer/src/backend/modelBuiltins.ml
Unescape View File

@ -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

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

@ -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] *)

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

@ -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

764
infer/src/backend/prop.ml
View File

File diff suppressed because it is too large Load Diff

97
infer/src/backend/prop.mli
Unescape View File

@ -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<e] return [n,e] *)
val atom_const_lt_exp : Sil.atom -> (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] *)

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

@ -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]

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

@ -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<e2]. Result [false] means "don't know". *)
val check_lt : t -> 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<e] if possible. *)
val compute_lower_bound : t -> 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<e2]. Result [false] means "don't know". *)
let check_lt prop e1 e2 =
let e1_lt_e2 = Sil.BinOp (Binop.Lt, e1, e2) in
let e1_lt_e2 = Exp.BinOp (Binop.Lt, e1, e2) in
check_atom prop (Prop.mk_inequality e1_lt_e2)
let filter_ptsto_lhs sub e0 = function

26
infer/src/backend/prover.mli
Unescape View File

@ -17,15 +17,15 @@ open Sil
(** {2 Ordinary Theorem Proving} *)
(** Check [ |- e=0]. Result [false] means "don't know". *)
val check_zero : exp -> 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

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

@ -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

6
infer/src/backend/rearrange.mli
Unescape View File

@ -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

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

@ -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 *)

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

@ -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

2
infer/src/backend/state.mli
Unescape View File

@ -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

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

@ -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

6
infer/src/backend/symExec.mli
Unescape View File

@ -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

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

@ -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

4
infer/src/backend/tabulation.mli
Unescape View File

@ -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

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

@ -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));

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

@ -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)

2
infer/src/checkers/accessPath.mli
Unescape View File

@ -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

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

@ -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

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

@ -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 ->

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

@ -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

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

@ -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

16
infer/src/checkers/codeQuery.ml
Unescape View File

@ -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

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

@ -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 "<init>" -> (* StringBuilder.<init> *)
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 =

2
infer/src/checkers/constantPropagation.mli
Unescape View File

@ -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

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

@ -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

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

@ -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

10
infer/src/checkers/idenv.ml
Unescape View File

@ -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

8
infer/src/checkers/idenv.mli
Unescape View File

@ -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

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

@ -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 ->

2
infer/src/checkers/patternMatch.mli
Unescape View File

@ -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

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

@ -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

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

@ -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

6
infer/src/checkers/sqlChecker.ml
Unescape View File

@ -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 ->

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

@ -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

2
infer/src/checkers/var.mli
Unescape View File

@ -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

46
infer/src/clang/cArithmetic_trans.ml
Unescape View File

@ -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)))

10
infer/src/clang/cArithmetic_trans.mli
Unescape View File

@ -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

2
infer/src/clang/cFrontend_config.mli
Unescape View File

@ -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

6
infer/src/clang/cFrontend_utils.mli
Unescape View File

@ -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 ->

2
infer/src/clang/cMethod_trans.mli
Unescape View File

@ -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

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

@ -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];

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

@ -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) ->

38
infer/src/clang/cTrans_utils.mli
Unescape View File

@ -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

2
infer/src/clang/cVar_decl.ml
Unescape View File

@ -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)

2
infer/src/clang/cVar_decl.mli
Unescape View File

@ -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

2
infer/src/eradicate/eradicate.mli
Unescape View File

@ -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 *)

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

@ -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

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

@ -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 *)

14
infer/src/eradicate/typeState.ml
Unescape View File

@ -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' }

2
infer/src/eradicate/typeState.mli
Unescape View File

@ -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

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

@ -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

137
infer/src/java/jTrans.ml
Unescape View File

@ -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

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

@ -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 =

6
infer/src/java/jTransStaticField.ml
Unescape View File

@ -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 =

2
infer/src/java/jTransStaticField.mli
Unescape View File

@ -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

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

@ -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")

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

@ -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

12
infer/src/llvm/lTrans.ml
Unescape View File

@ -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)

2
infer/src/unit/BoundedCallTreeTests.ml
Unescape View File

@ -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

12
infer/src/unit/accessPathTests.ml
Unescape View File

@ -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

6
infer/src/unit/addressTakenTests.ml
Unescape View File

@ -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",
[

18
infer/src/unit/analyzerTester.ml
Unescape View File

@ -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

6
infer/src/unit/livenessTests.ml
Unescape View File

@ -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

Write Preview
Loading…
Cancel
Save