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].
Ltac clean_up_stackframe := idtac.
Ltac entailer :=
try match goal with POSTCONDITION := @abbreviate ret_assert _ |- _ =>
clear POSTCONDITION
end;
try match goal with MORE_COMMANDS := @abbreviate statement _ |- _ =>
clear MORE_COMMANDS
end;
match goal with
| |- ?P |-- _ =>
match type of P with
| ?T => unify T (environ->mpred); clean_up_stackframe; go_lower
| _ => clear_Delta; pull_out_props
end
| |- _ => fail "The entailer tactic works only on entailments   _ |-- _ "
end;
saturate_local;
entailer';
rewrite <- ?sepcon_assoc.
Ltac entbang :=
intros;
try match goal with POSTCONDITION := @abbreviate ret_assert _ |- _ =>
clear POSTCONDITION
end;
try match goal with MORE_COMMANDS := @abbreviate statement _ |- _ =>
clear MORE_COMMANDS
end;
match goal with
| |- local _ && ?P |-- _ => clean_up_stackframe; go_lower; (*simpl;*) try (*simple*) apply empTrue
| |- ?P |-- _ =>
match type of P with
| ?T => unify T mpred; pull_out_props
end
| |- _ => fail "The entailer tactic works only on entailments  _ |-- _ "
end;
(* The following lines are only a temporary solution. Many current proofs depend on one original feature of "entailer!": sem_cast expressions and sem_binary_operation' expressions will be simplified. This step was done in go_lower. But that is not a reasonable design. Current version of go_lower does not "simpl" user's expressions any longer---go_lower should be safe. Thus we add the following lines here. *)
repeat match goal with
| |- context [force_val (sem_binary_operation' ?op ?t1 ?t2 ?v1 ?v2)] =>
progress simpl (force_val (sem_binary_operation' op t1 t2 v1 v2))
end;
simpl sem_cast;
(* end of temporary solution *)
saturate_local;
ent_iter;
repeat change (mapsto_memory_block.spacer _ _ _ _) with emp;
first [ contradiction
| simple apply prop_right; my_auto
| match goal with |- ?Q |-- !! _ && ?Q' => constr_eq  Q Q';
simple apply prop_and_same_derives'; my_auto
end
| simple apply andp_right;
[apply prop_right; my_auto
| cancel; rewrite <- ?sepcon_assoc; autorewrite with norm ]
| normalize; cancel; rewrite <- ?sepcon_assoc
].
Tactic Notation "entailer" "!" := entbang.
Ltac elim_hyps :=  (* not in use anywhere? *)
repeat match goal with
| H: isptr ?x |- _ =>
let x1 := fresh x "_b" in let x2 := fresh x "_ofs" in
destruct x as [ | | | | | x1 x2]; inv H
| H: ptr_eq _ _ |- _ => apply ptr_eq_e in H; safe_subst_any
end.
Ltac aggressive :=
repeat split; auto; elim_hyps; simpl; (computable || auto).
(**** try this out here, for now ****)
Hint Rewrite Int.signed_repr using rep_omega : norm.
Hint Rewrite Int.unsigned_repr using rep_omega : norm.
Hint Rewrite Int64.signed_repr using rep_omega : norm.
Hint Rewrite Int64.unsigned_repr using rep_omega : norm.
(************** TACTICS FOR GENERATING AND EXECUTING TEST CASES *******)
Definition EVAR (x: Prop) := x.
Hint Rewrite offset_val_sizeof_hack : norm.
Hint Rewrite offset_val_sizeof_hack2 : norm.
Hint Rewrite offset_val_sizeof_hack3 : norm.
Ltac make_Vptr c :=
let H := fresh in assert (isptr c) by auto;
destruct c; try (contradiction H); clear H.
Hint Rewrite Zmax0r using (try computable; rep_omega (*Omega0*)) : norm.
Definition cstring {CS : compspecs} sh (s: list byte) p :=
!!(~In Byte.zero s) &&
data_at sh (tarray tschar (Zlength s + 1)) (map Vbyte (s ++ [Byte.zero])) p.
Hint Resolve cstring_local_facts : saturate_local.
Hint Resolve cstring_valid_pointer : valid_pointer.
Definition cstringn {CS : compspecs} sh (s: list byte) n p :=
!!(~In Byte.zero s) &&
data_at sh (tarray tschar n) (map Vbyte (s ++ [Byte.zero]) ++
list_repeat (Z.to_nat (n - (Zlength s + 1))) Vundef) p.
Fixpoint no_zero_bytes (s: list byte) : bool :=
match s with
| nil => true
| b :: s' => andb (negb (Byte.eq b Byte.zero)) (no_zero_bytes s')
end.

Lemma cstringn_local_facts: forall {CS : compspecs} sh s n p,
cstringn sh s n p |-- !! (isptr p /\ Zlength s + 1 <= n <= Ptrofs.max_unsigned).