From compcert Require Export Clightdefs.
Require Export VST.veric.SeparationLogic.
Require Export VST.msl.Extensionality.
Require Export compcert.lib.Coqlib.
Require Export VST.msl.Coqlib2 VST.veric.coqlib4 VST.floyd.coqlib3.
Local Open Scope logic.
Ltac _destruct_var_types i Heq_vt Heq_ve t b ::=
let HH := fresh "H" in
match goal with
| H: typecheck_var_environ _ _ |- _ =>
pose proof WARNING___________you_should_use_tactic___destruct_var_types___instead _ _ H i as HH
| H: typecheck_environ _ _ |- _ =>
pose proof WARNING___________you_should_use_tactic___destruct_var_types___instead _ _ (proj1 (proj2 H)) i as HH
| H: tc_environ _ _ |- _ =>
pose proof WARNING___________you_should_use_tactic___destruct_var_types___instead _ _ (proj1 (proj2 H)) i as HH
end;
match type of HH with
| match ?o with _ => _ end =>
match goal with
| H: o = Some _ |- _ =>
rewrite H in HH
| H: Some _ = o |- _ =>
rewrite <- H in HH
| H: o = None |- _ =>
rewrite H in HH
| H: None = o |- _ =>
rewrite <- H in HH
| _ =>
let HH' := fresh "H" in
pose proof eq_refl o as HH';
destruct o as [t |] in HH, HH' at 2;
pose proof HH' as Heq_vt; clear HH'
end
end;
match type of HH with
| ex _ =>
pose proof HH as [b Heq_ve]
| _ =>
pose proof HH as Heq_ve
end;
clear HH.
Ltac _destruct_glob_types i Heq_gt Heq_ge t b ::=
let HH := fresh "H" in
match goal with
| H: typecheck_glob_environ _ _ |- _ =>
pose proof WARNING___________you_should_use_tactic___destruct_glob_types___instead _ _ H i as HH
| H: typecheck_environ _ _ |- _ =>
pose proof WARNING___________you_should_use_tactic___destruct_glob_types___instead _ _ (proj2 (proj2 H)) i as HH
| H: tc_environ _ _ |- _ =>
pose proof WARNING___________you_should_use_tactic___destruct_glob_types___instead _ _ (proj2 (proj2 H)) i as HH
end;
match type of HH with
| match ?o with _ => _ end =>
match goal with
| H: o = Some _ |- _ =>
rewrite H in HH
| H: Some _ = o |- _ =>
rewrite <- H in HH
| H: o = None |- _ =>
rewrite H in HH
| H: None = o |- _ =>
rewrite <- H in HH
| _ =>
let HH' := fresh "H" in
pose proof eq_refl o as HH';
destruct o as [t |] in HH, HH' at 2;
pose proof HH' as Heq_gt; clear HH'
end
end;
match type of HH with
| ex _ =>
pose proof HH as [b Heq_ge]
| _ =>
idtac
end;
clear HH.
(* no "semax" in this file, just assertions. *)
Global Transparent Int.repr.
Global Transparent Ptrofs.repr.
Definition loop1x_ret_assert (Inv : environ -> mpred) (R : ret_assert) :=
{| RA_normal := Inv; RA_break := FF; RA_continue := Inv; RA_return := R.(RA_return) |}.
Hint Rewrite frame_normal frame_for1 frame_loop1
overridePost_normal: ret_assert.
Hint Resolve @TT_right : core.
Hint Rewrite overridePost_overridePost : ret_assert.
Hint Rewrite overridePost_normal' : ret_assert.
Hint Rewrite @liftx_id : norm2.
Hint Rewrite @lift1_lift0 : norm2.
Hint Rewrite local_lift2_and : norm2.
Hint Rewrite @subst_TT @subst_FF: subst.
Hint Rewrite (@subst_TT mpred Nveric) (@subst_FF mpred Nveric): subst.
Hint Rewrite @resubst : subst.
Hint Rewrite @subst_andp subst_prop : subst.
Hint Rewrite subst_eval_var : subst.
Hint Rewrite overridePost_EK_return : ret_assert.
(*Hint Rewrite frame_ret_assert_emp : ret_assert.*)
Hint Rewrite frame_ret_assert_EK_return : ret_assert.
Hint Rewrite bind_ret1_unfold' : norm2.  (* put this in AFTER the unprimed version, for higher priority *)
Hint Rewrite overridePost_EK_break loop1_ret_assert_EK_break
normal_ret_assert_elim : ret_assert.
Hint Rewrite loop1_ret_assert_normal: ret_assert.
Hint Rewrite @eval_make_args_same : norm2.
Hint Rewrite @eval_make_args_other using (solve [clear; intro Hx; inversion Hx]) : norm.
Infix "oo" := Basics.compose (at level 54, right associativity).
Arguments Basics.compose {A B C} g f x / .
Hint Rewrite @compose_eval_make_args_same : norm.
Hint Rewrite @compose_eval_make_args_other using (solve [clear; intro Hx; inversion Hx]) : norm.
Hint Rewrite elim_globals_only using (split3; [eassumption | reflexivity.. ]) : norm.
Hint Rewrite globvars2pred_unfold : norm.
Hint Rewrite @exp_trivial : norm.

Lemma orp_ENTAILL: forall Delta P P' Q Q',
local (tc_environ Delta) && (allp_fun_id Delta && P) |-- P' ->
local (tc_environ Delta) && (allp_fun_id Delta && Q) |-- Q' ->
local (tc_environ Delta) && (allp_fun_id Delta && (P || Q)) |-- P' || Q'.