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

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