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.
Ltac lifted_derives_L2R H :=
eapply ENTAIL_trans; [apply H |].
Ltac ENTAIL_L2R H :=
match type of H with
| @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
eapply ENTAIL_trans; [apply H |]
| _ =>
eapply ENTAIL_trans; [apply derives_ENTAIL, H |]
end.
Ltac derives_bupd_L2R H :=
match type of H with
| @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> _) =>
eapply derives_bupd_trans; [apply H |]
| @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
eapply derives_bupd_trans; [apply ENTAIL_derives_bupd, H |]
| _ =>
eapply derives_bupd_trans; [apply ENTAIL_derives_bupd, derives_ENTAIL, H |]
end.
Ltac derives_bupd0_L2R H :=
match type of H with
| @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> |> FF || _) =>
eapply derives_bupd0_trans; [apply H |]
| @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> _) =>
eapply derives_bupd0_trans; [apply derives_bupd_derives_bupd0, H |]
| @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
eapply derives_bupd0_trans; [apply derives_bupd_derives_bupd0, ENTAIL_derives_bupd, H |]
| _ =>
eapply derives_bupd0_trans; [apply derives_bupd_derives_bupd0, ENTAIL_derives_bupd, derives_ENTAIL, H |]
end.
Ltac derives_full_L2R H :=
match type of H with
| @derives (environ -> mpred) _ (local (tc_environ ?Delta) && (allp_fun_id ?Delta && _)) (|==> |> FF || _) =>
eapply derives_full_trans; [apply H |]
| @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> |> FF || _) =>
eapply derives_full_trans; [apply derives_bupd0_derives_full, H |]
| @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> _) =>
eapply derives_full_trans; [apply derives_bupd0_derives_full, derives_bupd_derives_bupd0, H |]
| @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
eapply derives_full_trans; [apply derives_bupd0_derives_full, derives_bupd_derives_bupd0, ENTAIL_derives_bupd, H |]
| _ =>
eapply derives_full_trans; [apply derives_bupd0_derives_full, derives_bupd_derives_bupd0, ENTAIL_derives_bupd, derives_ENTAIL, H |]
end.
Tactic Notation "derives_rewrite" "->" constr(H) :=
match goal with
| |- @derives (environ -> mpred) _ (local (tc_environ ?Delta) && (allp_fun_id ?Delta && _)) (|==> |> FF || _) =>
derives_full_L2R H
| |- @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> |> FF || _) =>
derives_bupd0_L2R H
| |- @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> _) =>
derives_bupd_L2R H
| |- @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
ENTAIL_L2R H
| |- _ =>
lifted_derives_L2R H
end.
Ltac lifted_derives_R2L H :=
eapply derives_trans; [| apply H].
Ltac ENTAIL_R2L H :=
match type of H with
| @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
eapply ENTAIL_trans; [| apply H]
| _ =>
eapply ENTAIL_trans; [| apply derives_ENTAIL, H]
end.
Ltac derives_bupd_R2L H :=
match type of H with
| @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> _) =>
eapply derives_bupd_trans; [| apply H]
| @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
eapply derives_bupd_trans; [| apply ENTAIL_derives_bupd, H]
| _ =>
eapply derives_bupd_trans; [| apply ENTAIL_derives_bupd, derives_ENTAIL, H]
end.
Ltac derives_bupd0_R2L H :=
match type of H with
| @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> |> FF || _) =>
eapply derives_bupd0_trans; [| apply H]
| @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> _) =>
eapply derives_bupd0_trans; [| apply derives_bupd_derives_bupd0, H]
| @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
eapply derives_bupd0_trans; [| apply derives_bupd_derives_bupd0, ENTAIL_derives_bupd, H]
| _ =>
eapply derives_bupd0_trans; [| apply derives_bupd_derives_bupd0, ENTAIL_derives_bupd, derives_ENTAIL, H]
end.
Ltac derives_full_R2L H :=
match type of H with
| @derives (environ -> mpred) _ (local (tc_environ ?Delta) && (allp_fun_id ?Delta && _)) (|==> |> FF || _) =>
eapply derives_bupd0_trans; [| apply H]
| @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> |> FF || _) =>
eapply derives_bupd0_trans; [| apply derives_bupd0_derives_full, H]
| @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> _) =>
eapply derives_bupd0_trans; [| apply derives_bupd0_derives_full, derives_bupd_derives_bupd0, H]
| @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
eapply derives_bupd0_trans; [| apply derives_bupd0_derives_full, derives_bupd_derives_bupd0, ENTAIL_derives_bupd, H]
| _ =>
eapply derives_bupd0_trans; [| apply derives_bupd0_derives_full, derives_bupd_derives_bupd0, ENTAIL_derives_bupd, derives_ENTAIL, H]
end.
Tactic Notation "derives_rewrite" "<-" constr(H) :=
match goal with
| |- @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> |> FF || _) =>
derives_bupd0_R2L H
| |- @derives (environ -> mpred) _ (local (tc_environ _) && _) (|==> _) =>
derives_bupd_R2L H
| |- @derives (environ -> mpred) _ (local (tc_environ _) && _) _ =>
ENTAIL_R2L H
| |- _ =>
lifted_derives_R2L H
end.
Ltac solve_derives_trans :=
first [simple apply derives_full_refl | eapply derives_full_trans; [eassumption | solve_derives_trans]].
Ltac reduceR :=
match goal with
| |- _ |-- |==> |> FF || _ => apply aux1_reduceR
| _ => idtac
end;
match goal with
| |- _ |-- |==> _ => apply aux2_reduceR
| _ => idtac
end.

Lemma aux_reduceL: forall P Q R S: environ -> mpred,
P && R |-- S ->
P && (Q && R) |-- S.