Commit 7c32c1ac authored by Joseph Tassarotti's avatar Joseph Tassarotti

Modify adequacy proof to not break the 'fancy update' abstraction. Modify fupd...

Modify adequacy proof to not break the 'fancy update' abstraction. Modify fupd plainly interface and add new derived results.
parent 1d34bda8
From iris.base_logic.lib Require Export own. From iris.base_logic.lib Require Export own.
From stdpp Require Export coPset. From stdpp Require Export coPset.
From iris.base_logic.lib Require Import wsat. From iris.base_logic.lib Require Import wsat.
From iris.algebra Require Import gmap auth agree gset coPset.
From iris.proofmode Require Import tactics. From iris.proofmode Require Import tactics.
Set Default Proof Using "Type". Set Default Proof Using "Type".
Export invG. Export invG.
...@@ -40,13 +41,50 @@ Proof. rewrite /BiBUpdFUpd uPred_fupd_eq. by iIntros (E P) ">? [$ $] !> !>". Qed ...@@ -40,13 +41,50 @@ Proof. rewrite /BiBUpdFUpd uPred_fupd_eq. by iIntros (E P) ">? [$ $] !> !>". Qed
Instance uPred_bi_fupd_plainly `{invG Σ} : BiFUpdPlainly (uPredSI (iResUR Σ)). Instance uPred_bi_fupd_plainly `{invG Σ} : BiFUpdPlainly (uPredSI (iResUR Σ)).
Proof. Proof.
split. split.
- iIntros (E1 E2 E2' P Q ? (E3&->&HE)%subseteq_disjoint_union_L) "HQP HQ". - rewrite uPred_fupd_eq /uPred_fupd_def. iIntros (E P Q ?) "HQP HQ [Hw HE]".
rewrite uPred_fupd_eq /uPred_fupd_def ownE_op //. iIntros "H". iAssert ( P)%I as "#>$".
iMod ("HQ" with "H") as ">(Hws & [HE1 HE3] & HQ)"; iModIntro.
iAssert ( P)%I as "#HP".
{ by iMod ("HQP" with "HQ [$]") as "(_ & _ & HP)". } { by iMod ("HQP" with "HQ [$]") as "(_ & _ & HP)". }
iMod "HP". iFrame. auto. by iFrame.
- rewrite uPred_fupd_eq /uPred_fupd_def. iIntros (E P ?) "HP [Hw HE]". - rewrite uPred_fupd_eq /uPred_fupd_def. iIntros (p E1 E2 P ?) "HP [Hw HE]".
iAssert ( P)%I with "[-]" as "#$"; last by iFrame. iAssert (?p P)%I with "[-]" as "#$"; last by iFrame.
iNext. by iMod ("HP" with "[$]") as "(_ & _ & HP)". iNext. by iMod ("HP" with "[$]") as "(_ & _ & HP)".
Qed. Qed.
\ No newline at end of file
Lemma fupd_plain_soundness `{invPreG Σ} E (P: iPropSI Σ) `{!Plain P}:
( `{Hinv: invG Σ}, (|={, E}=> P)%I) ( P)%I.
Proof.
iIntros (Hfupd). iMod wsat_alloc as (Hinv) "[Hw HE]".
iPoseProof (Hfupd Hinv) as "H".
rewrite uPred_fupd_eq /uPred_fupd_def.
iMod ("H" with "[$]") as "[Hw [HE >H']]"; iFrame.
Qed.
Lemma step_fupdN_soundness `{invPreG Σ} φ n :
( `{Hinv: invG Σ}, (|={, }=>^n |={, }=> φ : iProp Σ)%I)
φ.
Proof.
iIntros (Hiter).
eapply (soundness (M:=iResUR Σ) _ (S (S n))).
eapply (fupd_plain_soundness ); first by apply _.
intros Hinv. rewrite -/sbi_laterN.
iPoseProof (Hiter Hinv) as "H".
destruct n.
- rewrite //=. iPoseProof (fupd_plain_strong with "H") as "H'".
do 2 iMod "H'"; iModIntro; auto.
- iPoseProof (step_fupdN_mono _ _ _ _ (|={}=> ⌜φ⌝)%I with "H") as "H'".
{ iIntros "H". iMod (fupd_plain_strong with "H"); auto. }
rewrite -step_fupdN_S_fupd.
iMod (step_fupdN_plain with "H'") as "Hφ". iModIntro. iNext.
rewrite -later_laterN laterN_later.
iNext. by do 2 iMod "Hφ".
Qed.
Lemma step_fupdN_soundness' `{invPreG Σ} φ n :
( `{Hinv: invG Σ}, (|={, }=>^n φ : iProp Σ)%I)
φ.
Proof.
iIntros (Hiter). eapply (step_fupdN_soundness _ n).
iIntros (Hinv). iPoseProof (Hiter Hinv) as "Hiter".
iApply (step_fupdN_mono with "Hiter").
iIntros (?). iMod (fupd_intro_mask' _ ) as "_"; auto.
Qed.
...@@ -16,6 +16,20 @@ Module invG. ...@@ -16,6 +16,20 @@ Module invG.
End invG. End invG.
Import invG. Import invG.
Definition invΣ : gFunctors :=
#[GFunctor (authRF (gmapURF positive (agreeRF (laterCF idCF))));
GFunctor coPset_disjUR;
GFunctor (gset_disjUR positive)].
Class invPreG (Σ : gFunctors) : Set := WsatPreG {
inv_inPreG :> inG Σ (authR (gmapUR positive (agreeR (laterC (iPreProp Σ)))));
enabled_inPreG :> inG Σ coPset_disjR;
disabled_inPreG :> inG Σ (gset_disjR positive);
}.
Instance subG_invΣ {Σ} : subG invΣ Σ invPreG Σ.
Proof. solve_inG. Qed.
Definition invariant_unfold {Σ} (P : iProp Σ) : agree (later (iPreProp Σ)) := Definition invariant_unfold {Σ} (P : iProp Σ) : agree (later (iPreProp Σ)) :=
to_agree (Next (iProp_unfold P)). to_agree (Next (iProp_unfold P)).
Definition ownI `{invG Σ} (i : positive) (P : iProp Σ) : iProp Σ := Definition ownI `{invG Σ} (i : positive) (P : iProp Σ) : iProp Σ :=
...@@ -175,3 +189,15 @@ Proof. ...@@ -175,3 +189,15 @@ Proof.
iFrame "HI". by iRight. iFrame "HI". by iRight.
Qed. Qed.
End wsat. End wsat.
(* Allocation of an initial world *)
Lemma wsat_alloc `{invPreG Σ} : (|==> _ : invG Σ, wsat ownE )%I.
Proof.
iIntros.
iMod (own_alloc ( ( : gmap _ _))) as (γI) "HI"; first done.
iMod (own_alloc (CoPset )) as (γE) "HE"; first done.
iMod (own_alloc (GSet )) as (γD) "HD"; first done.
iModIntro; iExists (WsatG _ _ _ _ γI γE γD).
rewrite /wsat /ownE -lock; iFrame.
iExists . rewrite fmap_empty big_opM_empty. by iFrame.
Qed.
...@@ -957,9 +957,10 @@ Proof. move => [] /(_ i). rewrite /Plain monPred_at_plainly bi.forall_elim //. Q ...@@ -957,9 +957,10 @@ Proof. move => [] /(_ i). rewrite /Plain monPred_at_plainly bi.forall_elim //. Q
Global Instance monPred_bi_fupd_plainly `{BiFUpdPlainly PROP} : BiFUpdPlainly monPredSI. Global Instance monPred_bi_fupd_plainly `{BiFUpdPlainly PROP} : BiFUpdPlainly monPredSI.
Proof. Proof.
split; rewrite monPred_fupd_eq; unseal. split; rewrite monPred_fupd_eq; unseal.
- intros E1 E2 E2' P Q ? HE12. split=>/= i. do 3 f_equiv. - intros E P Q ?. split=>/= i. do 3 f_equiv.
apply fupd_plain'; [apply _|done]. apply fupd_plain_weak; apply _.
- intros E P ?. split=>/= i. apply later_fupd_plain, _. - intros p E1 E2 P ?. split=>/= i. specialize (later_fupd_plain p) => HFP.
destruct p; simpl; [ unseal | ]; apply HFP, _.
Qed. Qed.
Global Instance plainly_objective `{BiPlainly PROP} P : Objective ( P). Global Instance plainly_objective `{BiPlainly PROP} P : Objective ( P).
......
...@@ -87,6 +87,8 @@ Reserved Notation "|={ E }▷=> Q" ...@@ -87,6 +87,8 @@ Reserved Notation "|={ E }▷=> Q"
Reserved Notation "P ={ E }▷=∗ Q" Reserved Notation "P ={ E }▷=∗ Q"
(at level 99, E at level 50, Q at level 200, (at level 99, E at level 50, Q at level 200,
format "'[' P '/' ={ E }▷=∗ Q ']'"). format "'[' P '/' ={ E }▷=∗ Q ']'").
Reserved Notation "|={ E1 , E2 }▷=>^ n Q"
(at level 99, E1, E2 at level 50, n at level 9, Q at level 200).
(** Big Ops *) (** Big Ops *)
Reserved Notation "'[∗' 'list]' k ↦ x ∈ l , P" Reserved Notation "'[∗' 'list]' k ↦ x ∈ l , P"
......
...@@ -28,9 +28,11 @@ Notation "P ={ E }=∗ Q" := (P -∗ |={E}=> Q) : stdpp_scope. ...@@ -28,9 +28,11 @@ Notation "P ={ E }=∗ Q" := (P -∗ |={E}=> Q) : stdpp_scope.
Notation "|={ E1 , E2 , E3 }▷=> Q" := (|={E1,E2}=> ( |={E2,E3}=> Q))%I : bi_scope. Notation "|={ E1 , E2 , E3 }▷=> Q" := (|={E1,E2}=> ( |={E2,E3}=> Q))%I : bi_scope.
Notation "P ={ E1 , E2 , E3 }▷=∗ Q" := (P - |={ E1,E2,E3 }=> Q)%I : bi_scope. Notation "P ={ E1 , E2 , E3 }▷=∗ Q" := (P - |={ E1,E2,E3 }=> Q)%I : bi_scope.
Notation "|={ E1 , E2 }▷=> Q" := (|={E1,E2,E1}=> Q)%I : bi_scope. Notation "|={ E1 , E2 }▷=> Q" := (|={E1,E2,E1}=> Q)%I : bi_scope.
Notation "P ={ E1 , E2 }▷=∗ Q" := (P |={ E1 , E2, E1 }=> Q) (only parsing) : stdpp_scope.
Notation "P ={ E1 , E2 }▷=∗ Q" := (P - |={ E1 , E2, E1 }=> Q)%I : bi_scope. Notation "P ={ E1 , E2 }▷=∗ Q" := (P - |={ E1 , E2, E1 }=> Q)%I : bi_scope.
Notation "|={ E }▷=> Q" := (|={E,E}=> Q)%I : bi_scope. Notation "|={ E }▷=> Q" := (|={E,E}=> Q)%I : bi_scope.
Notation "P ={ E }▷=∗ Q" := (P ={E,E}= Q)%I : bi_scope. Notation "P ={ E }▷=∗ Q" := (P ={E,E}= Q)%I : bi_scope.
Notation "|={ E1 , E2 }▷=>^ n Q" := (Nat.iter n (λ P, |={E1,E2}=> P) Q)%I : bi_scope.
(** Bundled versions *) (** Bundled versions *)
(* Mixins allow us to create instances easily without having to use Program *) (* Mixins allow us to create instances easily without having to use Program *)
...@@ -76,11 +78,10 @@ Class BiBUpdPlainly (PROP : sbi) `{!BiBUpd PROP, !BiPlainly PROP} := ...@@ -76,11 +78,10 @@ Class BiBUpdPlainly (PROP : sbi) `{!BiBUpd PROP, !BiPlainly PROP} :=
Hint Mode BiBUpdPlainly ! - - : typeclass_instances. Hint Mode BiBUpdPlainly ! - - : typeclass_instances.
Class BiFUpdPlainly (PROP : sbi) `{!BiFUpd PROP, !BiPlainly PROP} := { Class BiFUpdPlainly (PROP : sbi) `{!BiFUpd PROP, !BiPlainly PROP} := {
fupd_plain' E1 E2 E2' (P Q : PROP) `{!Plain P} : fupd_plain_weak E (P Q : PROP) `{!Plain P} :
E1 E2 (Q ={E}= P) - Q ={E}= Q P;
(Q ={E1, E2'}= P) - (|={E1, E2}=> Q) ={E1}= (|={E1, E2}=> Q) P; later_fupd_plain p E1 E2 (P : PROP) `{!Plain P} :
later_fupd_plain E (P : PROP) `{!Plain P} : (?p |={E1, E2}=> P) ={E1}= ?p P;
( |={E}=> P) ={E}= P;
}. }.
Hint Mode BiBUpdFUpd ! - - : typeclass_instances. Hint Mode BiBUpdFUpd ! - - : typeclass_instances.
...@@ -271,6 +272,23 @@ Section fupd_derived. ...@@ -271,6 +272,23 @@ Section fupd_derived.
intros P1 P2 HP Q1 Q2 HQ. by rewrite HP HQ -fupd_sep. intros P1 P2 HP Q1 Q2 HQ. by rewrite HP HQ -fupd_sep.
Qed. Qed.
Lemma fupd_plain_strong `{BiPlainly PROP, !BiFUpdPlainly PROP} E1 E2 P `{!Plain P} :
(|={E1, E2}=> P) ={E1}= P.
Proof. by apply (later_fupd_plain false). Qed.
Lemma fupd_plain' `{BiPlainly PROP, !BiFUpdPlainly PROP} E1 E2 E2' P Q `{!Plain P} :
E1 E2
(Q ={E1, E2'}= P) - (|={E1, E2}=> Q) ={E1}= (|={E1, E2}=> Q) P.
Proof.
intros (E3&->&HE)%subseteq_disjoint_union_L.
apply wand_intro_l. rewrite fupd_frame_r.
rewrite fupd_plain_strong fupd_except_0 fupd_plain_weak wand_elim_r.
rewrite (fupd_mask_mono E1 (E1 E3)); last by set_solver+.
rewrite fupd_trans -(fupd_trans E1 (E1 E3) E1).
apply fupd_mono. rewrite -fupd_frame_r.
apply sep_mono; auto. apply fupd_intro_mask; set_solver+.
Qed.
Lemma fupd_plain `{BiPlainly PROP, !BiFUpdPlainly PROP} E1 E2 P Q `{!Plain P} : Lemma fupd_plain `{BiPlainly PROP, !BiFUpdPlainly PROP} E1 E2 P Q `{!Plain P} :
E1 E2 (Q - P) - (|={E1, E2}=> Q) ={E1}= (|={E1, E2}=> Q) P. E1 E2 (Q - P) - (|={E1, E2}=> Q) ={E1}= (|={E1, E2}=> Q) P.
Proof. Proof.
...@@ -309,4 +327,60 @@ Section fupd_derived. ...@@ -309,4 +327,60 @@ Section fupd_derived.
Lemma step_fupd_intro E1 E2 P : E2 E1 P - |={E1,E2}=> P. Lemma step_fupd_intro E1 E2 P : E2 E1 P - |={E1,E2}=> P.
Proof. intros. by rewrite -(step_fupd_mask_mono E2 _ _ E2) // -!fupd_intro. Qed. Proof. intros. by rewrite -(step_fupd_mask_mono E2 _ _ E2) // -!fupd_intro. Qed.
Lemma step_fupd_frame_l E1 E2 R Q :
(R |={E1, E2}=> Q) - |={E1, E2}=> (R Q).
Proof.
rewrite fupd_frame_l.
apply fupd_mono.
rewrite [P in P _ _](later_intro R) -later_sep fupd_frame_l.
by apply later_mono, fupd_mono.
Qed.
Lemma step_fupd_plain `{BiPlainly PROP, !BiFUpdPlainly PROP} E P `{!Plain P} :
(|={E, }=> P) ={E}= P.
Proof.
specialize (later_fupd_plain true E P) => //= ->.
rewrite fupd_trans fupd_plain_strong. apply fupd_mono, except_0_later.
Qed.
Lemma step_fupd_fupd E P:
(|={E, }=> P) (|={E, }=> |={E}=> P).
Proof.
apply (anti_symm ()).
- by rewrite -fupd_intro.
- by rewrite fupd_trans.
Qed.
Lemma step_fupdN_mono E1 E2 n P Q :
(P Q) (|={E1, E2}=>^n P) (|={E1, E2}=>^n Q).
Proof.
intros HPQ. induction n as [|n IH]=> //=. rewrite IH //.
Qed.
Lemma step_fupdN_S_fupd n E P:
(|={E, }=>^(S n) P) (|={E, }=>^(S n) |={E}=> P).
Proof.
apply (anti_symm ()); rewrite !Nat_iter_S_r; apply step_fupdN_mono;
rewrite -step_fupd_fupd //.
Qed.
Lemma step_fupdN_frame_l E1 E2 n R Q :
(R |={E1, E2}=>^n Q) - |={E1, E2}=>^n (R Q).
Proof.
induction n as [|n IH]; simpl; [done|].
rewrite step_fupd_frame_l IH //=.
Qed.
Lemma step_fupdN_plain `{BiPlainly PROP, !BiFUpdPlainly PROP} E n P `{!Plain P}:
(|={E, }=>^n P) ={E}= ^n P.
Proof.
induction n as [| n].
- rewrite -fupd_intro. apply except_0_intro.
- rewrite Nat_iter_S step_fupd_fupd IHn ?fupd_trans step_fupd_plain.
apply fupd_mono. destruct n; simpl.
* by rewrite except_0_idemp.
* by rewrite except_0_later.
Qed.
End fupd_derived. End fupd_derived.
This diff is collapsed.
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