Commit 351ca6f1 authored by Ralf Jung's avatar Ralf Jung

generalize proofmode accessors to work with all modalities, and not depend on SBI or FUpd any more

parent 42da9a0b
......@@ -94,7 +94,7 @@ Section proofs.
Global Instance into_acc_cinv E N γ P p :
IntoAcc (X:=unit) (cinv N γ P)
(N E) (cinv_own γ p) E (E∖↑N)
(N E) (cinv_own γ p) (fupd E (E∖↑N)) (fupd (E∖↑N) E)
(λ _, P cinv_own γ p)%I (λ _, P)%I (λ _, None)%I.
Proof.
rewrite /IntoAcc /accessor. iIntros (?) "#Hinv Hown".
......
......@@ -111,7 +111,8 @@ Global Instance into_inv_inv N P : IntoInv (inv N P) N.
Global Instance into_acc_inv E N P :
IntoAcc (X:=unit) (inv N P)
(N E) True E (E∖↑N) (λ _, P)%I (λ _, P)%I (λ _, None)%I.
(N E) True (fupd E (E∖↑N)) (fupd (E∖↑N) E)
(λ _, P)%I (λ _, P)%I (λ _, None)%I.
Proof.
rewrite /IntoAcc /accessor exist_unit.
iIntros (?) "#Hinv _". iApply inv_open; done.
......
......@@ -115,7 +115,7 @@ Section proofs.
Global Instance into_acc_na p F E N P :
IntoAcc (X:=unit) (na_inv p N P)
(N E N F) (na_own p F) E E
(N E N F) (na_own p F) (fupd E E) (fupd E E)
(λ _, P na_own p (F∖↑N))%I (λ _, P na_own p (F∖↑N))%I
(λ _, Some (na_own p F))%I.
Proof.
......
......@@ -407,7 +407,8 @@ Section proofmode_classes.
Global Instance elim_acc_wp {X} E1 E2 α β γ e s Φ :
Atomic (stuckness_to_atomicity s) e
ElimAcc (X:=X) E1 E2 α β γ (WP e @ s; E1 {{ Φ }})
ElimAcc (X:=X) (fupd E1 E2) (fupd E2 E1)
α β γ (WP e @ s; E1 {{ Φ }})
(λ x, WP e @ s; E2 {{ v, |={E2}=> β x coq_tactics.maybe_wand (γ x) (Φ v) }})%I.
Proof.
intros ?. rewrite /ElimAcc. setoid_rewrite coq_tactics.maybe_wand_sound.
......@@ -417,7 +418,8 @@ Section proofmode_classes.
Qed.
Global Instance elim_acc_wp_nonatomic {X} E α β γ e s Φ :
ElimAcc (X:=X) E E α β γ (WP e @ s; E {{ Φ }})
ElimAcc (X:=X) (fupd E E) (fupd E E)
α β γ (WP e @ s; E {{ Φ }})
(λ x, WP e @ s; E {{ v, |={E}=> β x coq_tactics.maybe_wand (γ x) (Φ v) }})%I.
Proof.
rewrite /ElimAcc. setoid_rewrite coq_tactics.maybe_wand_sound.
......
From stdpp Require Import nat_cancel.
From iris.bi Require Import bi tactics.
From iris.proofmode Require Import modality_instances classes.
From iris.proofmode Require Import modality_instances classes ltac_tactics.
Set Default Proof Using "Type".
Import bi.
......@@ -8,6 +8,33 @@ Section bi_instances.
Context {PROP : bi}.
Implicit Types P Q R : PROP.
(* AsEmpValid *)
Global Instance as_emp_valid_emp_valid {PROP : bi} (P : PROP) : AsEmpValid0 (bi_emp_valid P) P | 0.
Proof. by rewrite /AsEmpValid. Qed.
Global Instance as_emp_valid_entails {PROP : bi} (P Q : PROP) : AsEmpValid0 (P Q) (P - Q).
Proof. split. apply bi.entails_wand. apply bi.wand_entails. Qed.
Global Instance as_emp_valid_equiv {PROP : bi} (P Q : PROP) : AsEmpValid0 (P Q) (P - Q).
Proof. split. apply bi.equiv_wand_iff. apply bi.wand_iff_equiv. Qed.
Global Instance as_emp_valid_forall {A : Type} (φ : A Prop) (P : A PROP) :
( x, AsEmpValid (φ x) (P x)) AsEmpValid ( x, φ x) ( x, P x).
Proof.
rewrite /AsEmpValid=>H1. split=>H2.
- apply bi.forall_intro=>?. apply H1, H2.
- intros x. apply H1. revert H2. by rewrite (bi.forall_elim x).
Qed.
(* We add a useless hypothesis [BiEmbed PROP PROP'] in order to make
sure this instance is not used when there is no embedding between
PROP and PROP'.
The first [`{BiEmbed PROP PROP'}] is not considered as a premise by
Coq TC search mechanism because the rest of the hypothesis is dependent
on it. *)
Global Instance as_emp_valid_embed `{BiEmbed PROP PROP'} (φ : Prop) (P : PROP) :
BiEmbed PROP PROP'
AsEmpValid0 φ P AsEmpValid φ P.
Proof. rewrite /AsEmpValid0 /AsEmpValid=> _ ->. rewrite embed_emp_valid //. Qed.
(* FromAffinely *)
Global Instance from_affinely_affine P : Affine P FromAffinely P P.
Proof. intros. by rewrite /FromAffinely affinely_elim. Qed.
......@@ -813,35 +840,37 @@ Global Instance add_modal_embed_bupd_goal `{BiEmbedBUpd PROP PROP'}
AddModal P P' (|==> Q)%I AddModal P P' |==> Q.
Proof. by rewrite /AddModal !embed_bupd. Qed.
(* IntoEmbed *)
Global Instance into_embed_embed {PROP' : bi} `{BiEmbed PROP PROP'} P :
IntoEmbed P P.
Proof. by rewrite /IntoEmbed. Qed.
(* AsEmpValid *)
Global Instance as_emp_valid_emp_valid {PROP : bi} (P : PROP) : AsEmpValid0 (bi_emp_valid P) P | 0.
Proof. by rewrite /AsEmpValid. Qed.
Global Instance as_emp_valid_entails {PROP : bi} (P Q : PROP) : AsEmpValid0 (P Q) (P - Q).
Proof. split. apply bi.entails_wand. apply bi.wand_entails. Qed.
Global Instance as_emp_valid_equiv {PROP : bi} (P Q : PROP) : AsEmpValid0 (P Q) (P - Q).
Proof. split. apply bi.equiv_wand_iff. apply bi.wand_iff_equiv. Qed.
(* ElimInv *)
Global Instance elim_inv_acc_without_close {X : Type}
φ Pinv Pin
M1 M2 α β γ Q (Q' : X PROP) :
IntoAcc (X:=X) Pinv φ Pin M1 M2 α β γ
ElimAcc (X:=X) M1 M2 α β γ Q Q'
ElimInv φ Pinv Pin α None Q Q'.
Proof.
rewrite /ElimAcc /IntoAcc /ElimInv.
iIntros (Hacc Helim Hφ) "(Hinv & Hin & Hcont)".
iApply (Helim with "[Hcont]").
- iIntros (x) "Hα". iApply "Hcont". iSplitL; done.
- iApply (Hacc with "Hinv Hin"). done.
Qed.
Global Instance as_emp_valid_forall {A : Type} (φ : A Prop) (P : A PROP) :
( x, AsEmpValid (φ x) (P x)) AsEmpValid ( x, φ x) ( x, P x).
Global Instance elim_inv_acc_with_close {X : Type}
φ Pinv Pin
M1 M2 α β γ Q Q' :
IntoAcc Pinv φ Pin M1 M2 α β γ
( R, ElimModal True false false (M1 R) R Q Q')
ElimInv (X:=X) φ Pinv Pin α (Some (λ x, β x - M2 (default emp (γ x) id)))%I
Q (λ _, Q').
Proof.
rewrite /AsEmpValid=>H1. split=>H2.
- apply bi.forall_intro=>?. apply H1, H2.
- intros x. apply H1. revert H2. by rewrite (bi.forall_elim x).
rewrite /ElimAcc /IntoAcc /ElimInv.
iIntros (Hacc Helim Hφ) "(Hinv & Hin & Hcont)".
iMod (Hacc with "Hinv Hin") as (x) "[Hα Hclose]"; first done.
iApply "Hcont". simpl. iSplitL "Hα"; done.
Qed.
(* We add a useless hypothesis [BiEmbed PROP PROP'] in order to make
sure this instance is not used when there is no embedding between
PROP and PROP'.
The first [`{BiEmbed PROP PROP'}] is not considered as a premise by
Coq TC search mechanism because the rest of the hypothesis is dependent
on it. *)
Global Instance as_emp_valid_embed `{BiEmbed PROP PROP'} (φ : Prop) (P : PROP) :
BiEmbed PROP PROP'
AsEmpValid0 φ P AsEmpValid φ P.
Proof. rewrite /AsEmpValid0 /AsEmpValid=> _ ->. rewrite embed_emp_valid //. Qed.
(* IntoEmbed *)
Global Instance into_embed_embed {PROP' : bi} `{BiEmbed PROP PROP'} P :
IntoEmbed P P.
Proof. by rewrite /IntoEmbed. Qed.
End bi_instances.
......@@ -554,7 +554,7 @@ Proof. by rewrite /AddModal !embed_fupd. Qed.
(* ElimAcc *)
Global Instance elim_acc_vs `{BiFUpd PROP} {X} E1 E2 E α β γ Q :
(* FIXME: Why %I? ElimAcc sets the right scopes! *)
ElimAcc (X:=X) E1 E2 α β γ
ElimAcc (X:=X) (fupd E1 E2) (fupd E2 E1) α β γ
(|={E1,E}=> Q)
(λ x, |={E2}=> (β x (coq_tactics.maybe_wand (γ x) (|={E1,E}=> Q))))%I.
Proof.
......@@ -568,35 +568,6 @@ Qed.
(* TODO: We could have instances from "unfolded" accessors with or without
the first binder. *)
(* ElimInv *)
Global Instance elim_inv_acc_without_close `{BiFUpd PROP} {X : Type}
φ Pinv Pin
E1 E2 α β γ Q (Q' : X PROP) :
IntoAcc (X:=X) Pinv φ Pin E1 E2 α β γ
ElimAcc (X:=X) E1 E2 α β γ Q Q'
ElimInv φ Pinv Pin α None Q Q'.
Proof.
rewrite /ElimAcc /IntoAcc /ElimInv.
iIntros (Hacc Helim Hφ) "(Hinv & Hin & Hcont)".
iApply (Helim with "[Hcont]").
- iIntros (x) "Hα". iApply "Hcont". iSplitL; done.
- iApply (Hacc with "Hinv Hin"). done.
Qed.
Global Instance elim_inv_acc_with_close `{BiFUpd PROP} {X : Type}
φ Pinv Pin
E1 E2 α β γ Q Q' :
IntoAcc Pinv φ Pin E1 E2 α β γ
( R, ElimModal True false false (|={E1,E2}=> R) R Q Q')
ElimInv (X:=X) φ Pinv Pin α (Some (λ x, β x ={E2,E1}= default emp (γ x) id))%I
Q (λ _, Q').
Proof.
rewrite /ElimAcc /IntoAcc /ElimInv.
iIntros (Hacc Helim Hφ) "(Hinv & Hin & Hcont)".
iMod (Hacc with "Hinv Hin") as (x) "[Hα Hclose]"; first done.
iApply "Hcont". simpl. iSplitL "Hα"; done.
Qed.
(* IntoLater *)
Global Instance into_laterN_0 only_head P : IntoLaterN only_head 0 P P.
Proof. by rewrite /IntoLaterN /MaybeIntoLaterN. Qed.
......
......@@ -518,23 +518,23 @@ Hint Mode IntoInv + ! - : typeclass_instances.
usable and general form would use telescopes and also allow binders for the
closing view shift. [γ] is an [option] to make it easy for ElimAcc
instances to recognize the [emp] case and make it look nicer. *)
Definition accessor `{BiFUpd PROP} {X : Type} (E1 E2 : coPset)
Definition accessor {PROP : bi} {X : Type} (M1 M2 : PROP PROP)
(α β : X PROP) (γ : X option PROP) : PROP :=
(|={E1,E2}=> x, α x (β x ={E2,E1}= default emp (γ x) id))%I.
M1 ( x, α x (β x - M2 (default emp (γ x) id)))%I.
(* Typeclass for assertions around which accessors can be elliminated.
Inputs: [Q], [α], [β], [γ]
Inputs: [Q], [E1], [E2], [α], [β], [γ]
Outputs: [Q']
In/Out (can be an evar and will not usually be instantiated): [E1], [E2]
Elliminates an accessor [accessor E1 E2 α β γ] in goal [Q'], turning the goal
into [Q'] with a new assumption [α x]. *)
Class ElimAcc `{BiFUpd PROP} {X : Type} E1 E2 (α β : X PROP) (γ : X option PROP)
Class ElimAcc {PROP : bi} {X : Type} (M1 M2 : PROP PROP)
(α β : X PROP) (γ : X option PROP)
(Q : PROP) (Q' : X PROP) :=
elim_acc : (( x, α x - Q' x) - accessor E1 E2 α β γ - Q).
Arguments ElimAcc {_} {_} {_} _ _ _%I _%I _%I _%I : simpl never.
Arguments elim_acc {_} {_} {_} _ _ _%I _%I _%I _%I {_}.
Hint Mode ElimAcc + + ! - - ! ! ! ! - : typeclass_instances.
elim_acc : (( x, α x - Q' x) - accessor M1 M2 α β γ - Q).
Arguments ElimAcc {_} {_} _%I _%I _%I _%I _%I _%I : simpl never.
Arguments elim_acc {_} {_} _%I _%I _%I _%I _%I _%I {_}.
Hint Mode ElimAcc + ! ! ! ! ! ! ! - : typeclass_instances.
(* Turn [P] into an accessor.
Inputs:
......@@ -543,14 +543,15 @@ Hint Mode ElimAcc + + ! - - ! ! ! ! - : typeclass_instances.
- [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]
- [M1], [M2]: the two accessor modalities (they will typically still have
some evars though, e.g. for the masks)
*)
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.
Class IntoAcc {PROP : bi} {X : Type} (Pacc : PROP) (φ : Prop) (Pin : PROP)
(M1 M2 : PROP PROP) (α β : X PROP) (γ : X option PROP) :=
into_acc : φ Pacc - Pin - accessor M1 M2 α β γ.
Arguments IntoAcc {_} {_} _%I _ _%I _%I _%I _%I _%I _%I : simpl never.
Arguments into_acc {_} {_} _%I _ _%I _%I _%I _%I _%I _%I {_} : simpl never.
Hint Mode IntoAcc + - ! - - - - - - - : typeclass_instances.
(* The typeclass used for the [iInv] tactic.
Input: [Pinv]
......
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