Commit 6099c1a8 authored by Ralf Jung's avatar Ralf Jung
Browse files

better support for view shift with mismatching masks

parent d4c1face
...@@ -65,7 +65,7 @@ Lemma fupd_plain_soundness `{!invPreG Σ} E1 E2 (P: iProp Σ) `{!Plain P} : ...@@ -65,7 +65,7 @@ Lemma fupd_plain_soundness `{!invPreG Σ} E1 E2 (P: iProp Σ) `{!Plain P} :
Proof. Proof.
iIntros (Hfupd). apply later_soundness. iMod wsat_alloc as (Hinv) "[Hw HE]". iIntros (Hfupd). apply later_soundness. iMod wsat_alloc as (Hinv) "[Hw HE]".
iAssert (|={,E2}=> P)%I as "H". iAssert (|={,E2}=> P)%I as "H".
{ iMod fupd_intro_mask'; last iApply Hfupd. done. } { iMod Hfupd as "[_ $]". done. }
rewrite uPred_fupd_eq /uPred_fupd_def. rewrite uPred_fupd_eq /uPred_fupd_def.
iMod ("H" with "[$]") as "[Hw [HE >H']]"; iFrame. iMod ("H" with "[$]") as "[Hw [HE >H']]"; iFrame.
Qed. Qed.
......
...@@ -140,8 +140,8 @@ Section inv. ...@@ -140,8 +140,8 @@ Section inv.
rewrite inv_eq. iIntros (??) "#HinvP #HinvQ !>"; iIntros (E ?). rewrite inv_eq. iIntros (??) "#HinvP #HinvQ !>"; iIntros (E ?).
iMod ("HinvP" with "[%]") as "[$ HcloseP]"; first set_solver. iMod ("HinvP" with "[%]") as "[$ HcloseP]"; first set_solver.
iMod ("HinvQ" with "[%]") as "[$ HcloseQ]"; first set_solver. iMod ("HinvQ" with "[%]") as "[$ HcloseQ]"; first set_solver.
iMod (fupd_intro_mask' _ (E N)) as "Hclose"; first set_solver. iApply fupd_intro_adjust_mask; first set_solver.
iIntros "!> [HP HQ]". iIntros "Hclose [HP HQ]".
iMod "Hclose" as %_. iMod ("HcloseQ" with "HQ") as %_. by iApply "HcloseP". iMod "Hclose" as %_. iMod ("HcloseQ" with "HQ") as %_. by iApply "HcloseP".
Qed. Qed.
......
...@@ -55,9 +55,9 @@ Section definition. ...@@ -55,9 +55,9 @@ Section definition.
Eo1 Eo2 Eo1 Eo2
atomic_acc Eo1 Ei α P β Φ - atomic_acc Eo2 Ei α P β Φ. atomic_acc Eo1 Ei α P β Φ - atomic_acc Eo2 Ei α P β Φ.
Proof. Proof.
iIntros (HE) "Hstep". iIntros (HE) "Hstep". rewrite /atomic_acc.
iMod fupd_intro_mask' as "Hclose1"; first done. iMod "Hstep" as "[Hclose Hstep]".
iMod "Hstep" as (x) "[Hα Hclose2]". iIntros "!>". iExists x. iDestruct "Hstep" as (x) "[Hα Hclose2]". iIntros "!>". iExists x.
iFrame. iSplitWith "Hclose2". iFrame. iSplitWith "Hclose2".
- iIntros "Hα". iMod ("Hclose2" with "Hα") as "$". done. - iIntros "Hα". iMod ("Hclose2" with "Hα") as "$". done.
- iIntros (y) "Hβ". iMod ("Hclose2" with "Hβ") as "$". done. - iIntros (y) "Hβ". iMod ("Hclose2" with "Hβ") as "$". done.
...@@ -311,7 +311,7 @@ Section lemmas. ...@@ -311,7 +311,7 @@ Section lemmas.
atomic_acc Eo Ei α P β Φ). atomic_acc Eo Ei α P β Φ).
Proof. Proof.
iIntros (? x) "Hα Hclose". iIntros (? x) "Hα Hclose".
iMod fupd_intro_mask' as "Hclose'"; last iModIntro; first set_solver. iApply fupd_intro_adjust_mask; first done. iIntros "Hclose'".
iExists x. iFrame. iSplitWith "Hclose". iExists x. iFrame. iSplitWith "Hclose".
- iIntros "Hα". iMod "Hclose'" as "_". iApply "Hclose". done. - iIntros "Hα". iMod "Hclose'" as "_". iApply "Hclose". done.
- iIntros (y) "Hβ". iMod "Hclose'" as "_". iApply "Hclose". done. - iIntros (y) "Hβ". iMod "Hclose'" as "_". iApply "Hclose". done.
...@@ -330,7 +330,7 @@ Section lemmas. ...@@ -330,7 +330,7 @@ Section lemmas.
to happen only if one argument is a constructor. *) to happen only if one argument is a constructor. *)
iIntros (_) "Hinner >Hacc". iDestruct "Hacc" as (x') "[Hα' Hclose]". iIntros (_) "Hinner >Hacc". iDestruct "Hacc" as (x') "[Hα' Hclose]".
iMod ("Hinner" with "Hα'") as (x) "[Hα Hclose']". iMod ("Hinner" with "Hα'") as (x) "[Hα Hclose']".
iMod (fupd_intro_mask') as "Hclose''"; last iModIntro; first done. iApply fupd_intro_adjust_mask; first done. iIntros "Hclose''".
iExists x. iFrame. iSplitWith "Hclose'". iExists x. iFrame. iSplitWith "Hclose'".
- iIntros "Hα". iMod "Hclose''" as "_". - iIntros "Hα". iMod "Hclose''" as "_".
iMod ("Hclose'" with "Hα") as "[Hβ' HPas]". iMod ("Hclose'" with "Hα") as "[Hβ' HPas]".
......
...@@ -283,6 +283,17 @@ Section fupd_derived. ...@@ -283,6 +283,17 @@ Section fupd_derived.
(Q - (|={E2,E3}=> P)) (|={E1,E2}=> Q) - (|={E1,E3}=> P). (Q - (|={E2,E3}=> P)) (|={E1,E2}=> Q) - (|={E1,E3}=> P).
Proof. intros ->. rewrite fupd_trans //. Qed. Proof. intros ->. rewrite fupd_trans //. Qed.
Lemma fupd_intro_adjust_mask E1 E2 P:
E2 E1
((|={E2,E1}=> emp) - P) - |={E1,E2}=> P.
Proof.
intros HE.
(* Get an [emp] so we can apply [fupd_intro_mask']. *)
rewrite -[X in (X - _)](right_id emp%I).
rewrite {2}(fupd_intro_mask' E1 E2) //.
rewrite fupd_frame_l. apply fupd_mono. rewrite wand_elim_l. done.
Qed.
Lemma fupd_mask_frame_r E1 E2 Ef P : Lemma fupd_mask_frame_r E1 E2 Ef P :
E1 ## Ef (|={E1,E2}=> P) ={E1 Ef,E2 Ef}= P. E1 ## Ef (|={E1,E2}=> P) ={E1 Ef,E2 Ef}= P.
Proof. Proof.
......
...@@ -62,8 +62,7 @@ Lemma wp_lift_pure_head_stuck E Φ e : ...@@ -62,8 +62,7 @@ Lemma wp_lift_pure_head_stuck E Φ e :
WP e @ E ?{{ Φ }}. WP e @ E ?{{ Φ }}.
Proof using Hinh. Proof using Hinh.
iIntros (?? Hstuck). iApply wp_lift_head_stuck; [done|done|]. iIntros (?? Hstuck). iApply wp_lift_head_stuck; [done|done|].
iIntros (σ κs n) "_". iMod (fupd_intro_mask' E ) as "_"; first set_solver. iIntros (σ κs n) "_". iApply fupd_intro_adjust_mask; by auto with set_solver.
by auto.
Qed. Qed.
Lemma wp_lift_atomic_head_step_fupd {s E1 E2 Φ} e1 : Lemma wp_lift_atomic_head_step_fupd {s E1 E2 Φ} e1 :
......
...@@ -61,7 +61,7 @@ Proof. ...@@ -61,7 +61,7 @@ Proof.
iIntros (Hsafe Hstep) "H". iApply wp_lift_step. iIntros (Hsafe Hstep) "H". iApply wp_lift_step.
{ specialize (Hsafe inhabitant). destruct s; eauto using reducible_not_val. } { specialize (Hsafe inhabitant). destruct s; eauto using reducible_not_val. }
iIntros (σ1 κ κs n) "Hσ". iMod "H". iIntros (σ1 κ κs n) "Hσ". iMod "H".
iMod fupd_intro_mask' as "Hclose"; last iModIntro; first by set_solver. iSplit. iApply fupd_intro_adjust_mask; first set_solver. iIntros "Hclose". iSplit.
{ iPureIntro. destruct s; done. } { iPureIntro. destruct s; done. }
iNext. iIntros (e2 σ2 efs ?). iNext. iIntros (e2 σ2 efs ?).
destruct (Hstep κ σ1 e2 σ2 efs) as (-> & <- & ->); auto. destruct (Hstep κ σ1 e2 σ2 efs) as (-> & <- & ->); auto.
...@@ -76,7 +76,7 @@ Proof. ...@@ -76,7 +76,7 @@ Proof.
iIntros (Hstuck) "_". iApply wp_lift_stuck. iIntros (Hstuck) "_". iApply wp_lift_stuck.
- destruct(to_val e) as [v|] eqn:He; last done. - destruct(to_val e) as [v|] eqn:He; last done.
rewrite -He. by case: (Hstuck inhabitant). rewrite -He. by case: (Hstuck inhabitant).
- iIntros (σ κs n) "_". by iMod (fupd_intro_mask' E ) as "_"; first set_solver. - iIntros (σ κs n) "_". iApply fupd_intro_adjust_mask; auto with set_solver.
Qed. Qed.
(* Atomic steps don't need any mask-changing business here, one can (* Atomic steps don't need any mask-changing business here, one can
...@@ -94,8 +94,8 @@ Proof. ...@@ -94,8 +94,8 @@ Proof.
iIntros (?) "H". iIntros (?) "H".
iApply (wp_lift_step_fupd s E1 _ e1)=>//; iIntros (σ1 κ κs n) "Hσ1". iApply (wp_lift_step_fupd s E1 _ e1)=>//; iIntros (σ1 κ κs n) "Hσ1".
iMod ("H" $! σ1 with "Hσ1") as "[$ H]". iMod ("H" $! σ1 with "Hσ1") as "[$ H]".
iMod (fupd_intro_mask' E1 ) as "Hclose"; first set_solver. iApply fupd_intro_adjust_mask; first set_solver.
iIntros "!>" (e2 σ2 efs ?). iMod "Hclose" as "_". iIntros "Hclose" (e2 σ2 efs ?). iMod "Hclose" as "_".
iMod ("H" $! e2 σ2 efs with "[#]") as "H"; [done|]. iMod ("H" $! e2 σ2 efs with "[#]") as "H"; [done|].
iMod (fupd_intro_mask' E2 ) as "Hclose"; [set_solver|]. iIntros "!> !>". iMod (fupd_intro_mask' E2 ) as "Hclose"; [set_solver|]. iIntros "!> !>".
iMod "Hclose" as "_". iMod "H" as "($ & HQ & $)". iMod "Hclose" as "_". iMod "H" as "($ & HQ & $)".
......
...@@ -146,8 +146,8 @@ Section lifting. ...@@ -146,8 +146,8 @@ Section lifting.
iIntros (Hsafe Hstep) "H"; iApply wp_lift_step. iIntros (Hsafe Hstep) "H"; iApply wp_lift_step.
{ specialize (Hsafe inhabitant). destruct s; last done. { specialize (Hsafe inhabitant). destruct s; last done.
by eapply reducible_not_val. } by eapply reducible_not_val. }
iIntros (σ1 κ κs n) "Hσ". iMod (fupd_intro_mask' E ) as "Hclose"; first set_solver. iIntros (σ1 κ κs n) "Hσ". iApply fupd_intro_adjust_mask; first set_solver.
iModIntro; iSplit; [by destruct s|]; iNext; iIntros (e2 σ2 efs ?). iIntros "Hclose". iSplit; [by destruct s|]; iNext; iIntros (e2 σ2 efs ?).
destruct (Hstep σ1 κ e2 σ2 efs); auto; subst. destruct (Hstep σ1 κ e2 σ2 efs); auto; subst.
by iMod "Hclose"; iModIntro; iFrame; iApply "H". by iMod "Hclose"; iModIntro; iFrame; iApply "H".
Qed. Qed.
...@@ -162,8 +162,8 @@ Section lifting. ...@@ -162,8 +162,8 @@ Section lifting.
WP e1 @ s; E {{ Φ }}. WP e1 @ s; E {{ Φ }}.
Proof. Proof.
iIntros (?) "[Hσ H]"; iApply ownP_lift_step. iIntros (?) "[Hσ H]"; iApply ownP_lift_step.
iMod (fupd_intro_mask' E ) as "Hclose"; first set_solver. iApply fupd_intro_adjust_mask; first set_solver.
iModIntro; iExists σ1; iFrame; iSplit; first by destruct s. iIntros "Hclose". iExists σ1; iFrame; iSplit; first by destruct s.
iNext; iIntros (κ e2 σ2 efs ?) "Hσ". iNext; iIntros (κ e2 σ2 efs ?) "Hσ".
iDestruct ("H" $! κ e2 σ2 efs with "[] [Hσ]") as "[HΦ $]"; [by eauto..|]. iDestruct ("H" $! κ e2 σ2 efs with "[] [Hσ]") as "[HΦ $]"; [by eauto..|].
destruct (to_val e2) eqn:?; last by iExFalso. destruct (to_val e2) eqn:?; last by iExFalso.
......
...@@ -35,7 +35,7 @@ Proof. ...@@ -35,7 +35,7 @@ Proof.
iIntros (Hsafe Hstep) ">H". iApply twp_lift_step. iIntros (Hsafe Hstep) ">H". iApply twp_lift_step.
{ eapply reducible_not_val, reducible_no_obs_reducible, (Hsafe inhabitant). } { eapply reducible_not_val, reducible_no_obs_reducible, (Hsafe inhabitant). }
iIntros (σ1 κs n) "Hσ". iIntros (σ1 κs n) "Hσ".
iMod fupd_intro_mask' as "Hclose"; last iModIntro; first by set_solver. iSplit. iApply fupd_intro_adjust_mask; first by set_solver. iIntros "Hclose". iSplit.
{ iPureIntro. destruct s; auto. } { iPureIntro. destruct s; auto. }
iIntros (κ e2 σ2 efs ?). destruct (Hstep σ1 κ e2 σ2 efs) as (->&<-&->); auto. iIntros (κ e2 σ2 efs ?). destruct (Hstep σ1 κ e2 σ2 efs) as (->&<-&->); auto.
iMod "Hclose" as "_". iModIntro. iMod "Hclose" as "_". iModIntro.
...@@ -58,8 +58,8 @@ Proof. ...@@ -58,8 +58,8 @@ Proof.
iIntros (?) "H". iIntros (?) "H".
iApply (twp_lift_step _ E _ e1)=>//; iIntros (σ1 κs n) "Hσ1". iApply (twp_lift_step _ E _ e1)=>//; iIntros (σ1 κs n) "Hσ1".
iMod ("H" $! σ1 with "Hσ1") as "[$ H]". iMod ("H" $! σ1 with "Hσ1") as "[$ H]".
iMod (fupd_intro_mask' E ) as "Hclose"; first set_solver. iApply fupd_intro_adjust_mask; first set_solver.
iIntros "!>" (κ e2 σ2 efs) "%". iMod "Hclose" as "_". iIntros "Hclose" (κ e2 σ2 efs) "%". iMod "Hclose" as "_".
iMod ("H" $! κ e2 σ2 efs with "[#]") as "($ & $ & HΦ & $)"; first by eauto. iMod ("H" $! κ e2 σ2 efs with "[#]") as "($ & $ & HΦ & $)"; first by eauto.
destruct (to_val e2) eqn:?; last by iExFalso. destruct (to_val e2) eqn:?; last by iExFalso.
iApply twp_value; last done. by apply of_to_val. iApply twp_value; last done. by apply of_to_val.
......
...@@ -115,8 +115,8 @@ Proof. ...@@ -115,8 +115,8 @@ Proof.
iIntros "!>" (e E1 Φ) "IH"; iIntros (E2 Ψ HE) "HΦ". iIntros "!>" (e E1 Φ) "IH"; iIntros (E2 Ψ HE) "HΦ".
rewrite !twp_unfold /twp_pre. destruct (to_val e) as [v|] eqn:?. rewrite !twp_unfold /twp_pre. destruct (to_val e) as [v|] eqn:?.
{ iApply ("HΦ" with "[> -]"). by iApply (fupd_mask_mono E1 _). } { iApply ("HΦ" with "[> -]"). by iApply (fupd_mask_mono E1 _). }
iIntros (σ1 κs n) "Hσ". iMod (fupd_intro_mask' E2 E1) as "Hclose"; first done. iIntros (σ1 κs n) "Hσ".
iMod ("IH" with "[$]") as "[% IH]". iMod ("IH" with "[$]") as "[Hclose [% IH]]".
iModIntro; iSplit; [by destruct s1, s2|]. iIntros (κ e2 σ2 efs Hstep). iModIntro; iSplit; [by destruct s1, s2|]. iIntros (κ e2 σ2 efs Hstep).
iMod ("IH" with "[//]") as (?) "(Hσ & IH & IHefs)"; auto. iMod ("IH" with "[//]") as (?) "(Hσ & IH & IHefs)"; auto.
iMod "Hclose" as "_"; iModIntro. iMod "Hclose" as "_"; iModIntro.
......
...@@ -101,8 +101,8 @@ Proof. ...@@ -101,8 +101,8 @@ Proof.
rewrite !wp_unfold /wp_pre. rewrite !wp_unfold /wp_pre.
destruct (to_val e) as [v|] eqn:?. destruct (to_val e) as [v|] eqn:?.
{ iApply ("HΦ" with "[> -]"). by iApply (fupd_mask_mono E1 _). } { iApply ("HΦ" with "[> -]"). by iApply (fupd_mask_mono E1 _). }
iIntros (σ1 κ κs n) "Hσ". iMod (fupd_intro_mask' E2 E1) as "Hclose"; first done. iIntros (σ1 κ κs n) "Hσ".
iMod ("H" with "[$]") as "[% H]". iMod ("H" with "[$]") as "[Hclose [% H]]".
iModIntro. iSplit; [by destruct s1, s2|]. iIntros (e2 σ2 efs Hstep). iModIntro. iSplit; [by destruct s1, s2|]. iIntros (e2 σ2 efs Hstep).
iMod ("H" with "[//]") as "H". iIntros "!> !>". iMod ("H" with "[//]") as "H". iIntros "!> !>".
iMod "H" as "(Hσ & H & Hefs)". iMod "H" as "(Hσ & H & Hefs)".
......
...@@ -178,4 +178,16 @@ Proof. ...@@ -178,4 +178,16 @@ Proof.
iMod ("Hinner" with "Hα") as "[Hβ Hfin]". iMod ("Hinner" with "Hα") as "[Hβ Hfin]".
iMod ("Hclose" with "Hβ") as "Hγ". by iApply "Hfin". iMod ("Hclose" with "Hβ") as "Hγ". by iApply "Hfin".
Qed. Qed.
Global Instance elim_modal_fupd_fupd_adjust_mask `{!BiFUpd PROP} p E1 E1' E2 E2' P Q :
ElimModal (E1' E1) p false
(|={E1',E2'}=> P) ((|={E1',E1}=> emp) P)
(|={E1,E2}=> Q) (|={E2',E2}=> Q) | 20.
Proof.
rewrite /ElimModal /= intuitionistically_if_elim.
iIntros (HE) "[HP Hcont]".
iMod fupd_intro_mask' as "Hclose"; first exact HE.
iMod "HP" as "HP". iApply "Hcont". iSplitR "HP"; done.
Qed.
End class_instances_updates. End class_instances_updates.
Supports Markdown
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