@ -473,11 +473,11 @@ end = struct
match ( e1 , e2 ) with
match ( e1 , e2 ) with
| Exp . Const Const . Cint n1 , Exp . Const Const . Cint n2
| Exp . Const Const . Cint n1 , Exp . Const Const . Cint n2
-> IntLit . leq n1 n2
-> IntLit . leq n1 n2
| ( Exp . BinOp
| ( Exp . BinOp ( Binop . MinusA , Exp . Sizeof { nbytes = Some nb1 } , Exp . Sizeof { nbytes = Some nb2 } )
( Binop . MinusA
, Exp . Sizeof { typ = t1 ; dynamic_length = None }
, Exp . Sizeof { typ = t2 ; dynamic_length = None } )
, Exp . Const Const . Cint n2 )
, Exp . Const Const . Cint n2 )
-> (* [ sizeof ( t1 ) - sizeof ( t2 ) <= n2 ] *)
IntLit . ( leq ( sub ( of_int nb1 ) ( of_int nb2 ) ) n2 )
| Exp . BinOp ( Binop . MinusA , Exp . Sizeof { typ = t1 } , Exp . Sizeof { typ = t2 } ) , Exp . Const Const . Cint n2
when IntLit . isminusone n2 && type_size_comparable t1 t2
when IntLit . isminusone n2 && type_size_comparable t1 t2
-> (* [ sizeof ( t1 ) - sizeof ( t2 ) <= -1 ] *)
-> (* [ sizeof ( t1 ) - sizeof ( t2 ) <= -1 ] *)
check_type_size_lt t1 t2
check_type_size_lt t1 t2
@ -550,6 +550,8 @@ end = struct
match e1 with
match e1 with
| Exp . Const Const . Cint n1
| Exp . Const Const . Cint n1
-> Some ( n1 - - IntLit . one )
-> Some ( n1 - - IntLit . one )
| Exp . Sizeof { nbytes = Some n1 }
-> Some ( IntLit . of_int n1 - - IntLit . one )
| Exp . Sizeof _
| Exp . Sizeof _
-> Some IntLit . zero
-> Some IntLit . zero
| _
| _
@ -597,9 +599,9 @@ end
(* End of module Inequalities *)
(* End of module Inequalities *)
(* * Check [prop |- e1=e2]. Result [false] means "don't know". *)
(* * Check [prop |- e1=e2]. Result [false] means "don't know". *)
let check_equal tenv prop e1 e2 =
let check_equal tenv prop e1 _0 e2 _0 =
let n_e1 = Prop . exp_normalize_prop tenv prop e1 in
let n_e1 = Prop . exp_normalize_prop ~ destructive : true tenv prop e1 _0 in
let n_e2 = Prop . exp_normalize_prop tenv prop e2 in
let n_e2 = Prop . exp_normalize_prop ~ destructive : true tenv prop e2 _0 in
let check_equal () = Exp . equal n_e1 n_e2 in
let check_equal () = Exp . equal n_e1 n_e2 in
let check_equal_const () =
let check_equal_const () =
match ( n_e1 , n_e2 ) with
match ( n_e1 , n_e2 ) with
@ -651,8 +653,8 @@ let is_root tenv prop base_exp exp =
f [] exp
f [] exp
(* * Get upper and lower bounds of an expression, if any *)
(* * Get upper and lower bounds of an expression, if any *)
let get_bounds tenv prop _ e =
let get_bounds tenv prop e 0 =
let e_norm = Prop . exp_normalize_prop tenv prop _ e in
let e_norm = Prop . exp_normalize_prop ~ destructive : true tenv prop e 0 in
let e_root , off =
let e_root , off =
match e_norm with
match e_norm with
| Exp . BinOp ( Binop . PlusA , e , Exp . Const Const . Cint n1 )
| Exp . BinOp ( Binop . PlusA , e , Exp . Const Const . Cint n1 )
@ -671,8 +673,8 @@ let get_bounds tenv prop _e =
(* * Check whether [prop |- e1!=e2]. *)
(* * Check whether [prop |- e1!=e2]. *)
let check_disequal tenv prop e1 e2 =
let check_disequal tenv prop e1 e2 =
let spatial_part = prop . Prop . sigma in
let spatial_part = prop . Prop . sigma in
let n_e1 = Prop . exp_normalize_prop tenv prop e1 in
let n_e1 = Prop . exp_normalize_prop ~ destructive : true tenv prop e1 in
let n_e2 = Prop . exp_normalize_prop tenv prop e2 in
let n_e2 = Prop . exp_normalize_prop ~ destructive : true tenv prop e2 in
let rec check_expr_disequal ce1 ce2 =
let rec check_expr_disequal ce1 ce2 =
match ( ce1 , ce2 ) with
match ( ce1 , ce2 ) with
| Exp . Const c1 , Exp . Const c2
| Exp . Const c1 , Exp . Const c2
@ -874,7 +876,7 @@ let check_le tenv prop e1 e2 =
(* * Check whether [prop |- allocated ( e ) ]. *)
(* * Check whether [prop |- allocated ( e ) ]. *)
let check_allocatedness tenv prop e =
let check_allocatedness tenv prop e =
let n_e = Prop . exp_normalize_prop tenv prop e in
let n_e = Prop . exp_normalize_prop ~ destructive : true tenv prop e in
let spatial_part = prop . Prop . sigma in
let spatial_part = prop . Prop . sigma in
let f = function
let f = function
| Sil . Hpointsto ( base , _ , _ )
| Sil . Hpointsto ( base , _ , _ )
@ -915,7 +917,7 @@ let check_inconsistency_two_hpreds tenv prop =
let prop' = Prop . normalize tenv ( Prop . from_sigma ( sigma_seen @ sigma_rest ) ) in
let prop' = Prop . normalize tenv ( Prop . from_sigma ( sigma_seen @ sigma_rest ) ) in
let prop_new = Prop . conjoin_eq tenv e1 e2 prop' in
let prop_new = Prop . conjoin_eq tenv e1 e2 prop' in
let sigma_new = prop_new . Prop . sigma in
let sigma_new = prop_new . Prop . sigma in
let e_new = Prop . exp_normalize_prop tenv prop_new e in
let e_new = Prop . exp_normalize_prop ~ destructive : true tenv prop_new e in
f e_new [] sigma_new
f e_new [] sigma_new
else f e ( hpred :: sigma_seen ) sigma_rest
else f e ( hpred :: sigma_seen ) sigma_rest
| ( Sil . Hdllseg ( Sil . Lseg_PE , _ , e1 , _ , Exp . Const Const . Cint i , _ , _ ) as hpred ) :: sigma_rest
| ( Sil . Hdllseg ( Sil . Lseg_PE , _ , e1 , _ , Exp . Const Const . Cint i , _ , _ ) as hpred ) :: sigma_rest
@ -926,7 +928,7 @@ let check_inconsistency_two_hpreds tenv prop =
let prop' = Prop . normalize tenv ( Prop . from_sigma ( sigma_seen @ sigma_rest ) ) in
let prop' = Prop . normalize tenv ( Prop . from_sigma ( sigma_seen @ sigma_rest ) ) in
let prop_new = Prop . conjoin_eq tenv e1 e3 prop' in
let prop_new = Prop . conjoin_eq tenv e1 e3 prop' in
let sigma_new = prop_new . Prop . sigma in
let sigma_new = prop_new . Prop . sigma in
let e_new = Prop . exp_normalize_prop tenv prop_new e in
let e_new = Prop . exp_normalize_prop ~ destructive : true tenv prop_new e in
f e_new [] sigma_new
f e_new [] sigma_new
else f e ( hpred :: sigma_seen ) sigma_rest
else f e ( hpred :: sigma_seen ) sigma_rest
in
in
@ -1319,7 +1321,9 @@ let exp_imply tenv calc_missing (subs: subst2) e1_in e2_in : subst2 =
-> let occurs_check v e =
-> let occurs_check v e =
(* check whether [v] occurs in normalized [e] *)
(* check whether [v] occurs in normalized [e] *)
if Sil . fav_mem ( Sil . exp_fav e ) v
if Sil . fav_mem ( Sil . exp_fav e ) v
&& Sil . fav_mem ( Sil . exp_fav ( Prop . exp_normalize_prop tenv Prop . prop_emp e ) ) v
&& Sil . fav_mem
( Sil . exp_fav ( Prop . exp_normalize_prop ~ destructive : true tenv Prop . prop_emp e ) )
v
then raise ( IMPL_EXC ( " occurs check " , subs , EXC_FALSE_EXPS ( e1 , e2 ) ) )
then raise ( IMPL_EXC ( " occurs check " , subs , EXC_FALSE_EXPS ( e1 , e2 ) ) )
in
in
if Ident . is_primed v2 then
if Ident . is_primed v2 then