Commit 3627c45f authored by Ralf Jung's avatar Ralf Jung

New IntoAcc typeclass to decouple creating and elliminating accessors; ElimInv...

New IntoAcc typeclass to decouple creating and elliminating accessors; ElimInv supports both with and without Hclose
parent 6ae49bd9
...@@ -144,8 +144,7 @@ Section auth. ...@@ -144,8 +144,7 @@ Section auth.
a f t φ t u b, a f t φ t u b,
(f t, a) ~l~> (f u, b) φ u ={E∖↑N,E}= auth_own γ b. (f t, a) ~l~> (f u, b) φ u ={E∖↑N,E}= auth_own γ b.
Proof using Type*. Proof using Type*.
iIntros (?) "[Hinv Hγf]". rewrite /auth_ctx. iIntros (?) "[#? Hγf]". rewrite /auth_ctx. iInv N as "Hinv" "Hclose".
iMod (inv_open with "Hinv") as "[Hinv Hclose]"; first done.
(* The following is essentially a very trivial composition of the accessors (* The following is essentially a very trivial composition of the accessors
[auth_acc] and [inv_open] -- but since we don't have any good support [auth_acc] and [inv_open] -- but since we don't have any good support
for that currently, this gets more tedious than it should, with us having for that currently, this gets more tedious than it should, with us having
......
...@@ -83,21 +83,22 @@ Section proofs. ...@@ -83,21 +83,22 @@ Section proofs.
cinv N γ P - cinv_own γ p ={E,E∖↑N}= P cinv_own γ p ( P ={E∖↑N,E}= True). cinv N γ P - cinv_own γ p ={E,E∖↑N}= P cinv_own γ p ( P ={E∖↑N,E}= True).
Proof. Proof.
iIntros (?) "#Hinv Hγ". iDestruct "Hinv" as (P') "[#HP' Hinv]". iIntros (?) "#Hinv Hγ". iDestruct "Hinv" as (P') "[#HP' Hinv]".
iMod (inv_open with "Hinv") as "[[HP | >Hγ'] Hclose]"; first done. iInv N as "[HP | >Hγ']" "Hclose".
- iIntros "!> {$Hγ}". iSplitL "HP". - iIntros "!> {$Hγ}". iSplitL "HP".
+ iApply "HP'". done. + iNext. iApply "HP'". done.
+ iIntros "HP". iApply "Hclose". iLeft. iNext. by iApply "HP'". + iIntros "HP". iApply "Hclose". iLeft. iNext. by iApply "HP'".
- iDestruct (cinv_own_1_l with "Hγ' Hγ") as %[]. - iDestruct (cinv_own_1_l with "Hγ' Hγ") as %[].
Qed. Qed.
Global Instance into_inv_cinv N γ P : IntoInv (cinv N γ P) N. Global Instance into_inv_cinv N γ P : IntoInv (cinv N γ P) N.
Global Instance elim_inv_cinv E N γ P p Q Q' : Global Instance elim_inv_cinv E N γ P p :
AccElim E (E∖↑N) ( P cinv_own γ p) ( P) None Q Q' IntoAcc (X:=unit) (cinv N γ P)
ElimInv (N E) (cinv N γ P) (cinv_own γ p) ( P cinv_own γ p) Q Q'. (N E) (cinv_own γ p) E (E∖↑N)
(λ _, P cinv_own γ p)%I (λ _, P)%I (λ _, None)%I.
Proof. Proof.
rewrite /ElimInv /AccElim. iIntros (Helim ?) "(#Hinv & Hown & Hcont)". rewrite /IntoAcc /accessor. iIntros (?) "#Hinv Hown".
iApply (Helim with "Hcont"). clear Helim. rewrite -assoc. rewrite exist_unit -assoc.
iApply (cinv_open with "Hinv"); done. iApply (cinv_open with "Hinv"); done.
Qed. Qed.
End proofs. End proofs.
......
...@@ -109,12 +109,12 @@ Qed. ...@@ -109,12 +109,12 @@ Qed.
Global Instance into_inv_inv N P : IntoInv (inv N P) N. Global Instance into_inv_inv N P : IntoInv (inv N P) N.
Global Instance elim_inv_inv E N P Q Q' : Global Instance elim_inv_inv E N P :
AccElim E (E∖↑N) ( P) ( P) None Q Q' IntoAcc (X:=unit) (inv N P)
ElimInv (N E) (inv N P) True ( P) Q Q'. (N E) True E (E∖↑N) (λ _, P)%I (λ _, P)%I (λ _, None)%I.
Proof. Proof.
rewrite /ElimInv /AccElim. iIntros (Hopener ?) "(#Hinv & _ & Hcont)". rewrite /IntoAcc /accessor exist_unit.
iApply (Hopener with "Hcont"). iApply inv_open; done. iIntros (?) "#Hinv _". iApply inv_open; done.
Qed. Qed.
Lemma inv_open_timeless E N P `{!Timeless P} : Lemma inv_open_timeless E N P `{!Timeless P} :
...@@ -123,4 +123,5 @@ Proof. ...@@ -123,4 +123,5 @@ Proof.
iIntros (?) "Hinv". iMod (inv_open with "Hinv") as "[>HP Hclose]"; auto. iIntros (?) "Hinv". iMod (inv_open with "Hinv") as "[>HP Hclose]"; auto.
iIntros "!> {$HP} HP". iApply "Hclose"; auto. iIntros "!> {$HP} HP". iApply "Hclose"; auto.
Qed. Qed.
End inv. End inv.
...@@ -101,7 +101,7 @@ Section proofs. ...@@ -101,7 +101,7 @@ Section proofs.
rewrite [F as X in na_own p X](union_difference_L (N) F) //. rewrite [F as X in na_own p X](union_difference_L (N) F) //.
rewrite [X in (X _)](union_difference_L {[i]} (N)) ?na_own_union; [|set_solver..]. rewrite [X in (X _)](union_difference_L {[i]} (N)) ?na_own_union; [|set_solver..].
iDestruct "Htoks" as "[[Htoki $] $]". iDestruct "Htoks" as "[[Htoki $] $]".
iMod (inv_open with "Hinv") as "[[[$ >Hdis]|>Htoki2] Hclose]"; first done. iInv "Hinv" as "[[$ >Hdis]|>Htoki2]" "Hclose".
- iMod ("Hclose" with "[Htoki]") as "_"; first auto. - iMod ("Hclose" with "[Htoki]") as "_"; first auto.
iIntros "!> [HP $]". iIntros "!> [HP $]".
iInv N as "[[_ >Hdis2]|>Hitok]". iInv N as "[[_ >Hdis2]|>Hitok]".
...@@ -113,14 +113,14 @@ Section proofs. ...@@ -113,14 +113,14 @@ Section proofs.
Global Instance into_inv_na p N P : IntoInv (na_inv p N P) N. Global Instance into_inv_na p N P : IntoInv (na_inv p N P) N.
Global Instance elim_inv_na p F E N P Q Q': Global Instance elim_inv_na p F E N P :
AccElim E E ( P na_own p (F N)) ( P na_own p (F N)) IntoAcc (X:=unit) (na_inv p N P)
(Some (na_own p F)) Q Q' (N E N F) (na_own p F) E E
ElimInv (N E N F) (na_inv p N P) (na_own p F) (λ _, P na_own p (F∖↑N))%I (λ _, P na_own p (F∖↑N))%I
( P na_own p (F∖↑N)) Q Q'. (λ _, Some (na_own p F))%I.
Proof. Proof.
rewrite /ElimInv /AccElim. iIntros (Helim (?&?)) "(#Hinv & Hown & Hcont)". rewrite /IntoAcc /accessor. iIntros ((?&?)) "#Hinv Hown".
iApply (Helim with "Hcont"). clear Helim. rewrite -assoc /=. rewrite exist_unit -assoc /=.
iApply (na_inv_open with "Hinv"); done. iApply (na_inv_open with "Hinv"); done.
Qed. Qed.
End proofs. End proofs.
...@@ -156,8 +156,7 @@ Section sts. ...@@ -156,8 +156,7 @@ Section sts.
s S φ s s' T', s S φ s s' T',
sts.steps (s, T) (s', T') φ s' ={E∖↑N,E}= sts_own γ s' T'. sts.steps (s, T) (s', T') φ s' ={E∖↑N,E}= sts_own γ s' T'.
Proof. Proof.
iIntros (?) "[Hinv Hγf]". rewrite /sts_ctx. iIntros (?) "[#? Hγf]". rewrite /sts_ctx. iInv N as "Hinv" "Hclose".
iMod (inv_open with "Hinv") as "[Hinv Hclose]"; first done.
(* The following is essentially a very trivial composition of the accessors (* The following is essentially a very trivial composition of the accessors
[sts_acc] and [inv_open] -- but since we don't have any good support [sts_acc] and [inv_open] -- but since we don't have any good support
for that currently, this gets more tedious than it should, with us having for that currently, this gets more tedious than it should, with us having
......
...@@ -72,8 +72,7 @@ Qed. ...@@ -72,8 +72,7 @@ Qed.
Lemma vs_inv N E P Q R : Lemma vs_inv N E P Q R :
N E inv N R ( R P ={E∖↑N}=> R Q) P ={E}=> Q. N E inv N R ( R P ={E∖↑N}=> R Q) P ={E}=> Q.
Proof. Proof.
iIntros (?) "#[Hinv Hvs] !# HP". iIntros (?) "#[? Hvs] !# HP". iInv N as "HR" "Hclose".
iMod (inv_open with "Hinv") as "[HR Hclose]"; first done.
iMod ("Hvs" with "[HR HP]") as "[? $]"; first by iFrame. iMod ("Hvs" with "[HR HP]") as "[? $]"; first by iFrame.
by iApply "Hclose". by iApply "Hclose".
Qed. Qed.
......
...@@ -219,6 +219,20 @@ Proof. ...@@ -219,6 +219,20 @@ Proof.
- apply impl_intro_r, impl_elim_r', exist_elim=>x. - apply impl_intro_r, impl_elim_r', exist_elim=>x.
apply impl_intro_r. by rewrite (forall_elim x) impl_elim_r. apply impl_intro_r. by rewrite (forall_elim x) impl_elim_r.
Qed. Qed.
Lemma forall_unit (Ψ : unit PROP) :
( x, Ψ x) Ψ ().
Proof.
apply (anti_symm ()).
- rewrite (forall_elim ()) //.
- apply forall_intro=>[[]]. done.
Qed.
Lemma exist_unit (Ψ : unit PROP) :
( x, Ψ x) Ψ ().
Proof.
apply (anti_symm ()).
- apply exist_elim=>[[]]. done.
- rewrite -(exist_intro ()). done.
Qed.
Lemma or_and_l P Q R : P Q R (P Q) (P R). Lemma or_and_l P Q R : P Q R (P Q) (P R).
Proof. Proof.
......
...@@ -68,7 +68,7 @@ Section increment_client. ...@@ -68,7 +68,7 @@ Section increment_client.
WP incr_client #x {{ _, True }}%I. WP incr_client #x {{ _, True }}%I.
Proof using Type*. Proof using Type*.
wp_let. wp_alloc l as "Hl". wp_let. wp_let. wp_alloc l as "Hl". wp_let.
iMod (inv_alloc nroot _ (x':Z, l #x')%I with "[Hl]") as "#Hinv"; first eauto. iMod (inv_alloc nroot _ (x':Z, l #x')%I with "[Hl]") as "#?"; first eauto.
(* FIXME: I am only usign persistent stuff, so I should be allowed (* FIXME: I am only usign persistent stuff, so I should be allowed
to move this to the persisten context even without the additional □. *) to move this to the persisten context even without the additional □. *)
iAssert ( atomic_update (λ (v: Z), l #v) iAssert ( atomic_update (λ (v: Z), l #v)
...@@ -78,8 +78,7 @@ Section increment_client. ...@@ -78,8 +78,7 @@ Section increment_client.
{ iAlways. iExists True%I, True%I. repeat (iSplit; first done). clear x. { iAlways. iExists True%I, True%I. repeat (iSplit; first done). clear x.
iIntros "!#" (E) "% _". iIntros "!#" (E) "% _".
assert (E = ) as -> by set_solver. assert (E = ) as -> by set_solver.
iMod (inv_open with "Hinv") as "[>H↦ Hclose]"; first done. iInv nroot as (x) ">H↦" "Hclose".
iDestruct "H↦" as (x) "H↦".
iMod fupd_intro_mask' as "Hclose2"; last iModIntro; first set_solver. iMod fupd_intro_mask' as "Hclose2"; last iModIntro; first set_solver.
iExists _. iFrame. iSplit. iExists _. iFrame. iSplit.
{ iIntros "H↦". iMod "Hclose2" as "_". iMod ("Hclose" with "[-]"); last done. { iIntros "H↦". iMod "Hclose2" as "_". iMod ("Hclose" with "[-]"); last done.
......
...@@ -405,25 +405,26 @@ Section proofmode_classes. ...@@ -405,25 +405,26 @@ Section proofmode_classes.
AddModal (|={E}=> P) P (WP e @ s; E {{ Φ }}). AddModal (|={E}=> P) P (WP e @ s; E {{ Φ }}).
Proof. by rewrite /AddModal fupd_frame_r wand_elim_r fupd_wp. Qed. Proof. by rewrite /AddModal fupd_frame_r wand_elim_r fupd_wp. Qed.
Global Instance acc_elim_wp E1 E2 P P' (P'' : option _) e s Φ : Global Instance acc_elim_wp {X} E1 E2 α β γ e s Φ :
Atomic (stuckness_to_atomicity s) e Atomic (stuckness_to_atomicity s) e
AccElim E1 E2 P P' P'' (WP e @ s; E1 {{ Φ }}) AccElim (X:=X) E1 E2 α β γ (WP e @ s; E1 {{ Φ }})
(WP e @ s; E2 {{ v, P' coq_tactics.maybe_wand P'' (Φ v) }})%I. (λ x, WP e @ s; E2 {{ v, β x coq_tactics.maybe_wand (γ x) (Φ v) }})%I.
Proof. Proof.
intros ?. rewrite /AccElim. setoid_rewrite coq_tactics.maybe_wand_sound. intros ?. rewrite /AccElim. setoid_rewrite coq_tactics.maybe_wand_sound.
iIntros "Hinner >[HP Hclose]". iIntros "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]".
iApply (wp_wand with "[Hinner HP]"); first by iApply "Hinner". iApply (wp_wand with "[Hinner Hα]"); first by iApply "Hinner".
iIntros (v) "[HP HΦ]". iApply "HΦ". by iApply "Hclose". iIntros (v) "[Hβ HΦ]". iApply "HΦ". by iApply "Hclose".
Qed. Qed.
Global Instance acc_elim_wp_nonatomic E P P' (P'' : option _) e s Φ : Global Instance acc_elim_wp_nonatomic {X} E α β γ e s Φ :
AccElim E E P P' P'' (WP e @ s; E {{ Φ }}) AccElim (X:=X) E E α β γ (WP e @ s; E {{ Φ }})
(WP e @ s; E {{ v, P' coq_tactics.maybe_wand P'' (Φ v) }})%I. (λ x, WP e @ s; E {{ v, β x coq_tactics.maybe_wand (γ x) (Φ v) }})%I.
Proof. Proof.
rewrite /AccElim. setoid_rewrite coq_tactics.maybe_wand_sound. rewrite /AccElim. setoid_rewrite coq_tactics.maybe_wand_sound.
iIntros "Hinner >[HP Hclose]". iApply wp_fupd. iIntros "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]".
iApply (wp_wand with "[Hinner HP]"); first by iApply "Hinner". iApply wp_fupd.
iIntros (v) "[HP HΦ]". iApply "HΦ". by iApply "Hclose". iApply (wp_wand with "[Hinner Hα]"); first by iApply "Hinner".
iIntros (v) "[Hβ HΦ]". iApply "HΦ". by iApply "Hclose".
Qed. Qed.
End proofmode_classes. End proofmode_classes.
...@@ -552,15 +552,46 @@ Global Instance add_modal_embed_fupd_goal `{BiEmbedFUpd PROP PROP'} ...@@ -552,15 +552,46 @@ Global Instance add_modal_embed_fupd_goal `{BiEmbedFUpd PROP PROP'}
Proof. by rewrite /AddModal !embed_fupd. Qed. Proof. by rewrite /AddModal !embed_fupd. Qed.
(* AccElim *) (* AccElim *)
Global Instance acc_elim_vs `{BiFUpd PROP} E1 E2 E P P' (P'' : option PROP) Q : Global Instance acc_elim_vs `{BiFUpd PROP} {X} E1 E2 E α β γ Q :
(* FIXME: Why %I? AccElim sets the right scopes! *) (* FIXME: Why %I? AccElim sets the right scopes! *)
AccElim E1 E2 P P' P'' AccElim (X:=X) E1 E2 α β γ
(|={E1,E}=> Q) (|={E2}=> (P' (coq_tactics.maybe_wand P'' (|={E1,E}=> Q))))%I. (|={E1,E}=> Q)
Proof. (λ x, |={E2}=> (β x (coq_tactics.maybe_wand (γ x) (|={E1,E}=> Q))))%I.
rewrite /AccElim coq_tactics.maybe_wand_sound. Proof.
iIntros "Hinner >[HP Hclose]". rewrite /AccElim. setoid_rewrite coq_tactics.maybe_wand_sound.
iMod ("Hinner" with "HP") as "[HP Hfin]". iIntros "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]".
iMod ("Hclose" with "HP") as "HP''". by iApply "Hfin". iMod ("Hinner" with "Hα") as "[Hβ Hfin]".
iMod ("Hclose" with "Hβ") as "Hγ". by iApply "Hfin".
Qed.
(* IntoAcc *)
(* TODO: We could have instances from "unfolded" accessors with or without
the first binder. *)
(* ElimInv *)
Global Instance elim_inv_acc_without_close `{BiFUpd PROP} φ Pinv Pin
E1 E2 α β γ Q (Q' : () PROP) :
IntoAcc (X:=unit) Pinv φ Pin E1 E2 α β γ
AccElim (X:=unit) E1 E2 α β γ Q Q'
ElimInv φ Pinv Pin (α ()) None Q (Q' ()).
Proof.
rewrite /AccElim /IntoAcc /ElimInv.
iIntros (Hacc Helim Hφ) "(Hinv & Hin & Hcont)".
iApply (Helim with "[Hcont]").
- rewrite right_id. iIntros ([]). done.
- iApply (Hacc with "Hinv Hin"). done.
Qed.
Global Instance elim_inv_acc_with_close `{BiFUpd PROP} φ Pinv Pin
E1 E2 α β γ Q Q' :
IntoAcc (X:=unit) Pinv φ Pin E1 E2 α β γ
( R, ElimModal True false false (|={E1,E2}=> R) R Q Q')
ElimInv φ Pinv Pin (α ()) (Some (β () ={E2,E1}= default emp (γ ()) id))%I Q Q'.
Proof.
rewrite /AccElim /IntoAcc /ElimInv.
iIntros (Hacc Helim Hφ) "(Hinv & Hin & Hcont)".
iMod (Hacc with "Hinv Hin") as ([]) "[Hα Hclose]"; first done.
iApply "Hcont". simpl. iSplitL "Hα"; done.
Qed. Qed.
(* IntoLater *) (* IntoLater *)
......
...@@ -513,40 +513,74 @@ Class IntoInv {PROP : bi} (P: PROP) (N: namespace). ...@@ -513,40 +513,74 @@ Class IntoInv {PROP : bi} (P: PROP) (N: namespace).
Arguments IntoInv {_} _%I _. Arguments IntoInv {_} _%I _.
Hint Mode IntoInv + ! - : typeclass_instances. Hint Mode IntoInv + ! - : typeclass_instances.
(** Typeclass for assertions around which accessors can be elliminated. (** Accessors.
Inputs: [Q], [P], [P'], [P''] This definition only exists for the purpose of the proof mode; a truly
Outputs: [Q'] usable and general form would use telescopes and also allow binders for the
In/Out (can be an evar and will not usually be instantiated): [E1], [E2] closing view shift. [γ] is an [option] to make it easy for AccElim
instances to recognize the [emp] case and make it look nicer. *)
Elliminates an accessor [|={E1,E2}=> P ∗ (P' ={E2,E1}=∗ P'')] in goal [Q'], Definition accessor `{BiFUpd PROP} {X : Type} (E1 E2 : coPset)
turning the goal into [Q'] with a new assumption [P]. If [P''] is None, (α β : X PROP) (γ : X option PROP) : PROP :=
that signifies [emp] and will be used to make the goal shown to the user (|={E1,E2}=> x, α x (β x ={E2,E1}= default emp (γ x) id))%I.
nicer (i.e., no unnecessary hypothesis is added). [φ] is a Coq-level
side-condition that will be attempted to be discharged by solve_ndisj. *) (* Typeclass for assertions around which accessors can be elliminated.
Class AccElim `{BiFUpd PROP} E1 E2 (P P' : PROP) (P'' : option PROP) (Q Q' : PROP) := Inputs: [Q], [α], [β], [γ]
acc_elim : ((P - Q') - (|={E1,E2}=> P (P' ={E2,E1}= default emp P'' id)) - Q). Outputs: [Q']
Arguments AccElim {_} {_} _ _ _%I _%I _%I _%I : simpl never. In/Out (can be an evar and will not usually be instantiated): [E1], [E2]
Arguments acc_elim {_} {_} _ _ _%I _%I _%I _%I {_}.
Hint Mode AccElim + + - - ! ! ! ! - : typeclass_instances. Elliminates an accessor [accessor E1 E2 α β γ] in goal [Q'], turning the goal
into [Q'] with a new assumption [α x]. *)
(* Input: [Pinv] Class AccElim `{BiFUpd PROP} {X : Type} E1 E2 (α β : X PROP) (γ : X option PROP)
(Q : PROP) (Q' : X PROP) :=
acc_elim : (( x, α x - Q' x) - accessor E1 E2 α β γ - Q).
Arguments AccElim {_} {_} {_} _ _ _%I _%I _%I _%I : simpl never.
Arguments acc_elim {_} {_} {_} _ _ _%I _%I _%I _%I {_}.
Hint Mode AccElim + + ! - - ! ! ! ! - : typeclass_instances.
(* Turn [P] into an accessor.
Inputs:
- [Pacc]: the assertion to be turned into an accessor (e.g. an invariant)
Outputs:
- [Pin]: additional logic assertion needed for starting the accessor.
- [φ]: additional Coq assertion needed for starting the accessor.
- [X] [α], [β], [γ]: the accessor parameters.
In/Out (can be an evar and will not usually be instantiated): [E1], [E2]
*)
Class IntoAcc `{BiFUpd PROP} (Pacc : PROP) (φ : Prop) (Pin : PROP)
{X : Type} E1 E2 (α β : X PROP) (γ : X option PROP) :=
into_acc : φ Pacc - Pin - accessor E1 E2 α β γ.
Arguments IntoAcc {_} {_} _%I _ _%I {_} _ _ _%I _%I _%I : simpl never.
Arguments into_acc {_} {_} _%I _ _%I {_} _ _ _%I _%I _%I {_} : simpl never.
Hint Mode IntoAcc + - ! - - - - - - - - : typeclass_instances.
(* The typeclass used for the [iInv] tactic.
Input: [Pinv]
Arguments: Arguments:
- [Pinv] is an invariant assertion - [Pinv] is an invariant assertion
- [Pin] is an additional assertion needed for opening an invariant - [Pin] is an additional logic assertion needed for opening an invariant
- [φ] is an additional Coq assertion needed for opening an invariant
- [Pout] is the assertion obtained by opening the invariant - [Pout] is the assertion obtained by opening the invariant
- [Pclose] is the closing view shift. It must be (Some _) or None
when doing typeclass search as instances are allowed to make a
case distinction on whether the user wants a closing view-shift or not.
- [Q] is a goal on which iInv may be invoked - [Q] is a goal on which iInv may be invoked
- [Q'] is the transformed goal that must be proved after opening the invariant. - [Q'] is the transformed goal that must be proved after opening the invariant.
There are similarities to the definition of ElimModal, however we Most users will never want to instantiate this; there is a general instance
want to be general enough to support uses in settings where there based on [AccElim] and [IntoAcc]. However, logics like Iris 2 that support
is not a clearly associated instance of ElimModal of the right form invariants but not mask-changing fancy updates can use this class directly to
(e.g. to handle Iris 2.0 usage of iInv). still benefit from [iInv].
TODO: Add support for a binder (like accessors have it).
This is defined on sbi instead of bi as typeclass search otherwise
fails (e.g. in the iInv as used in cancelable_invariants.v)
*) *)
Class ElimInv {PROP : bi} (φ : Prop) (Pinv Pin Pout Q Q' : PROP) := Class ElimInv {PROP : sbi} (φ : Prop)
elim_inv : φ Pinv Pin (Pout - Q') Q. (Pinv Pin : PROP) (Pout : PROP) (Pclose : option PROP) (Q Q' : PROP) :=
Arguments ElimInv {_} _ _%I _%I _%I _%I _%I : simpl never. elim_inv : φ Pinv Pin (Pout default emp Pclose id - Q') Q.
Arguments elim_inv {_} _ _ _%I _%I _%I _%I _%I. Arguments ElimInv {_} _ _%I _%I _%I _%I _%I _%I : simpl never.
Hint Mode ElimInv + - ! - - ! - : typeclass_instances. Arguments elim_inv {_} _ _%I _%I _%I _%I _%I _%I {_}.
Hint Mode ElimInv + - ! - - ! ! - : typeclass_instances.
(* We make sure that tactics that perform actions on *specific* hypotheses or (* We make sure that tactics that perform actions on *specific* hypotheses or
parts of the goal look through the [tc_opaque] connective, which is used to make parts of the goal look through the [tc_opaque] connective, which is used to make
...@@ -594,6 +628,6 @@ Instance elim_modal_tc_opaque {PROP : bi} φ p p' (P P' Q Q' : PROP) : ...@@ -594,6 +628,6 @@ Instance elim_modal_tc_opaque {PROP : bi} φ p p' (P P' Q Q' : PROP) :
ElimModal φ p p' P P' Q Q' ElimModal φ p p' (tc_opaque P) P' Q Q' := id. ElimModal φ p p' P P' Q Q' ElimModal φ p p' (tc_opaque P) P' Q Q' := id.
Instance into_inv_tc_opaque {PROP : bi} (P : PROP) N : Instance into_inv_tc_opaque {PROP : bi} (P : PROP) N :
IntoInv P N IntoInv (tc_opaque P) N := id. IntoInv P N IntoInv (tc_opaque P) N := id.
Instance elim_inv_tc_opaque {PROP : bi} φ (Pinv Pin Pout Q Q' : PROP) : Instance elim_inv_tc_opaque {PROP : sbi} φ Pinv Pin Pout Pclose Q Q' :
ElimInv φ Pinv Pin Pout Q Q' ElimInv (PROP:=PROP) φ Pinv Pin Pout Pclose Q Q'
ElimInv φ (tc_opaque Pinv) Pin Pout Q Q' := id. ElimInv φ (tc_opaque Pinv) Pin Pout Pclose Q Q' := id.
...@@ -746,6 +746,7 @@ Proof. ...@@ -746,6 +746,7 @@ Proof.
rewrite envs_lookup_sound // envs_split_sound //. rewrite envs_lookup_sound // envs_split_sound //.
rewrite (envs_app_singleton_sound Δ2) //; simpl. rewrite (envs_app_singleton_sound Δ2) //; simpl.
rewrite HP1 into_wand /= -(add_modal P1' P1 Q). cancel [P1']. rewrite HP1 into_wand /= -(add_modal P1' P1 Q). cancel [P1'].
apply wand_intro_l. by rewrite assoc !wand_elim_r. apply wand_intro_l. by rewrite assoc !wand_elim_r.
Qed. Qed.
...@@ -1075,22 +1076,6 @@ Proof. ...@@ -1075,22 +1076,6 @@ Proof.
rewrite HΔ. by eapply elim_modal. rewrite HΔ. by eapply elim_modal.
Qed. Qed.
(** * Invariants *)
Lemma tac_inv_elim Δ Δ' i j φ p P Pin Pout Q Q' :
envs_lookup_delete false i Δ = Some (p, P, Δ')
ElimInv φ P Pin Pout Q Q'
φ
( R, Δ'',
envs_app false (Esnoc Enil j (Pin - (Pout - Q') - R)%I) Δ' = Some Δ''
envs_entails Δ'' R)
envs_entails Δ Q.
Proof.
rewrite envs_entails_eq=> /envs_lookup_delete_Some [? ->] ?? /(_ Q) [Δ'' [? <-]].
rewrite (envs_lookup_sound' _ false) // envs_app_singleton_sound //; simpl.
apply wand_elim_r', wand_mono; last done. apply wand_intro_r, wand_intro_r.
rewrite intuitionistically_if_elim -assoc. auto.
Qed.
(** * Accumulate hypotheses *) (** * Accumulate hypotheses *)
Lemma tac_accu Δ P : Lemma tac_accu Δ P :
prop_of_env (env_spatial Δ) = P prop_of_env (env_spatial Δ) = P
...@@ -1339,6 +1324,22 @@ Implicit Types Γ : env PROP. ...@@ -1339,6 +1324,22 @@ Implicit Types Γ : env PROP.
Implicit Types Δ : envs PROP. Implicit Types Δ : envs PROP.
Implicit Types P Q : PROP. Implicit Types P Q : PROP.
(** * Invariants *)
Lemma tac_inv_elim Δ Δ' i j φ p Pinv Pin Pout (Pclose : option PROP) Q Q' :
envs_lookup_delete false i Δ = Some (p, Pinv, Δ')
ElimInv φ Pinv Pin Pout Pclose Q Q'
φ
( R, Δ'',
envs_app false (Esnoc Enil j (Pin - (Pout - maybe_wand Pclose Q') - R)%I) Δ' = Some Δ''
envs_entails Δ'' R)
envs_entails Δ Q.
Proof.
rewrite envs_entails_eq=> /envs_lookup_delete_Some [? ->] ?? /(_ Q) [Δ'' [? <-]].
rewrite (envs_lookup_sound' _ false) // envs_app_singleton_sound //; simpl.
apply wand_elim_r', wand_mono; last done. apply wand_intro_r, wand_intro_r.
rewrite intuitionistically_if_elim maybe_wand_sound -assoc wand_curry. auto.
Qed.
(** * Rewriting *) (** * Rewriting *)
Lemma tac_rewrite Δ i p Pxy d Q : Lemma tac_rewrite Δ i p Pxy d Q :
envs_lookup i Δ = Some (p, Pxy) envs_lookup i Δ = Some (p, Pxy)
......
...@@ -8,7 +8,7 @@ Set Default Proof Using "Type". ...@@ -8,7 +8,7 @@ Set Default Proof Using "Type".
Export ident. Export ident.
Declare Reduction env_cbv := cbv [ Declare Reduction env_cbv := cbv [
option_bind option_bind from_option (* TODO: Can we make these (and maybe_wand) reduce only if applied to a constructor? *)
beq ascii_beq string_beq positive_beq Pos.succ ident_beq beq ascii_beq string_beq positive_beq Pos.succ ident_beq
env_lookup env_lookup_delete env_delete env_app env_replace env_dom env_lookup env_lookup_delete env_delete env_app env_replace env_dom
env_intuitionistic env_spatial env_counter env_spatial_is_nil envs_dom env_intuitionistic env_spatial env_counter env_spatial_is_nil envs_dom
...@@ -1887,7 +1887,7 @@ Tactic Notation "iAssumptionInv" constr(N) := ...@@ -1887,7 +1887,7 @@ Tactic Notation "iAssumptionInv" constr(N) :=
(* The argument [select] is the namespace [N] or hypothesis name ["H"] of the (* The argument [select] is the namespace [N] or hypothesis name ["H"] of the
invariant. *) invariant. *)
Tactic Notation "iInvCore" constr(select) "with" constr(pats) "as" tactic(tac) := Tactic Notation "iInvCore" constr(select) "with" constr(pats) "as" tactic(tac) open_constr(Hclose) :=
iStartProof; iStartProof;
let pats := spec_pat.parse pats in