Commit 925a9169 by Robbert Krebbers

Backwards compatibility layer for ownP.

parent b0039d65
 ... @@ -93,6 +93,7 @@ program_logic/ectx_language.v ... @@ -93,6 +93,7 @@ program_logic/ectx_language.v program_logic/ectxi_language.v program_logic/ectxi_language.v program_logic/ectx_lifting.v program_logic/ectx_lifting.v program_logic/gen_heap.v program_logic/gen_heap.v program_logic/ownp.v heap_lang/lang.v heap_lang/lang.v heap_lang/tactics.v heap_lang/tactics.v heap_lang/wp_tactics.v heap_lang/wp_tactics.v ... ...
 ... @@ -165,7 +165,7 @@ Proof. ... @@ -165,7 +165,7 @@ Proof. Qed. Qed. End adequacy. End adequacy. Theorem wp_adequacy Σ Λ `{invPreG Σ} (e : expr Λ) σ φ : Theorem wp_adequacy Σ Λ `{invPreG Σ} e σ φ : (∀ `{Hinv : invG Σ}, (∀ `{Hinv : invG Σ}, True ={⊤}=∗ ∃ stateI : state Λ → iProp Σ, True ={⊤}=∗ ∃ stateI : state Λ → iProp Σ, let _ : irisG Λ Σ := IrisG _ _ Hinv stateI in let _ : irisG Λ Σ := IrisG _ _ Hinv stateI in ... @@ -189,7 +189,7 @@ Proof. ... @@ -189,7 +189,7 @@ Proof. iFrame. by iApply big_sepL_nil. iFrame. by iApply big_sepL_nil. Qed. Qed. Theorem wp_invariance {Λ} `{invPreG Σ} e σ1 t2 σ2 φ Φ : Theorem wp_invariance Σ Λ `{invPreG Σ} e σ1 t2 σ2 φ Φ : (∀ `{Hinv : invG Σ}, (∀ `{Hinv : invG Σ}, True ={⊤}=∗ ∃ stateI : state Λ → iProp Σ, True ={⊤}=∗ ∃ stateI : state Λ → iProp Σ, let _ : irisG Λ Σ := IrisG _ _ Hinv stateI in let _ : irisG Λ Σ := IrisG _ _ Hinv stateI in ... ...
 From iris.program_logic Require Export weakestpre. From iris.program_logic Require Import lifting adequacy. From iris.program_logic Require ectx_language. From iris.algebra Require Import auth. From iris.proofmode Require Import tactics classes. Class ownPG' (Λstate : Type) (Σ : gFunctors) := OwnPG { ownP_invG : invG Σ; ownP_inG :> inG Σ (authR (optionUR (exclR (leibnizC Λstate)))); ownP_name : gname; }. Notation ownPG Λ Σ := (ownPG' (state Λ) Σ). Instance ownPG_irisG `{ownPG' Λstate Σ} : irisG' Λstate Σ := { iris_invG := ownP_invG; state_interp σ := own ownP_name (● (Excl' (σ:leibnizC Λstate))) }. Definition ownPΣ (Λstate : Type) : gFunctors := #[invΣ; GFunctor (constRF (authUR (optionUR (exclR (leibnizC Λstate)))))]. Class ownPPreG' (Λstate : Type) (Σ : gFunctors) : Set := IrisPreG { ownPPre_invG :> invPreG Σ; ownPPre_inG :> inG Σ (authR (optionUR (exclR (leibnizC Λstate)))) }. Notation ownPPreG Λ Σ := (ownPPreG' (state Λ) Σ). Instance subG_ownPΣ {Λstate Σ} : subG (ownPΣ Λstate) Σ → ownPPreG' Λstate Σ. Proof. intros [??%subG_inG]%subG_inv; constructor; apply _. Qed. (** Ownership *) Definition ownP `{ownPG' Λstate Σ} (σ : Λstate) : iProp Σ := own ownP_name (◯ (Excl' σ)). Typeclasses Opaque ownP. Instance: Params (@ownP) 3. (* Adequacy *) Theorem ownP_adequacy Σ `{ownPPreG Λ Σ} e σ φ : (∀ `{ownPG Λ Σ}, ownP σ ⊢ WP e {{ v, ⌜φ v⌝ }}) → adequate e σ φ. Proof. intros Hwp. apply (wp_adequacy Σ _). iIntros (?) "". iMod (own_alloc (● (Excl' (σ : leibnizC _)) ⋅ ◯ (Excl' σ))) as (γσ) "[Hσ Hσf]"; first done. iModIntro. iExists (λ σ, own γσ (● (Excl' (σ:leibnizC _)))). iFrame "Hσ". iApply (Hwp (OwnPG _ _ _ _ γσ)). by rewrite /ownP. Qed. Theorem ownP_invariance Σ `{ownPPreG Λ Σ} e σ1 t2 σ2 φ Φ : (∀ `{ownPG Λ Σ}, ownP σ1 ={⊤}=∗ WP e {{ Φ }} ∗ |={⊤,∅}=> ∃ σ', ownP σ' ∧ ⌜φ σ'⌝) → rtc step ([e], σ1) (t2, σ2) → φ σ2. Proof. intros Hwp Hsteps. eapply (wp_invariance Σ Λ e σ1 t2 σ2 _ Φ)=> //. iIntros (?) "". iMod (own_alloc (● (Excl' (σ1 : leibnizC _)) ⋅ ◯ (Excl' σ1))) as (γσ) "[Hσ Hσf]"; first done. iExists (λ σ, own γσ (● (Excl' (σ:leibnizC _)))). iFrame "Hσ". iMod (Hwp (OwnPG _ _ _ _ γσ) with "[Hσf]") as "[\$ H]"; first by rewrite /ownP. iIntros "!> Hσ". iMod "H" as (σ2') "[Hσf %]". rewrite /ownP. iDestruct (own_valid_2 with "Hσ Hσf") as %[->%Excl_included%leibniz_equiv _]%auth_valid_discrete_2; auto. Qed. (** Lifting *) Section lifting. Context `{ownPG Λ Σ}. Implicit Types e : expr Λ. Implicit Types Φ : val Λ → iProp Σ. Lemma ownP_twice σ1 σ2 : ownP σ1 ∗ ownP σ2 ⊢ False. Proof. rewrite /ownP -own_op own_valid. by iIntros (?). Qed. Global Instance ownP_timeless σ : TimelessP (@ownP (state Λ) Σ _ σ). Proof. rewrite /ownP; apply _. Qed. Lemma ownP_lift_step E Φ e1 : (|={E,∅}=> ∃ σ1, ⌜reducible e1 σ1⌝ ∗ ▷ ownP σ1 ∗ ▷ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 e2 σ2 efs⌝ -∗ ownP σ2 ={∅,E}=∗ WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) ⊢ WP e1 @ E {{ Φ }}. Proof. iIntros "H". destruct (to_val e1) as [v|] eqn:EQe1. - apply of_to_val in EQe1 as <-. iApply fupd_wp. iMod "H" as (σ1) "[Hred _]"; iDestruct "Hred" as %Hred%reducible_not_val. move: Hred; by rewrite to_of_val. - iApply wp_lift_step; [done|]; iIntros (σ1) "Hσ". iMod "H" as (σ1') "(% & >Hσf & H)". rewrite /ownP. iDestruct (own_valid_2 with "Hσ Hσf") as %[->%Excl_included%leibniz_equiv _]%auth_valid_discrete_2. iModIntro; iSplit; [done|]; iNext; iIntros (e2 σ2 efs Hstep). iMod (own_update_2 with "Hσ Hσf") as "[Hσ Hσf]". { by apply auth_update, option_local_update, (exclusive_local_update _ (Excl σ2)). } iFrame "Hσ". iApply ("H" with "* []"); eauto. Qed. Lemma ownP_lift_pure_step `{Inhabited (state Λ)} E Φ e1 : (∀ σ1, reducible e1 σ1) → (∀ σ1 e2 σ2 efs, prim_step e1 σ1 e2 σ2 efs → σ1 = σ2) → (▷ ∀ e2 efs σ, ⌜prim_step e1 σ e2 σ efs⌝ → WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) ⊢ WP e1 @ E {{ Φ }}. Proof. iIntros (Hsafe Hstep) "H". iApply wp_lift_step. { eapply reducible_not_val, (Hsafe inhabitant). } iIntros (σ1) "Hσ". iMod (fupd_intro_mask' E ∅) as "Hclose"; first set_solver. iModIntro. iSplit; [done|]; iNext; iIntros (e2 σ2 efs ?). destruct (Hstep σ1 e2 σ2 efs); auto; subst. iMod "Hclose"; iModIntro. iFrame "Hσ". iApply "H"; auto. Qed. (** Derived lifting lemmas. *) Lemma ownP_lift_atomic_step {E Φ} e1 σ1 : reducible e1 σ1 → (▷ ownP σ1 ∗ ▷ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 e2 σ2 efs⌝ -∗ ownP σ2 -∗ default False (to_val e2) Φ ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) ⊢ WP e1 @ E {{ Φ }}. Proof. iIntros (?) "[Hσ H]". iApply (ownP_lift_step E _ e1). iMod (fupd_intro_mask' E ∅) as "Hclose"; first set_solver. iModIntro. iExists σ1. iFrame "Hσ"; iSplit; eauto. iNext; iIntros (e2 σ2 efs) "% Hσ". iDestruct ("H" \$! e2 σ2 efs with "[] [Hσ]") as "[HΦ \$]"; [by eauto..|]. destruct (to_val e2) eqn:?; last by iExFalso. iMod "Hclose". iApply wp_value; auto using to_of_val. done. Qed. Lemma ownP_lift_atomic_det_step {E Φ e1} σ1 v2 σ2 efs : reducible e1 σ1 → (∀ e2' σ2' efs', prim_step e1 σ1 e2' σ2' efs' → σ2 = σ2' ∧ to_val e2' = Some v2 ∧ efs = efs') → ▷ ownP σ1 ∗ ▷ (ownP σ2 -∗ Φ v2 ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) ⊢ WP e1 @ E {{ Φ }}. Proof. iIntros (? Hdet) "[Hσ1 Hσ2]". iApply (ownP_lift_atomic_step _ σ1); try done. iFrame. iNext. iIntros (e2' σ2' efs') "% Hσ2'". edestruct Hdet as (->&Hval&->). done. rewrite Hval. by iApply "Hσ2". Qed. Lemma ownP_lift_pure_det_step `{Inhabited (state Λ)} {E Φ} e1 e2 efs : (∀ σ1, reducible e1 σ1) → (∀ σ1 e2' σ2 efs', prim_step e1 σ1 e2' σ2 efs' → σ1 = σ2 ∧ e2 = e2' ∧ efs = efs')→ ▷ (WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) ⊢ WP e1 @ E {{ Φ }}. Proof. iIntros (? Hpuredet) "?". iApply (ownP_lift_pure_step E); try done. by intros; eapply Hpuredet. iNext. by iIntros (e' efs' σ (_&->&->)%Hpuredet). Qed. End lifting. Section ectx_lifting. Import ectx_language. Context {expr val ectx state} {Λ : EctxLanguage expr val ectx state}. Context `{ownPG (ectx_lang expr) Σ} `{Inhabited state}. Implicit Types Φ : val → iProp Σ. Implicit Types e : expr. Hint Resolve head_prim_reducible head_reducible_prim_step. Lemma ownP_lift_head_step E Φ e1 : (|={E,∅}=> ∃ σ1, ⌜head_reducible e1 σ1⌝ ∗ ▷ ownP σ1 ∗ ▷ ∀ e2 σ2 efs, ⌜head_step e1 σ1 e2 σ2 efs⌝ -∗ ownP σ2 ={∅,E}=∗ WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) ⊢ WP e1 @ E {{ Φ }}. Proof. iIntros "H". iApply (ownP_lift_step E); try done. iMod "H" as (σ1) "(%&Hσ1&Hwp)". iModIntro. iExists σ1. iSplit; first by eauto. iFrame. iNext. iIntros (e2 σ2 efs) "% ?". iApply ("Hwp" with "* []"); by eauto. Qed. Lemma ownP_lift_pure_head_step E Φ e1 : (∀ σ1, head_reducible e1 σ1) → (∀ σ1 e2 σ2 efs, head_step e1 σ1 e2 σ2 efs → σ1 = σ2) → (▷ ∀ e2 efs σ, ⌜head_step e1 σ e2 σ efs⌝ → WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) ⊢ WP e1 @ E {{ Φ }}. Proof. iIntros (??) "H". iApply ownP_lift_pure_step; eauto. iNext. iIntros (????). iApply "H". eauto. Qed. Lemma ownP_lift_atomic_head_step {E Φ} e1 σ1 : head_reducible e1 σ1 → ▷ ownP σ1 ∗ ▷ (∀ e2 σ2 efs, ⌜head_step e1 σ1 e2 σ2 efs⌝ -∗ ownP σ2 -∗ default False (to_val e2) Φ ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) ⊢ WP e1 @ E {{ Φ }}. Proof. iIntros (?) "[? H]". iApply ownP_lift_atomic_step; eauto. iFrame. iNext. iIntros (???) "% ?". iApply ("H" with "* []"); eauto. Qed. Lemma ownP_lift_atomic_det_head_step {E Φ e1} σ1 v2 σ2 efs : head_reducible e1 σ1 → (∀ e2' σ2' efs', head_step e1 σ1 e2' σ2' efs' → σ2 = σ2' ∧ to_val e2' = Some v2 ∧ efs = efs') → ▷ ownP σ1 ∗ ▷ (ownP σ2 -∗ Φ v2 ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) ⊢ WP e1 @ E {{ Φ }}. Proof. eauto using ownP_lift_atomic_det_step. Qed. Lemma ownP_lift_atomic_det_head_step_no_fork {E e1} σ1 v2 σ2 : head_reducible e1 σ1 → (∀ e2' σ2' efs', head_step e1 σ1 e2' σ2' efs' → σ2 = σ2' ∧ to_val e2' = Some v2 ∧ [] = efs') → {{{ ▷ ownP σ1 }}} e1 @ E {{{ RET v2; ownP σ2 }}}. Proof. intros. rewrite -(ownP_lift_atomic_det_head_step σ1 v2 σ2 []); [|done..]. rewrite big_sepL_nil right_id. by apply uPred.wand_intro_r. Qed. Lemma ownP_lift_pure_det_head_step {E Φ} e1 e2 efs : (∀ σ1, head_reducible e1 σ1) → (∀ σ1 e2' σ2 efs', head_step e1 σ1 e2' σ2 efs' → σ1 = σ2 ∧ e2 = e2' ∧ efs = efs') → ▷ (WP e2 @ E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef {{ _, True }}) ⊢ WP e1 @ E {{ Φ }}. Proof. eauto using wp_lift_pure_det_step. Qed. Lemma ownP_lift_pure_det_head_step_no_fork {E Φ} e1 e2 : to_val e1 = None → (∀ σ1, head_reducible e1 σ1) → (∀ σ1 e2' σ2 efs', head_step e1 σ1 e2' σ2 efs' → σ1 = σ2 ∧ e2 = e2' ∧ [] = efs') → ▷ WP e2 @ E {{ Φ }} ⊢ WP e1 @ E {{ Φ }}. Proof. intros. rewrite -(wp_lift_pure_det_step e1 e2 []) ?big_sepL_nil ?right_id; eauto. Qed. End ectx_lifting.
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