Commit 0b7b5ad0 authored by Marianna Rapoport's avatar Marianna Rapoport Committed by Ralf Jung
Browse files

Finalizing general (not prophecy specific) support for observations

- Removing head of list of observations after each reduction step in definition of wp
- Adding support for observations to state_interp and world
- Applying Ralf's suggestions to previous commit (e.g. replacing /\ and -> with unicode characters)
parent 936eeb48
...@@ -76,7 +76,7 @@ theories/program_logic/language.v ...@@ -76,7 +76,7 @@ theories/program_logic/language.v
theories/program_logic/ectx_language.v theories/program_logic/ectx_language.v
theories/program_logic/ectxi_language.v theories/program_logic/ectxi_language.v
theories/program_logic/ectx_lifting.v theories/program_logic/ectx_lifting.v
theories/program_logic/ownp.v #theories/program_logic/ownp.v
theories/program_logic/total_lifting.v theories/program_logic/total_lifting.v
theories/program_logic/total_ectx_lifting.v theories/program_logic/total_ectx_lifting.v
theories/program_logic/atomic.v theories/program_logic/atomic.v
......
...@@ -17,8 +17,8 @@ Definition heap_adequacy Σ `{heapPreG Σ} s e σ φ : ...@@ -17,8 +17,8 @@ Definition heap_adequacy Σ `{heapPreG Σ} s e σ φ :
( `{heapG Σ}, WP e @ s; {{ v, ⌜φ v }}%I) ( `{heapG Σ}, WP e @ s; {{ v, ⌜φ v }}%I)
adequate s e σ (λ v _, φ v). adequate s e σ (λ v _, φ v).
Proof. Proof.
intros Hwp; eapply (wp_adequacy _ _); iIntros (?) "". intros Hwp; eapply (wp_adequacy _ _); iIntros (??) "".
iMod (gen_heap_init σ) as (?) "Hh". iMod (gen_heap_init σ) as (?) "Hh".
iModIntro. iExists gen_heap_ctx. iFrame "Hh". iModIntro. iExists (fun σ _ => gen_heap_ctx σ). iFrame "Hh".
iApply (Hwp (HeapG _ _ _)). iApply (Hwp (HeapG _ _ _)).
Qed. Qed.
...@@ -108,7 +108,7 @@ Inductive val := ...@@ -108,7 +108,7 @@ Inductive val :=
Bind Scope val_scope with val. Bind Scope val_scope with val.
Inductive observation := prophecy_observation_todo. Definition observation := Empty val.
Fixpoint of_val (v : val) : expr := Fixpoint of_val (v : val) : expr :=
match v with match v with
......
...@@ -14,7 +14,7 @@ Class heapG Σ := HeapG { ...@@ -14,7 +14,7 @@ Class heapG Σ := HeapG {
Instance heapG_irisG `{heapG Σ} : irisG heap_lang Σ := { Instance heapG_irisG `{heapG Σ} : irisG heap_lang Σ := {
iris_invG := heapG_invG; iris_invG := heapG_invG;
state_interp := gen_heap_ctx state_interp σ κs := gen_heap_ctx σ
}. }.
(** Override the notations so that scopes and coercions work out *) (** Override the notations so that scopes and coercions work out *)
...@@ -112,6 +112,7 @@ Proof. ...@@ -112,6 +112,7 @@ Proof.
iApply wp_lift_pure_det_head_step; [eauto|intros; inv_head_step; eauto|]. iApply wp_lift_pure_det_head_step; [eauto|intros; inv_head_step; eauto|].
iModIntro; iNext; iIntros "!> /= {$He}". by iApply wp_value. iModIntro; iNext; iIntros "!> /= {$He}". by iApply wp_value.
Qed. Qed.
Lemma twp_fork s E e Φ : Lemma twp_fork s E e Φ :
WP e @ s; [{ _, True }] - Φ (LitV LitUnit) - WP Fork e @ s; E [{ Φ }]. WP e @ s; [{ _, True }] - Φ (LitV LitUnit) - WP Fork e @ s; E [{ Φ }].
Proof. Proof.
...@@ -126,8 +127,8 @@ Lemma wp_alloc s E e v : ...@@ -126,8 +127,8 @@ Lemma wp_alloc s E e v :
{{{ True }}} Alloc e @ s; E {{{ l, RET LitV (LitLoc l); l v }}}. {{{ True }}} Alloc e @ s; E {{{ l, RET LitV (LitLoc l); l v }}}.
Proof. Proof.
iIntros (<- Φ) "_ HΦ". iApply wp_lift_atomic_head_step_no_fork; auto. iIntros (<- Φ) "_ HΦ". iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>"; iSplit; first by eauto. iIntros (σ1 κs) "Hσ !>"; iSplit; first by eauto.
iNext; iIntros (κ v2 σ2 efs Hstep); inv_head_step. iNext; iIntros (κ κs' v2 σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_alloc with "Hσ") as "[Hσ Hl]"; first done. iMod (@gen_heap_alloc with "Hσ") as "[Hσ Hl]"; first done.
iModIntro; iSplit=> //. iFrame. by iApply "HΦ". iModIntro; iSplit=> //. iFrame. by iApply "HΦ".
Qed. Qed.
...@@ -136,8 +137,8 @@ Lemma twp_alloc s E e v : ...@@ -136,8 +137,8 @@ Lemma twp_alloc s E e v :
[[{ True }]] Alloc e @ s; E [[{ l, RET LitV (LitLoc l); l v }]]. [[{ True }]] Alloc e @ s; E [[{ l, RET LitV (LitLoc l); l v }]].
Proof. Proof.
iIntros (<- Φ) "_ HΦ". iApply twp_lift_atomic_head_step_no_fork; auto. iIntros (<- Φ) "_ HΦ". iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>"; iSplit; first by eauto. iIntros (σ1 κs) "Hσ !>"; iSplit; first by eauto.
iIntros (κ v2 σ2 efs Hstep); inv_head_step. iIntros (κ κs' v2 σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_alloc with "Hσ") as "[Hσ Hl]"; first done. iMod (@gen_heap_alloc with "Hσ") as "[Hσ Hl]"; first done.
iModIntro; iSplit=> //. iFrame. by iApply "HΦ". iModIntro; iSplit=> //. iFrame. by iApply "HΦ".
Qed. Qed.
...@@ -146,18 +147,18 @@ Lemma wp_load s E l q v : ...@@ -146,18 +147,18 @@ Lemma wp_load s E l q v :
{{{ l {q} v }}} Load (Lit (LitLoc l)) @ s; E {{{ RET v; l {q} v }}}. {{{ l {q} v }}} Load (Lit (LitLoc l)) @ s; E {{{ RET v; l {q} v }}}.
Proof. Proof.
iIntros (Φ) ">Hl HΦ". iApply wp_lift_atomic_head_step_no_fork; auto. iIntros (Φ) ">Hl HΦ". iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?. iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iSplit; first by eauto.
iNext; iIntros (κ v2 σ2 efs Hstep); inv_head_step. iNext; iIntros (κ κs' v2 σ2 efs [Hstep ->]); inv_head_step.
iModIntro; iSplit=> //. iFrame. by iApply "HΦ". iModIntro; iSplit=> //. iFrame. by iApply "HΦ".
Qed. Qed.
Lemma twp_load s E l q v : Lemma twp_load s E l q v :
[[{ l {q} v }]] Load (Lit (LitLoc l)) @ s; E [[{ RET v; l {q} v }]]. [[{ l {q} v }]] Load (Lit (LitLoc l)) @ s; E [[{ RET v; l {q} v }]].
Proof. Proof.
iIntros (Φ) "Hl HΦ". iApply twp_lift_atomic_head_step_no_fork; auto. iIntros (Φ) "Hl HΦ". iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?. iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iSplit; first by eauto.
iIntros (κ v2 σ2 efs Hstep); inv_head_step. iIntros (κ κs' v2 σ2 efs [Hstep ->]); inv_head_step.
iModIntro; iSplit=> //. iFrame. by iApply "HΦ". iModIntro; iSplit=> //. iFrame. by iApply "HΦ".
Qed. Qed.
...@@ -167,8 +168,8 @@ Lemma wp_store s E l v' e v : ...@@ -167,8 +168,8 @@ Lemma wp_store s E l v' e v :
Proof. Proof.
iIntros (<- Φ) ">Hl HΦ". iIntros (<- Φ) ">Hl HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto. iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?. iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto 6. iNext; iIntros (κ v2 σ2 efs Hstep); inv_head_step. iSplit; first by eauto 6. iNext; iIntros (κ κs' v2 σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]". iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. by iApply "HΦ". iModIntro. iSplit=>//. by iApply "HΦ".
Qed. Qed.
...@@ -178,8 +179,8 @@ Lemma twp_store s E l v' e v : ...@@ -178,8 +179,8 @@ Lemma twp_store s E l v' e v :
Proof. Proof.
iIntros (<- Φ) "Hl HΦ". iIntros (<- Φ) "Hl HΦ".
iApply twp_lift_atomic_head_step_no_fork; auto. iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?. iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto 6. iIntros (κ v2 σ2 efs Hstep); inv_head_step. iSplit; first by eauto 6. iIntros (κ κs' v2 σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]". iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. by iApply "HΦ". iModIntro. iSplit=>//. by iApply "HΦ".
Qed. Qed.
...@@ -191,8 +192,8 @@ Lemma wp_cas_fail s E l q v' e1 v1 e2 : ...@@ -191,8 +192,8 @@ Lemma wp_cas_fail s E l q v' e1 v1 e2 :
Proof. Proof.
iIntros (<- [v2 <-] ?? Φ) ">Hl HΦ". iIntros (<- [v2 <-] ?? Φ) ">Hl HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto. iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?. iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (κ v2' σ2 efs Hstep); inv_head_step. iSplit; first by eauto. iNext; iIntros (κ κs' v2' σ2 efs [Hstep ->]); inv_head_step.
iModIntro; iSplit=> //. iFrame. by iApply "HΦ". iModIntro; iSplit=> //. iFrame. by iApply "HΦ".
Qed. Qed.
Lemma twp_cas_fail s E l q v' e1 v1 e2 : Lemma twp_cas_fail s E l q v' e1 v1 e2 :
...@@ -202,8 +203,8 @@ Lemma twp_cas_fail s E l q v' e1 v1 e2 : ...@@ -202,8 +203,8 @@ Lemma twp_cas_fail s E l q v' e1 v1 e2 :
Proof. Proof.
iIntros (<- [v2 <-] ?? Φ) "Hl HΦ". iIntros (<- [v2 <-] ?? Φ) "Hl HΦ".
iApply twp_lift_atomic_head_step_no_fork; auto. iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?. iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (κ v2' σ2 efs Hstep); inv_head_step. iSplit; first by eauto. iIntros (κ κs' v2' σ2 efs [Hstep ->]); inv_head_step.
iModIntro; iSplit=> //. iFrame. by iApply "HΦ". iModIntro; iSplit=> //. iFrame. by iApply "HΦ".
Qed. Qed.
...@@ -214,8 +215,8 @@ Lemma wp_cas_suc s E l e1 v1 e2 v2 : ...@@ -214,8 +215,8 @@ Lemma wp_cas_suc s E l e1 v1 e2 v2 :
Proof. Proof.
iIntros (<- <- ? Φ) ">Hl HΦ". iIntros (<- <- ? Φ) ">Hl HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto. iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?. iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (κ v2' σ2 efs Hstep); inv_head_step. iSplit; first by eauto. iNext; iIntros (κ κs' v2' σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]". iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. by iApply "HΦ". iModIntro. iSplit=>//. by iApply "HΦ".
Qed. Qed.
...@@ -226,8 +227,8 @@ Lemma twp_cas_suc s E l e1 v1 e2 v2 : ...@@ -226,8 +227,8 @@ Lemma twp_cas_suc s E l e1 v1 e2 v2 :
Proof. Proof.
iIntros (<- <- ? Φ) "Hl HΦ". iIntros (<- <- ? Φ) "Hl HΦ".
iApply twp_lift_atomic_head_step_no_fork; auto. iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?. iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (κ v2' σ2 efs Hstep); inv_head_step. iSplit; first by eauto. iIntros (κ κs' v2' σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]". iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. by iApply "HΦ". iModIntro. iSplit=>//. by iApply "HΦ".
Qed. Qed.
...@@ -239,8 +240,8 @@ Lemma wp_faa s E l i1 e2 i2 : ...@@ -239,8 +240,8 @@ Lemma wp_faa s E l i1 e2 i2 :
Proof. Proof.
iIntros (<- Φ) ">Hl HΦ". iIntros (<- Φ) ">Hl HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto. iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?. iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (κ v2' σ2 efs Hstep); inv_head_step. iSplit; first by eauto. iNext; iIntros (κ κs' v2' σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]". iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. by iApply "HΦ". iModIntro. iSplit=>//. by iApply "HΦ".
Qed. Qed.
...@@ -251,8 +252,8 @@ Lemma twp_faa s E l i1 e2 i2 : ...@@ -251,8 +252,8 @@ Lemma twp_faa s E l i1 e2 i2 :
Proof. Proof.
iIntros (<- Φ) "Hl HΦ". iIntros (<- Φ) "Hl HΦ".
iApply twp_lift_atomic_head_step_no_fork; auto. iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?. iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (κ v2' σ2 efs Hstep); inv_head_step. iSplit; first by eauto. iIntros (κ κs' v2' σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]". iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. by iApply "HΦ". iModIntro. iSplit=>//. by iApply "HΦ".
Qed. Qed.
......
...@@ -40,6 +40,7 @@ Proof. ...@@ -40,6 +40,7 @@ Proof.
rewrite envs_entails_eq=> ??? HΔ'. rewrite into_laterN_env_sound /=. rewrite envs_entails_eq=> ??? HΔ'. rewrite into_laterN_env_sound /=.
rewrite HΔ' -lifting.wp_pure_step_later //. rewrite HΔ' -lifting.wp_pure_step_later //.
Qed. Qed.
Lemma tac_twp_pure `{heapG Σ} Δ s E e1 e2 φ Φ : Lemma tac_twp_pure `{heapG Σ} Δ s E e1 e2 φ Φ :
PureExec φ e1 e2 PureExec φ e1 e2
φ φ
......
...@@ -4,12 +4,15 @@ From iris.heap_lang Require Import proofmode notation. ...@@ -4,12 +4,15 @@ From iris.heap_lang Require Import proofmode notation.
From iris.proofmode Require Import tactics. From iris.proofmode Require Import tactics.
Set Default Proof Using "Type". Set Default Proof Using "Type".
(* TODO (MR) re-introduce lemma after we prove twp_total *)
(*
Definition heap_total Σ `{heapPreG Σ} s e σ φ : Definition heap_total Σ `{heapPreG Σ} s e σ φ :
(∀ `{heapG Σ}, WP e @ s; ⊤ [{ v, ⌜φ v⌝ }]%I) → (∀ `{heapG Σ}, WP e @ s; ⊤ [{ v, ⌜φ v⌝ }]%I) →
sn erased_step ([e], σ). sn erased_step ([e], σ).
Proof. Proof.
intros Hwp; eapply (twp_total _ _); iIntros (?) "". intros Hwp; eapply (twp_total _ _) with (κs := []); iIntros (?) "".
iMod (gen_heap_init σ) as (?) "Hh". iMod (gen_heap_init σ) as (?) "Hh".
iModIntro. iExists gen_heap_ctx; iFrame. iModIntro. iExists (fun σ _ => gen_heap_ctx σ); iFrame.
iApply (Hwp (HeapG _ _ _)). iApply (Hwp (HeapG _ _ _)).
Qed. Qed.
*)
...@@ -66,50 +66,50 @@ Implicit Types P Q : iProp Σ. ...@@ -66,50 +66,50 @@ Implicit Types P Q : iProp Σ.
Implicit Types Φ : val Λ iProp Σ. Implicit Types Φ : val Λ iProp Σ.
Implicit Types Φs : list (val Λ iProp Σ). Implicit Types Φs : list (val Λ iProp Σ).
Notation world' E σ := (wsat ownE E state_interp σ)%I (only parsing). Notation world' E σ κs := (wsat ownE E state_interp σ κs)%I (only parsing).
Notation world σ := (world' σ) (only parsing). Notation world σ κs := (world' σ κs) (only parsing).
Notation wptp s t := ([ list] ef t, WP ef @ s; {{ _, True }})%I. Notation wptp s t := ([ list] ef t, WP ef @ s; {{ _, True }})%I.
Lemma wp_step s E e1 σ1 κ e2 σ2 efs Φ : Lemma wp_step s E e1 σ1 κ κs e2 σ2 efs Φ :
prim_step e1 σ1 κ e2 σ2 efs prim_step e1 σ1 κ e2 σ2 efs
world' E σ1 WP e1 @ s; E {{ Φ }} world' E σ1 (cons_obs κ κs) WP e1 @ s; E {{ Φ }}
== |==> (world' E σ2 WP e2 @ s; E {{ Φ }} wptp s efs). == |==> (world' E σ2 κs WP e2 @ s; E {{ Φ }} wptp s efs).
Proof. Proof.
rewrite {1}wp_unfold /wp_pre. iIntros (?) "[(Hw & HE & Hσ) H]". rewrite {1}wp_unfold /wp_pre. iIntros (?) "[(Hw & HE & Hσ) H]".
rewrite (val_stuck e1 σ1 κ e2 σ2 efs) // uPred_fupd_eq. rewrite (val_stuck e1 σ1 κ e2 σ2 efs) // uPred_fupd_eq.
iMod ("H" $! σ1 with "Hσ [Hw HE]") as ">(Hw & HE & _ & H)"; first by iFrame. iMod ("H" $! σ1 _ with "Hσ [Hw HE]") as ">(Hw & HE & _ & H)"; first by iFrame.
iMod ("H" $! κ e2 σ2 efs with "[//] [$Hw $HE]") as ">(Hw & HE & H)". iMod ("H" $! κ κs e2 σ2 efs with "[//] [$Hw $HE]") as ">(Hw & HE & H)".
iIntros "!> !>". by iMod ("H" with "[$Hw $HE]") as ">($ & $ & $)". iIntros "!> !>". by iMod ("H" with "[$Hw $HE]") as ">($ & $ & $)".
Qed. Qed.
(* should we be able to say that κs = κ :: κs'? *) Lemma wptp_step s e1 t1 t2 κ κs σ1 σ2 Φ :
Lemma wptp_step s e1 t1 t2 κ σ1 σ2 Φ :
step (e1 :: t1,σ1) κ (t2, σ2) step (e1 :: t1,σ1) κ (t2, σ2)
world σ1 WP e1 @ s; {{ Φ }} wptp s t1 world σ1 (cons_obs κ κs) WP e1 @ s; {{ Φ }} wptp s t1
== e2 t2', == e2 t2',
t2 = e2 :: t2' |==> (world σ2 WP e2 @ s; {{ Φ }} wptp s t2'). t2 = e2 :: t2' |==> (world σ2 κs WP e2 @ s; {{ Φ }} wptp s t2').
Proof. Proof.
iIntros (Hstep) "(HW & He & Ht)". iIntros (Hstep) "(HW & He & Ht)".
destruct Hstep as [e1' σ1' e2' σ2' efs [|? t1'] t2' ?? Hstep]; simplify_eq/=. destruct Hstep as [e1' σ1' e2' σ2' efs [|? t1'] t2' ?? Hstep]; simplify_eq/=.
- iExists e2', (t2' ++ efs); iSplitR; first by eauto. - iExists e2', (t2' ++ efs). iSplitR; first by eauto.
iFrame "Ht". iApply wp_step; eauto with iFrame. iFrame "Ht". iApply wp_step; eauto with iFrame.
- iExists e, (t1' ++ e2' :: t2' ++ efs); iSplitR; first eauto. - iExists e, (t1' ++ e2' :: t2' ++ efs); iSplitR; first eauto.
iDestruct "Ht" as "($ & He' & $)". iFrame "He". iDestruct "Ht" as "($ & He' & $)". iFrame "He".
iApply wp_step; eauto with iFrame. iApply wp_step; eauto with iFrame.
Qed. Qed.
Lemma wptp_steps s n e1 t1 κs t2 σ1 σ2 Φ : Lemma wptp_steps s n e1 t1 κs κs' t2 σ1 σ2 Φ :
nsteps n (e1 :: t1, σ1) κs (t2, σ2) nsteps n (e1 :: t1, σ1) κs (t2, σ2)
world σ1 WP e1 @ s; {{ Φ }} wptp s t1 world σ1 (κs ++ κs') WP e1 @ s; {{ Φ }} wptp s t1
Nat.iter (S n) (λ P, |==> P) ( e2 t2', Nat.iter (S n) (λ P, |==> P) ( e2 t2',
t2 = e2 :: t2' world σ2 WP e2 @ s; {{ Φ }} wptp s t2'). t2 = e2 :: t2' world σ2 κs' WP e2 @ s; {{ Φ }} wptp s t2').
Proof. Proof.
revert e1 t1 κs t2 σ1 σ2; simpl; induction n as [|n IH]=> e1 t1 κs t2 σ1 σ2 /=. revert e1 t1 κs κs' t2 σ1 σ2; simpl; induction n as [|n IH]=> e1 t1 κs κs' t2 σ1 σ2 /=.
{ inversion_clear 1; iIntros "?"; eauto 10. } { inversion_clear 1; iIntros "?"; eauto 10. }
iIntros (Hsteps) "H". inversion_clear Hsteps as [|?? [t1' σ1']]. iIntros (Hsteps) "H". inversion_clear Hsteps as [|?? [t1' σ1']].
iMod (wptp_step with "H") as (e1' t1'') "[% H]"; first eauto; simplify_eq. rewrite /cons_obs. rewrite <- app_assoc.
iModIntro; iNext; iMod "H" as ">?". by iApply IH. iMod (wptp_step with "H") as (e1' t1'') "[% H]"; first by eauto; simplify_eq.
subst. iModIntro; iNext; iMod "H" as ">H". by iApply IH.
Qed. Qed.
Lemma bupd_iter_laterN_mono n P Q `{!Plain Q} : Lemma bupd_iter_laterN_mono n P Q `{!Plain Q} :
...@@ -125,9 +125,11 @@ Proof. ...@@ -125,9 +125,11 @@ Proof.
by rewrite bupd_frame_l {1}(later_intro R) -later_sep IH. by rewrite bupd_frame_l {1}(later_intro R) -later_sep IH.
Qed. Qed.
Lemma wptp_result s n e1 t1 κs v2 t2 σ1 σ2 φ : Lemma wptp_result s n e1 t1 κs κs' v2 t2 σ1 σ2 φ :
nsteps n (e1 :: t1, σ1) κs (of_val v2 :: t2, σ2) nsteps n (e1 :: t1, σ1) κs (of_val v2 :: t2, σ2)
world σ1 WP e1 @ s; {{ v, σ, state_interp σ ={,}= ⌜φ v σ⌝ }} wptp s t1 world σ1 (κs ++ κs')
WP e1 @ s; {{ v, σ, state_interp σ κs' ={,}= ⌜φ v σ⌝ }}
wptp s t1
^(S (S n)) ⌜φ v2 σ2. ^(S (S n)) ⌜φ v2 σ2.
Proof. Proof.
intros. rewrite wptp_steps // laterN_later. apply: bupd_iter_laterN_mono. intros. rewrite wptp_steps // laterN_later. apply: bupd_iter_laterN_mono.
...@@ -137,8 +139,8 @@ Proof. ...@@ -137,8 +139,8 @@ Proof.
iMod ("H" with "Hσ [$]") as ">(_ & _ & $)". iMod ("H" with "Hσ [$]") as ">(_ & _ & $)".
Qed. Qed.
Lemma wp_safe E e σ Φ : Lemma wp_safe E e σ κs Φ :
world' E σ - WP e @ E {{ Φ }} == is_Some (to_val e) reducible e σ⌝. world' E σ κs - WP e @ E {{ Φ }} == is_Some (to_val e) reducible e σ⌝.
Proof. Proof.
rewrite wp_unfold /wp_pre. iIntros "(Hw&HE&Hσ) H". rewrite wp_unfold /wp_pre. iIntros "(Hw&HE&Hσ) H".
destruct (to_val e) as [v|] eqn:?. destruct (to_val e) as [v|] eqn:?.
...@@ -147,9 +149,9 @@ Proof. ...@@ -147,9 +149,9 @@ Proof.
iIntros "!> !> !%". by right. iIntros "!> !> !%". by right.
Qed. Qed.
Lemma wptp_safe n e1 κs e2 t1 t2 σ1 σ2 Φ : Lemma wptp_safe n e1 κs κs' e2 t1 t2 σ1 σ2 Φ :
nsteps n (e1 :: t1, σ1) κs (t2, σ2) e2 t2 nsteps n (e1 :: t1, σ1) κs (t2, σ2) e2 t2
world σ1 WP e1 {{ Φ }} wptp NotStuck t1 world σ1 (κs ++ κs') WP e1 {{ Φ }} wptp NotStuck t1
^(S (S n)) is_Some (to_val e2) reducible e2 σ2. ^(S (S n)) is_Some (to_val e2) reducible e2 σ2.
Proof. Proof.
intros ? He2. rewrite wptp_steps // laterN_later. apply: bupd_iter_laterN_mono. intros ? He2. rewrite wptp_steps // laterN_later. apply: bupd_iter_laterN_mono.
...@@ -159,9 +161,9 @@ Proof. ...@@ -159,9 +161,9 @@ Proof.
- iMod (wp_safe with "Hw [Htp]") as "$". by iApply (big_sepL_elem_of with "Htp"). - iMod (wp_safe with "Hw [Htp]") as "$". by iApply (big_sepL_elem_of with "Htp").
Qed. Qed.
Lemma wptp_invariance s n e1 κs e2 t1 t2 σ1 σ2 φ Φ : Lemma wptp_invariance s n e1 κs κs' e2 t1 t2 σ1 σ2 φ Φ :
nsteps n (e1 :: t1, σ1) κs (t2, σ2) nsteps n (e1 :: t1, σ1) κs (t2, σ2)
(state_interp σ2 ={,}= ⌜φ⌝) world σ1 WP e1 @ s; {{ Φ }} wptp s t1 (state_interp σ2 κs' ={,}= ⌜φ⌝) world σ1 (κs ++ κs') WP e1 @ s; {{ Φ }} wptp s t1
^(S (S n)) ⌜φ⌝. ^(S (S n)) ⌜φ⌝.
Proof. Proof.
intros ?. rewrite wptp_steps // bupd_iter_frame_l laterN_later. intros ?. rewrite wptp_steps // bupd_iter_frame_l laterN_later.
...@@ -173,68 +175,70 @@ Qed. ...@@ -173,68 +175,70 @@ Qed.
End adequacy. End adequacy.
Theorem wp_strong_adequacy Σ Λ `{invPreG Σ} s e σ φ : Theorem wp_strong_adequacy Σ Λ `{invPreG Σ} s e σ φ :
( `{Hinv : invG Σ}, ( `{Hinv : invG Σ} κs,
(|={}=> stateI : state Λ iProp Σ, (|={}=> stateI : state Λ list (observation Λ) iProp Σ,
let _ : irisG Λ Σ := IrisG _ _ Hinv stateI in let _ : irisG Λ Σ := IrisG _ _ _ Hinv stateI in
stateI σ WP e @ s; {{ v, σ, stateI σ ={,}= ⌜φ v σ⌝ }})%I) stateI σ κs WP e @ s; {{ v, σ, stateI σ [] ={,}= ⌜φ v σ⌝ }})%I)
adequate s e σ φ. adequate s e σ φ.
Proof. Proof.
intros Hwp; split. intros Hwp; split.
- intros t2 σ2 v2 [n [κs ?]]%erased_steps_nsteps. - intros t2 σ2 v2 [n [κs ?]]%erased_steps_nsteps.
eapply (soundness (M:=iResUR Σ) _ (S (S n))). eapply (soundness (M:=iResUR Σ) _ (S (S n))).
iMod wsat_alloc as (Hinv) "[Hw HE]". specialize (Hwp _). iMod wsat_alloc as (Hinv) "[Hw HE]". specialize (Hwp _ κs).
rewrite {1}uPred_fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)". rewrite {1}uPred_fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
iDestruct "Hwp" as (Istate) "[HI Hwp]". iDestruct "Hwp" as (Istate) "[HI Hwp]".
iApply (@wptp_result _ _ (IrisG _ _ Hinv Istate)); eauto with iFrame. iApply (@wptp_result _ _ (IrisG _ _ _ Hinv Istate) _ _ _ _ _ []); last first.
rewrite app_nil_r. all: eauto with iFrame.
- destruct s; last done. intros t2 σ2 e2 _ [n [κs ?]]%erased_steps_nsteps ?. - destruct s; last done. intros t2 σ2 e2 _ [n [κs ?]]%erased_steps_nsteps ?.
eapply (soundness (M:=iResUR Σ) _ (S (S n))). eapply (soundness (M:=iResUR Σ) _ (S (S n))).
iMod wsat_alloc as (Hinv) "[Hw HE]". specialize (Hwp _). iMod wsat_alloc as (Hinv) "[Hw HE]". specialize (Hwp _ κs).
rewrite uPred_fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)". rewrite uPred_fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
iDestruct "Hwp" as (Istate) "[HI Hwp]". iDestruct "Hwp" as (Istate) "[HI Hwp]".
iApply (@wptp_safe _ _ (IrisG _ _ Hinv Istate)); eauto with iFrame. iApply (@wptp_safe _ _ (IrisG _ _ _ Hinv Istate) _ _ _ []); last first.
rewrite app_nil_r. all: eauto with iFrame.
Qed. Qed.
Theorem wp_adequacy Σ Λ `{invPreG Σ} s e σ φ : Theorem wp_adequacy Σ Λ `{invPreG Σ} s e σ φ :
( `{Hinv : invG Σ}, ( `{Hinv : invG Σ} κs,
(|={}=> stateI : state Λ iProp Σ, (|={}=> stateI : state Λ list (observation Λ) iProp Σ,
let _ : irisG Λ Σ := IrisG _ _ Hinv stateI in let _ : irisG Λ Σ := IrisG _ _ _ Hinv stateI in
stateI σ WP e @ s; {{ v, ⌜φ v }})%I) stateI σ κs WP e @ s; {{