Local Open Scope logic.
Hint Resolve isptr_force_val_sem_cast_neutral : norm.
Arguments denote_tc_isptr v / .
Arguments denote_tc_iszero !v .
Arguments denote_tc_nonzero !v .
Arguments denote_tc_igt i !v .
Arguments denote_tc_Zge z !v .
Arguments denote_tc_Zle z !v .
Arguments denote_tc_samebase !v1 !v2 .
Arguments denote_tc_nodivover !v1 !v2 .
Arguments denote_tc_initialized id ty rho / .
Arguments denote_tc_nosignedover op v1 v2 / .
Ltac simpl_denote_tc :=
simpl denote_tc_isptr;
simpl denote_tc_iszero;
simpl denote_tc_nonzero;
simpl denote_tc_igt;
simpl denote_tc_Zge;
simpl denote_tc_Zle;
simpl denote_tc_samebase;
simpl denote_tc_nodivover;
simpl denote_tc_initialized;
simpl denote_tc_nosignedover.
Hint Resolve sepcon_valid_pointer1 sepcon_valid_pointer2 : valid_pointer.
Hint Resolve andp_valid_pointer1 andp_valid_pointer2 : valid_pointer.
Hint Resolve valid_pointer_null : valid_pointer.
Hint Resolve valid_pointer_zero32 : valid_pointer.
Hint Resolve valid_pointer_zero64 : valid_pointer.
Hint Resolve sepcon_weak_valid_pointer1: valid_pointer.
Hint Resolve sepcon_weak_valid_pointer2: valid_pointer.
(* TODO: test_order need to be added *)
Ltac solve_valid_pointer :=
match goal with
| |- _ |-- denote_tc_test_eq _ _ && _ =>
apply andp_right;
[apply denote_tc_test_eq_split;
solve [auto 50 with valid_pointer] | ]
| |- _ |-- valid_pointer _ && _ =>
apply andp_right; [ solve [auto 50 with valid_pointer] | ]
| |- _ |-- weak_valid_pointer _ && _ =>
apply andp_right; [ solve [auto 50 with valid_pointer] | ]
| |- _ |-- denote_tc_test_eq _ _ =>
auto 50 with valid_pointer
| |- _ |-- valid_pointer _ =>
auto 50 with valid_pointer
| |- _ |-- weak_valid_pointer _ =>
auto 50 with valid_pointer
end.
Hint Rewrite (@TT_andp mpred _) : gather_prop.
Hint Rewrite (@andp_TT mpred _) : gather_prop.
Ltac pull_out_props :=
repeat (( simple apply derives_extract_prop
|| simple apply derives_extract_prop');
fancy_intros true);
autorewrite with gather_prop;
repeat (( simple apply derives_extract_prop
|| simple apply derives_extract_prop');
fancy_intros true).
Ltac simplify_float2int :=
match goal with
| |- context [Zofsingle (Float32.of_bits (Int.repr ?A))] =>
putable A;
let x := fresh "x" in (evar (x: Z));
replace (Zofsingle (Float32.of_bits (Int.repr A))) with (Some x) by (subst x; reflexivity);
compute in x; subst x
| |- context [Zoffloat (Float.of_bits (Int.repr ?A))] =>
putable A;
let x := fresh "x" in (evar (x: Z));
replace (Zoffloat (Float.of_bits (Int.repr A))) with (Some x) by (subst x; reflexivity);
compute in x; subst x
end.
Ltac ent_iter :=
repeat simplify_float2int;
autorewrite with gather_prop;
repeat (( simple apply derives_extract_prop
|| simple apply derives_extract_prop');
fancy_intros true);
(*   saturate_local; *)
repeat erewrite unfold_reptype_elim in * by (apply JMeq_refl; reflexivity);
simpl_compare;
simpl_denote_tc;
safe_subst_any;
try autorewrite with entailer_rewrite in *;
try solve_valid_pointer;
repeat data_at_conflict_neq.
Ltac splittable :=
match goal with
| |- _ <= _ < _ => fail 1
| |- _ < _ <= _ => fail 1
| |- _ <= _ <= _ => fail 1
| |- _ < _ < _ => fail 1
| |- _ <-> _ => fail 1
| |- _ /\ _ => idtac
end.
Ltac prove_signed_range :=
match goal with
| |- Int.min_signed <= _ <= Int.max_signed =>
normalize; rep_omega
| |- Int64.min_signed <= _ <= Int64.max_signed =>
normalize; rep_omega
end.
Hint Resolve ptr_eq_refl : prove_it_now.
Hint Resolve ptr_eq_nullval : prove_it_now.
Hint Extern 4 (value_fits _ _ _) =>
(rewrite ?proj_sumbool_is_true by auto;
rewrite ?proj_sumbool_is_false by auto;
repeat simplify_value_fits; auto) : prove_it_now.
Hint Rewrite intsigned_intrepr_bytesigned : rep_omega.
Ltac prove_it_now :=
first [ splittable; fail 1
| computable
| apply Coq.Init.Logic.I
| reflexivity
| rewrite ?intsigned_intrepr_bytesigned; rep_omega (* Omega0 *)
| prove_signed_range
| repeat match goal with H: ?A |- _ => has_evar A; clear H end;
auto with prove_it_now field_compatible;
autorewrite with norm entailer_rewrite; normalize;
first [eapply field_compatible_nullval; eassumption
| eapply field_compatible_nullval1; eassumption
| eapply field_compatible_nullval2; eassumption
]
].
Ltac try_prove_it_now :=
first [match goal with H := _ |- _ => instantiate (1:=True) in H; prove_it_now end
| eassumption].
Ltac prop_right_cautious :=
try solve [simple apply prop_right; auto; prove_it_now].
Ltac prune_conjuncts :=
repeat rewrite and_assoc';
first [simple eapply try_conjuncts_prop;
[intro; try_conjuncts
| cbv beta; repeat rewrite and_True; prop_right_cautious ]
| simple eapply try_conjuncts_prop_and;
[intro; try_conjuncts
| cbv beta; repeat rewrite and_True; try simple apply go_lower_lem1]
| idtac].
Ltac entailer' :=
repeat (progress (ent_iter; normalize));
try simple apply prop_and_same_derives;
prune_conjuncts;
try rewrite (prop_true_andp True) by apply Coq.Init.Logic.I;
try solve_valid_pointer;
try first [apply derives_refl
| simple apply FF_left
| simple apply TT_right].

Lemma empTrue:
@derives mpred Nveric (@emp mpred Nveric Sveric) (@prop mpred Nveric True).