Commit 1aae01e6 authored by Robbert Krebbers's avatar Robbert Krebbers

Rename type classes in proof mode.

We are now using the prefixes Into, From, and Is (the first two are
inspired by the names of some traits in the Rust stdlib), and hopefully
doing that consistenly.
parent b5a23477
...@@ -12,14 +12,14 @@ Implicit Types P Q : iPropG heap_lang Σ. ...@@ -12,14 +12,14 @@ Implicit Types P Q : iPropG heap_lang Σ.
Implicit Types Φ : val iPropG heap_lang Σ. Implicit Types Φ : val iPropG heap_lang Σ.
Implicit Types Δ : envs (iResUR heap_lang (globalF Σ)). Implicit Types Δ : envs (iResUR heap_lang (globalF Σ)).
Global Instance sep_destruct_mapsto l q v : Global Instance into_sep_mapsto l q v :
SepDestruct false (l {q} v) (l {q/2} v) (l {q/2} v). IntoSep false (l {q} v) (l {q/2} v) (l {q/2} v).
Proof. by rewrite /SepDestruct heap_mapsto_op_split. Qed. Proof. by rewrite /IntoSep heap_mapsto_op_split. Qed.
Lemma tac_wp_alloc Δ Δ' N E j e v Φ : Lemma tac_wp_alloc Δ Δ' N E j e v Φ :
to_val e = Some v to_val e = Some v
(Δ heap_ctx N) nclose N E (Δ heap_ctx N) nclose N E
StripLaterEnvs Δ Δ' IntoLaterEnvs Δ Δ'
( l, Δ'', ( l, Δ'',
envs_app false (Esnoc Enil j (l v)) Δ' = Some Δ'' envs_app false (Esnoc Enil j (l v)) Δ' = Some Δ''
(Δ'' Φ (LitV (LitLoc l)))) (Δ'' Φ (LitV (LitLoc l))))
...@@ -27,60 +27,60 @@ Lemma tac_wp_alloc Δ Δ' N E j e v Φ : ...@@ -27,60 +27,60 @@ Lemma tac_wp_alloc Δ Δ' N E j e v Φ :
Proof. Proof.
intros ???? HΔ. rewrite -wp_alloc // -always_and_sep_l. intros ???? HΔ. rewrite -wp_alloc // -always_and_sep_l.
apply and_intro; first done. apply and_intro; first done.
rewrite strip_later_env_sound; apply later_mono, forall_intro=> l. rewrite into_later_env_sound; apply later_mono, forall_intro=> l.
destruct (HΔ l) as (Δ''&?&HΔ'). rewrite envs_app_sound //; simpl. destruct (HΔ l) as (Δ''&?&HΔ'). rewrite envs_app_sound //; simpl.
by rewrite right_id HΔ'. by rewrite right_id HΔ'.
Qed. Qed.
Lemma tac_wp_load Δ Δ' N E i l q v Φ : Lemma tac_wp_load Δ Δ' N E i l q v Φ :
(Δ heap_ctx N) nclose N E (Δ heap_ctx N) nclose N E
StripLaterEnvs Δ Δ' IntoLaterEnvs Δ Δ'
envs_lookup i Δ' = Some (false, l {q} v)%I envs_lookup i Δ' = Some (false, l {q} v)%I
(Δ' Φ v) (Δ' Φ v)
Δ WP Load (Lit (LitLoc l)) @ E {{ Φ }}. Δ WP Load (Lit (LitLoc l)) @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -wp_load // -always_and_sep_l. apply and_intro; first done. intros. rewrite -wp_load // -always_and_sep_l. apply and_intro; first done.
rewrite strip_later_env_sound -later_sep envs_lookup_split //; simpl. rewrite into_later_env_sound -later_sep envs_lookup_split //; simpl.
by apply later_mono, sep_mono_r, wand_mono. by apply later_mono, sep_mono_r, wand_mono.
Qed. Qed.
Lemma tac_wp_store Δ Δ' Δ'' N E i l v e v' Φ : Lemma tac_wp_store Δ Δ' Δ'' N E i l v e v' Φ :
to_val e = Some v' to_val e = Some v'
(Δ heap_ctx N) nclose N E (Δ heap_ctx N) nclose N E
StripLaterEnvs Δ Δ' IntoLaterEnvs Δ Δ'
envs_lookup i Δ' = Some (false, l v)%I envs_lookup i Δ' = Some (false, l v)%I
envs_simple_replace i false (Esnoc Enil i (l v')) Δ' = Some Δ'' envs_simple_replace i false (Esnoc Enil i (l v')) Δ' = Some Δ''
(Δ'' Φ (LitV LitUnit)) Δ WP Store (Lit (LitLoc l)) e @ E {{ Φ }}. (Δ'' Φ (LitV LitUnit)) Δ WP Store (Lit (LitLoc l)) e @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -wp_store // -always_and_sep_l. apply and_intro; first done. intros. rewrite -wp_store // -always_and_sep_l. apply and_intro; first done.
rewrite strip_later_env_sound -later_sep envs_simple_replace_sound //; simpl. rewrite into_later_env_sound -later_sep envs_simple_replace_sound //; simpl.
rewrite right_id. by apply later_mono, sep_mono_r, wand_mono. rewrite right_id. by apply later_mono, sep_mono_r, wand_mono.
Qed. Qed.
Lemma tac_wp_cas_fail Δ Δ' N E i l q v e1 v1 e2 v2 Φ : Lemma tac_wp_cas_fail Δ Δ' N E i l q v e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2 to_val e1 = Some v1 to_val e2 = Some v2
(Δ heap_ctx N) nclose N E (Δ heap_ctx N) nclose N E
StripLaterEnvs Δ Δ' IntoLaterEnvs Δ Δ'
envs_lookup i Δ' = Some (false, l {q} v)%I v v1 envs_lookup i Δ' = Some (false, l {q} v)%I v v1
(Δ' Φ (LitV (LitBool false))) (Δ' Φ (LitV (LitBool false)))
Δ WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}. Δ WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -wp_cas_fail // -always_and_sep_l. apply and_intro; first done. intros. rewrite -wp_cas_fail // -always_and_sep_l. apply and_intro; first done.
rewrite strip_later_env_sound -later_sep envs_lookup_split //; simpl. rewrite into_later_env_sound -later_sep envs_lookup_split //; simpl.
by apply later_mono, sep_mono_r, wand_mono. by apply later_mono, sep_mono_r, wand_mono.
Qed. Qed.
Lemma tac_wp_cas_suc Δ Δ' Δ'' N E i l v e1 v1 e2 v2 Φ : Lemma tac_wp_cas_suc Δ Δ' Δ'' N E i l v e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2 to_val e1 = Some v1 to_val e2 = Some v2
(Δ heap_ctx N) nclose N E (Δ heap_ctx N) nclose N E
StripLaterEnvs Δ Δ' IntoLaterEnvs Δ Δ'
envs_lookup i Δ' = Some (false, l v)%I v = v1 envs_lookup i Δ' = Some (false, l v)%I v = v1
envs_simple_replace i false (Esnoc Enil i (l v2)) Δ' = Some Δ'' envs_simple_replace i false (Esnoc Enil i (l v2)) Δ' = Some Δ''
(Δ'' Φ (LitV (LitBool true))) Δ WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}. (Δ'' Φ (LitV (LitBool true))) Δ WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}.
Proof. Proof.
intros; subst. intros; subst.
rewrite -wp_cas_suc // -always_and_sep_l. apply and_intro; first done. rewrite -wp_cas_suc // -always_and_sep_l. apply and_intro; first done.
rewrite strip_later_env_sound -later_sep envs_simple_replace_sound //; simpl. rewrite into_later_env_sound -later_sep envs_simple_replace_sound //; simpl.
rewrite right_id. by apply later_mono, sep_mono_r, wand_mono. rewrite right_id. by apply later_mono, sep_mono_r, wand_mono.
Qed. Qed.
End heap. End heap.
......
This diff is collapsed.
...@@ -6,10 +6,10 @@ Section ghost. ...@@ -6,10 +6,10 @@ Section ghost.
Context `{inG Λ Σ A}. Context `{inG Λ Σ A}.
Implicit Types a b : A. Implicit Types a b : A.
Global Instance sep_destruct_own p γ a b1 b2 : Global Instance into_sep_own p γ a b1 b2 :
OpDestruct a b1 b2 SepDestruct p (own γ a) (own γ b1) (own γ b2). IntoOp a b1 b2 IntoSep p (own γ a) (own γ b1) (own γ b2).
Proof. rewrite /OpDestruct /SepDestruct => ->. by rewrite own_op. Qed. Proof. rewrite /IntoOp /IntoSep => ->. by rewrite own_op. Qed.
Global Instance sep_split_own γ a b : Global Instance from_sep_own γ a b :
SepSplit (own γ (a b)) (own γ a) (own γ b) | 90. FromSep (own γ (a b)) (own γ a) (own γ b) | 90.
Proof. by rewrite /SepSplit own_op. Qed. Proof. by rewrite /FromSep own_op. Qed.
End ghost. End ghost.
...@@ -9,23 +9,23 @@ Implicit Types N : namespace. ...@@ -9,23 +9,23 @@ Implicit Types N : namespace.
Implicit Types P Q R : iProp Λ Σ. Implicit Types P Q R : iProp Λ Σ.
Lemma tac_inv_fsa {A} (fsa : FSA Λ Σ A) fsaV Δ Δ' E N i P Q Φ : Lemma tac_inv_fsa {A} (fsa : FSA Λ Σ A) fsaV Δ Δ' E N i P Q Φ :
FSASplit Q E fsa fsaV Φ IsFSA Q E fsa fsaV Φ
fsaV nclose N E (of_envs Δ inv N P) fsaV nclose N E (of_envs Δ inv N P)
envs_app false (Esnoc Enil i ( P)) Δ = Some Δ' envs_app false (Esnoc Enil i ( P)) Δ = Some Δ'
(Δ' fsa (E nclose N) (λ a, P Φ a)) Δ Q. (Δ' fsa (E nclose N) (λ a, P Φ a)) Δ Q.
Proof. Proof.
intros ????? HΔ'. rewrite -(fsa_split Q) -(inv_fsa fsa _ _ P) //. intros ????? HΔ'. rewrite (is_fsa Q) -(inv_fsa fsa _ _ P) //.
rewrite // -always_and_sep_l. apply and_intro; first done. rewrite // -always_and_sep_l. apply and_intro; first done.
rewrite envs_app_sound //; simpl. by rewrite right_id HΔ'. rewrite envs_app_sound //; simpl. by rewrite right_id HΔ'.
Qed. Qed.
Lemma tac_inv_fsa_timeless {A} (fsa : FSA Λ Σ A) fsaV Δ Δ' E N i P Q Φ : Lemma tac_inv_fsa_timeless {A} (fsa : FSA Λ Σ A) fsaV Δ Δ' E N i P Q Φ :
FSASplit Q E fsa fsaV Φ IsFSA Q E fsa fsaV Φ
fsaV nclose N E (of_envs Δ inv N P) TimelessP P fsaV nclose N E (of_envs Δ inv N P) TimelessP P
envs_app false (Esnoc Enil i P) Δ = Some Δ' envs_app false (Esnoc Enil i P) Δ = Some Δ'
(Δ' fsa (E nclose N) (λ a, P Φ a)) Δ Q. (Δ' fsa (E nclose N) (λ a, P Φ a)) Δ Q.
Proof. Proof.
intros ?????? HΔ'. rewrite -(fsa_split Q) -(inv_fsa fsa _ _ P) //. intros ?????? HΔ'. rewrite (is_fsa Q) -(inv_fsa fsa _ _ P) //.
rewrite // -always_and_sep_l. apply and_intro, wand_intro_l; first done. rewrite // -always_and_sep_l. apply and_intro, wand_intro_l; first done.
trans (|={E N}=> P Δ)%I; first by rewrite pvs_timeless pvs_frame_r. trans (|={E N}=> P Δ)%I; first by rewrite pvs_timeless pvs_frame_r.
apply (fsa_strip_pvs _). apply (fsa_strip_pvs _).
...@@ -36,7 +36,7 @@ End invariants. ...@@ -36,7 +36,7 @@ End invariants.
Tactic Notation "iInvCore" constr(N) "as" constr(H) := Tactic Notation "iInvCore" constr(N) "as" constr(H) :=
eapply tac_inv_fsa with _ _ _ _ N H _ _; eapply tac_inv_fsa with _ _ _ _ N H _ _;
[let P := match goal with |- FSASplit ?P _ _ _ _ => P end in [let P := match goal with |- IsFSA ?P _ _ _ _ => P end in
apply _ || fail "iInv: cannot viewshift in goal" P apply _ || fail "iInv: cannot viewshift in goal" P
|try fast_done (* atomic *) |try fast_done (* atomic *)
|done || eauto with ndisj (* [eauto with ndisj] is slow *) |done || eauto with ndisj (* [eauto with ndisj] is slow *)
...@@ -62,7 +62,7 @@ Tactic Notation "iInv" constr(N) "as" "{" simple_intropattern(x1) ...@@ -62,7 +62,7 @@ Tactic Notation "iInv" constr(N) "as" "{" simple_intropattern(x1)
Tactic Notation "iInvCore>" constr(N) "as" constr(H) := Tactic Notation "iInvCore>" constr(N) "as" constr(H) :=
eapply tac_inv_fsa_timeless with _ _ _ _ N H _ _; eapply tac_inv_fsa_timeless with _ _ _ _ N H _ _;
[let P := match goal with |- FSASplit ?P _ _ _ _ => P end in [let P := match goal with |- IsFSA ?P _ _ _ _ => P end in
apply _ || fail "iInv: cannot viewshift in goal" P apply _ || fail "iInv: cannot viewshift in goal" P
|try fast_done (* atomic *) |try fast_done (* atomic *)
|done || eauto with ndisj (* [eauto with ndisj] is slow *) |done || eauto with ndisj (* [eauto with ndisj] is slow *)
......
...@@ -7,45 +7,44 @@ Section pvs. ...@@ -7,45 +7,44 @@ Section pvs.
Context {Λ : language} {Σ : iFunctor}. Context {Λ : language} {Σ : iFunctor}.
Implicit Types P Q : iProp Λ Σ. Implicit Types P Q : iProp Λ Σ.
Global Instance to_assumption_pvs E p P Q : Global Instance from_assumption_pvs E p P Q :
ToAssumption p P Q ToAssumption p P (|={E}=> Q)%I. FromAssumption p P Q FromAssumption p P (|={E}=> Q)%I.
Proof. rewrite /ToAssumption=>->. apply pvs_intro. Qed. Proof. rewrite /FromAssumption=>->. apply pvs_intro. Qed.
Global Instance sep_split_pvs E P Q1 Q2 : Global Instance from_sep_pvs E P Q1 Q2 :
SepSplit P Q1 Q2 SepSplit (|={E}=> P) (|={E}=> Q1) (|={E}=> Q2). FromSep P Q1 Q2 FromSep (|={E}=> P) (|={E}=> Q1) (|={E}=> Q2).
Proof. rewrite /SepSplit=><-. apply pvs_sep. Qed. Proof. rewrite /FromSep=><-. apply pvs_sep. Qed.
Global Instance or_split_pvs E1 E2 P Q1 Q2 : Global Instance or_split_pvs E1 E2 P Q1 Q2 :
OrSplit P Q1 Q2 OrSplit (|={E1,E2}=> P) (|={E1,E2}=> Q1) (|={E1,E2}=> Q2). FromOr P Q1 Q2 FromOr (|={E1,E2}=> P) (|={E1,E2}=> Q1) (|={E1,E2}=> Q2).
Proof. rewrite /OrSplit=><-. apply or_elim; apply pvs_mono; auto with I. Qed. Proof. rewrite /FromOr=><-. apply or_elim; apply pvs_mono; auto with I. Qed.
Global Instance exists_split_pvs {A} E1 E2 P (Φ : A iProp Λ Σ) : Global Instance exists_split_pvs {A} E1 E2 P (Φ : A iProp Λ Σ) :
ExistSplit P Φ ExistSplit (|={E1,E2}=> P) (λ a, |={E1,E2}=> Φ a)%I. FromExist P Φ FromExist (|={E1,E2}=> P) (λ a, |={E1,E2}=> Φ a)%I.
Proof. Proof.
rewrite /ExistSplit=><-. apply exist_elim=> a. by rewrite -(exist_intro a). rewrite /FromExist=><-. apply exist_elim=> a. by rewrite -(exist_intro a).
Qed. Qed.
Global Instance frame_pvs E1 E2 R P Q : Global Instance frame_pvs E1 E2 R P Q :
Frame R P Q Frame R (|={E1,E2}=> P) (|={E1,E2}=> Q). Frame R P Q Frame R (|={E1,E2}=> P) (|={E1,E2}=> Q).
Proof. rewrite /Frame=><-. by rewrite pvs_frame_l. Qed. Proof. rewrite /Frame=><-. by rewrite pvs_frame_l. Qed.
Global Instance to_wand_pvs E1 E2 R P Q : Global Instance into_wand_pvs E1 E2 R P Q :
ToWand R P Q ToWand R (|={E1,E2}=> P) (|={E1,E2}=> Q) | 100. IntoWand R P Q IntoWand R (|={E1,E2}=> P) (|={E1,E2}=> Q) | 100.
Proof. rewrite /ToWand=>->. apply wand_intro_l. by rewrite pvs_wand_r. Qed. Proof. rewrite /IntoWand=>->. apply wand_intro_l. by rewrite pvs_wand_r. Qed.
Class FSASplit {A} (P : iProp Λ Σ) (E : coPset) Class IsFSA {A} (P : iProp Λ Σ) (E : coPset)
(fsa : FSA Λ Σ A) (fsaV : Prop) (Φ : A iProp Λ Σ) := { (fsa : FSA Λ Σ A) (fsaV : Prop) (Φ : A iProp Λ Σ) := {
fsa_split : fsa E Φ ⊣⊢ P; is_fsa : P ⊣⊢ fsa E Φ;
fsa_split_is_fsa :> FrameShiftAssertion fsaV fsa; is_fsa_is_fsa :> FrameShiftAssertion fsaV fsa;
}. }.
Global Arguments fsa_split {_} _ _ _ _ _ {_}. Global Arguments is_fsa {_} _ _ _ _ _ {_}.
Global Instance fsa_split_pvs E P : Global Instance is_fsa_pvs E P :
FSASplit (|={E}=> P)%I E pvs_fsa True (λ _, P). IsFSA (|={E}=> P)%I E pvs_fsa True (λ _, P).
Proof. split. done. apply _. Qed. Proof. split. done. apply _. Qed.
Global Instance fsa_split_fsa {A} (fsa : FSA Λ Σ A) E Φ : Global Instance is_fsa_fsa {A} (fsa : FSA Λ Σ A) E Φ :
FrameShiftAssertion fsaV fsa FSASplit (fsa E Φ) E fsa fsaV Φ. FrameShiftAssertion fsaV fsa IsFSA (fsa E Φ) E fsa fsaV Φ.
Proof. done. Qed. Proof. done. Qed.
Global Instance to_assert_pvs {A} P Q E (fsa : FSA Λ Σ A) fsaV Φ : Global Instance to_assert_pvs {A} P Q E (fsa : FSA Λ Σ A) fsaV Φ :
FSASplit Q E fsa fsaV Φ ToAssert P Q (|={E}=> P). IsFSA Q E fsa fsaV Φ IntoAssert P Q (|={E}=> P).
Proof. Proof.
intros. intros. by rewrite /IntoAssert pvs_frame_r wand_elim_r (is_fsa Q) fsa_pvs_fsa.
by rewrite /ToAssert pvs_frame_r wand_elim_r -(fsa_split Q) fsa_pvs_fsa.
Qed. Qed.
Lemma tac_pvs_intro Δ E1 E2 Q : E1 = E2 (Δ Q) Δ |={E1,E2}=> Q. Lemma tac_pvs_intro Δ E1 E2 Q : E1 = E2 (Δ Q) Δ |={E1,E2}=> Q.
...@@ -66,11 +65,11 @@ Qed. ...@@ -66,11 +65,11 @@ Qed.
Lemma tac_pvs_elim_fsa {A} (fsa : FSA Λ Σ A) fsaV Δ Δ' E i p P' P Q Φ : Lemma tac_pvs_elim_fsa {A} (fsa : FSA Λ Σ A) fsaV Δ Δ' E i p P' P Q Φ :
envs_lookup i Δ = Some (p, P') P' = (|={E}=> P)%I envs_lookup i Δ = Some (p, P') P' = (|={E}=> P)%I
FSASplit Q E fsa fsaV Φ IsFSA Q E fsa fsaV Φ
envs_replace i p false (Esnoc Enil i P) Δ = Some Δ' envs_replace i p false (Esnoc Enil i P) Δ = Some Δ'
(Δ' fsa E Φ) Δ Q. (Δ' fsa E Φ) Δ Q.
Proof. Proof.
intros ? -> ??. rewrite -(fsa_split Q) -fsa_pvs_fsa. intros ? -> ??. rewrite (is_fsa Q) -fsa_pvs_fsa.
eapply tac_pvs_elim; set_solver. eapply tac_pvs_elim; set_solver.
Qed. Qed.
...@@ -85,12 +84,12 @@ Proof. ...@@ -85,12 +84,12 @@ Proof.
Qed. Qed.
Lemma tac_pvs_timeless_fsa {A} (fsa : FSA Λ Σ A) fsaV Δ Δ' E i p P Q Φ : Lemma tac_pvs_timeless_fsa {A} (fsa : FSA Λ Σ A) fsaV Δ Δ' E i p P Q Φ :
FSASplit Q E fsa fsaV Φ IsFSA Q E fsa fsaV Φ
envs_lookup i Δ = Some (p, P)%I TimelessP P envs_lookup i Δ = Some (p, P)%I TimelessP P
envs_simple_replace i p (Esnoc Enil i P) Δ = Some Δ' envs_simple_replace i p (Esnoc Enil i P) Δ = Some Δ'
(Δ' fsa E Φ) Δ Q. (Δ' fsa E Φ) Δ Q.
Proof. Proof.
intros ????. rewrite -(fsa_split Q) -fsa_pvs_fsa. intros ????. rewrite (is_fsa Q) -fsa_pvs_fsa.
eauto using tac_pvs_timeless. eauto using tac_pvs_timeless.
Qed. Qed.
End pvs. End pvs.
...@@ -114,7 +113,7 @@ Tactic Notation "iPvsCore" constr(H) := ...@@ -114,7 +113,7 @@ Tactic Notation "iPvsCore" constr(H) :=
[env_cbv; reflexivity || fail "iPvs:" H "not found" [env_cbv; reflexivity || fail "iPvs:" H "not found"
|let P := match goal with |- ?P = _ => P end in |let P := match goal with |- ?P = _ => P end in
reflexivity || fail "iPvs:" H ":" P "not a pvs with the right mask" reflexivity || fail "iPvs:" H ":" P "not a pvs with the right mask"
|let P := match goal with |- FSASplit ?P _ _ _ _ => P end in |let P := match goal with |- IsFSA ?P _ _ _ _ => P end in
apply _ || fail "iPvs:" P "not a pvs" apply _ || fail "iPvs:" P "not a pvs"
|env_cbv; reflexivity|simpl] |env_cbv; reflexivity|simpl]
end. end.
...@@ -170,7 +169,7 @@ Tactic Notation "iTimeless" constr(H) := ...@@ -170,7 +169,7 @@ Tactic Notation "iTimeless" constr(H) :=
|env_cbv; reflexivity|simpl] |env_cbv; reflexivity|simpl]
| |- _ => | |- _ =>
eapply tac_pvs_timeless_fsa with _ _ _ _ H _ _ _; eapply tac_pvs_timeless_fsa with _ _ _ _ H _ _ _;
[let P := match goal with |- FSASplit ?P _ _ _ _ => P end in [let P := match goal with |- IsFSA ?P _ _ _ _ => P end in
apply _ || fail "iTimeless: " P "not a pvs" apply _ || fail "iTimeless: " P "not a pvs"
|env_cbv; reflexivity || fail "iTimeless:" H "not found" |env_cbv; reflexivity || fail "iTimeless:" H "not found"
|let P := match goal with |- TimelessP ?P => P end in |let P := match goal with |- TimelessP ?P => P end in
......
...@@ -8,7 +8,7 @@ Context `{stsG Λ Σ sts} (φ : sts.state sts → iPropG Λ Σ). ...@@ -8,7 +8,7 @@ Context `{stsG Λ Σ sts} (φ : sts.state sts → iPropG Λ Σ).
Implicit Types P Q : iPropG Λ Σ. Implicit Types P Q : iPropG Λ Σ.
Lemma tac_sts_fsa {A} (fsa : FSA Λ _ A) fsaV Δ E N i γ S T Q Φ : Lemma tac_sts_fsa {A} (fsa : FSA Λ _ A) fsaV Δ E N i γ S T Q Φ :
FSASplit Q E fsa fsaV Φ IsFSA Q E fsa fsaV Φ
fsaV fsaV
envs_lookup i Δ = Some (false, sts_ownS γ S T) envs_lookup i Δ = Some (false, sts_ownS γ S T)
(of_envs Δ sts_ctx γ N φ) nclose N E (of_envs Δ sts_ctx γ N φ) nclose N E
...@@ -18,7 +18,7 @@ Lemma tac_sts_fsa {A} (fsa : FSA Λ _ A) fsaV Δ E N i γ S T Q Φ : ...@@ -18,7 +18,7 @@ Lemma tac_sts_fsa {A} (fsa : FSA Λ _ A) fsaV Δ E N i γ S T Q Φ :
sts.steps (s, T) (s', T') φ s' (sts_own γ s' T' - Φ a)))) sts.steps (s, T) (s', T') φ s' (sts_own γ s' T' - Φ a))))
Δ Q. Δ Q.
Proof. Proof.
intros ????? HΔ'. rewrite -(fsa_split Q) -(sts_fsaS φ fsa) //. intros ????? HΔ'. rewrite (is_fsa Q) -(sts_fsaS φ fsa) //.
rewrite // -always_and_sep_l. apply and_intro; first done. rewrite // -always_and_sep_l. apply and_intro; first done.
rewrite envs_lookup_sound //; simpl; apply sep_mono_r. rewrite envs_lookup_sound //; simpl; apply sep_mono_r.
apply forall_intro=>s; apply wand_intro_l. apply forall_intro=>s; apply wand_intro_l.
...@@ -36,7 +36,7 @@ Tactic Notation "iSts" constr(H) "as" ...@@ -36,7 +36,7 @@ Tactic Notation "iSts" constr(H) "as"
| gname => eapply tac_sts_fsa with _ _ _ _ _ _ _ H _ _ _ | gname => eapply tac_sts_fsa with _ _ _ _ _ _ _ H _ _ _
| _ => fail "iSts:" H "not a string or gname" | _ => fail "iSts:" H "not a string or gname"
end; end;
[let P := match goal with |- FSASplit ?P _ _ _ _ => P end in [let P := match goal with |- IsFSA ?P _ _ _ _ => P end in
apply _ || fail "iSts: cannot viewshift in goal" P apply _ || fail "iSts: cannot viewshift in goal" P
|try fast_done (* atomic *) |try fast_done (* atomic *)
|iAssumptionCore || fail "iSts:" H "not found" |iAssumptionCore || fail "iSts:" H "not found"
......
This diff is collapsed.
...@@ -11,7 +11,7 @@ Implicit Types Φ : val Λ → iProp Λ Σ. ...@@ -11,7 +11,7 @@ Implicit Types Φ : val Λ → iProp Λ Σ.
Global Instance frame_wp E e R Φ Ψ : Global Instance frame_wp E e R Φ Ψ :
( v, Frame R (Φ v) (Ψ v)) Frame R (WP e @ E {{ Φ }}) (WP e @ E {{ Ψ }}). ( v, Frame R (Φ v) (Ψ v)) Frame R (WP e @ E {{ Φ }}) (WP e @ E {{ Ψ }}).
Proof. rewrite /Frame=> HR. rewrite wp_frame_l. apply wp_mono, HR. Qed. Proof. rewrite /Frame=> HR. rewrite wp_frame_l. apply wp_mono, HR. Qed.
Global Instance fsa_split_wp E e Φ : Global Instance is_fsa_wp E e Φ :
FSASplit (WP e @ E {{ Φ }})%I E (wp_fsa e) (language.atomic e) Φ. IsFSA (WP e @ E {{ Φ }})%I E (wp_fsa e) (language.atomic e) Φ.
Proof. split. done. apply _. Qed. Proof. split. done. apply _. Qed.
End weakestpre. End weakestpre.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment