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

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
theories/program_logic/ectx_language.v
theories/program_logic/ectxi_language.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_ectx_lifting.v
theories/program_logic/atomic.v
......
......@@ -17,8 +17,8 @@ Definition heap_adequacy Σ `{heapPreG Σ} s e σ φ :
( `{heapG Σ}, WP e @ s; {{ v, ⌜φ v }}%I)
adequate s e σ (λ v _, φ v).
Proof.
intros Hwp; eapply (wp_adequacy _ _); iIntros (?) "".
intros Hwp; eapply (wp_adequacy _ _); iIntros (??) "".
iMod (gen_heap_init σ) as (?) "Hh".
iModIntro. iExists gen_heap_ctx. iFrame "Hh".
iModIntro. iExists (fun σ _ => gen_heap_ctx σ). iFrame "Hh".
iApply (Hwp (HeapG _ _ _)).
Qed.
......@@ -108,7 +108,7 @@ Inductive val :=
Bind Scope val_scope with val.
Inductive observation := prophecy_observation_todo.
Definition observation := Empty val.
Fixpoint of_val (v : val) : expr :=
match v with
......
......@@ -14,7 +14,7 @@ Class heapG Σ := HeapG {
Instance heapG_irisG `{heapG Σ} : irisG heap_lang Σ := {
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 *)
......@@ -112,6 +112,7 @@ Proof.
iApply wp_lift_pure_det_head_step; [eauto|intros; inv_head_step; eauto|].
iModIntro; iNext; iIntros "!> /= {$He}". by iApply wp_value.
Qed.
Lemma twp_fork s E e Φ :
WP e @ s; [{ _, True }] - Φ (LitV LitUnit) - WP Fork e @ s; E [{ Φ }].
Proof.
......@@ -126,8 +127,8 @@ Lemma wp_alloc s E e v :
{{{ True }}} Alloc e @ s; E {{{ l, RET LitV (LitLoc l); l v }}}.
Proof.
iIntros (<- Φ) "_ HΦ". iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>"; iSplit; first by eauto.
iNext; iIntros (κ v2 σ2 efs Hstep); inv_head_step.
iIntros (σ1 κs) "Hσ !>"; iSplit; first by eauto.
iNext; iIntros (κ κs' v2 σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_alloc with "Hσ") as "[Hσ Hl]"; first done.
iModIntro; iSplit=> //. iFrame. by iApply "HΦ".
Qed.
......@@ -136,8 +137,8 @@ Lemma twp_alloc s E e v :
[[{ True }]] Alloc e @ s; E [[{ l, RET LitV (LitLoc l); l v }]].
Proof.
iIntros (<- Φ) "_ HΦ". iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>"; iSplit; first by eauto.
iIntros (κ v2 σ2 efs Hstep); inv_head_step.
iIntros (σ1 κs) "Hσ !>"; iSplit; first by eauto.
iIntros (κ κs' v2 σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_alloc with "Hσ") as "[Hσ Hl]"; first done.
iModIntro; iSplit=> //. iFrame. by iApply "HΦ".
Qed.
......@@ -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 }}}.
Proof.
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.
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Φ".
Qed.
Lemma twp_load s E l q v :
[[{ l {q} v }]] Load (Lit (LitLoc l)) @ s; E [[{ RET v; l {q} v }]].
Proof.
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.
iIntros (κ v2 σ2 efs Hstep); inv_head_step.
iIntros (κ κs' v2 σ2 efs [Hstep ->]); inv_head_step.
iModIntro; iSplit=> //. iFrame. by iApply "HΦ".
Qed.
......@@ -167,8 +168,8 @@ Lemma wp_store s E l v' e v :
Proof.
iIntros (<- Φ) ">Hl HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto 6. iNext; iIntros (κ v2 σ2 efs Hstep); inv_head_step.
iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto 6. iNext; iIntros (κ κs' v2 σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. by iApply "HΦ".
Qed.
......@@ -178,8 +179,8 @@ Lemma twp_store s E l v' e v :
Proof.
iIntros (<- Φ) "Hl HΦ".
iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto 6. iIntros (κ v2 σ2 efs Hstep); inv_head_step.
iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto 6. iIntros (κ κs' v2 σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. by iApply "HΦ".
Qed.
......@@ -191,8 +192,8 @@ Lemma wp_cas_fail s E l q v' e1 v1 e2 :
Proof.
iIntros (<- [v2 <-] ?? Φ) ">Hl HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (κ v2' σ2 efs Hstep); inv_head_step.
iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (κ κs' v2' σ2 efs [Hstep ->]); inv_head_step.
iModIntro; iSplit=> //. iFrame. by iApply "HΦ".
Qed.
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.
iIntros (<- [v2 <-] ?? Φ) "Hl HΦ".
iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (κ v2' σ2 efs Hstep); inv_head_step.
iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (κ κs' v2' σ2 efs [Hstep ->]); inv_head_step.
iModIntro; iSplit=> //. iFrame. by iApply "HΦ".
Qed.
......@@ -214,8 +215,8 @@ Lemma wp_cas_suc s E l e1 v1 e2 v2 :
Proof.
iIntros (<- <- ? Φ) ">Hl HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (κ v2' σ2 efs Hstep); inv_head_step.
iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (κ κs' v2' σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. by iApply "HΦ".
Qed.
......@@ -226,8 +227,8 @@ Lemma twp_cas_suc s E l e1 v1 e2 v2 :
Proof.
iIntros (<- <- ? Φ) "Hl HΦ".
iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (κ v2' σ2 efs Hstep); inv_head_step.
iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (κ κs' v2' σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. by iApply "HΦ".
Qed.
......@@ -239,8 +240,8 @@ Lemma wp_faa s E l i1 e2 i2 :
Proof.
iIntros (<- Φ) ">Hl HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (κ v2' σ2 efs Hstep); inv_head_step.
iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (κ κs' v2' σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. by iApply "HΦ".
Qed.
......@@ -251,8 +252,8 @@ Lemma twp_faa s E l i1 e2 i2 :
Proof.
iIntros (<- Φ) "Hl HΦ".
iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (κ v2' σ2 efs Hstep); inv_head_step.
iIntros (σ1 κs) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (κ κs' v2' σ2 efs [Hstep ->]); inv_head_step.
iMod (@gen_heap_update with "Hσ Hl") as "[$ Hl]".
iModIntro. iSplit=>//. by iApply "HΦ".
Qed.
......
......@@ -40,6 +40,7 @@ Proof.
rewrite envs_entails_eq=> ??? HΔ'. rewrite into_laterN_env_sound /=.
rewrite HΔ' -lifting.wp_pure_step_later //.
Qed.
Lemma tac_twp_pure `{heapG Σ} Δ s E e1 e2 φ Φ :
PureExec φ e1 e2
φ
......
......@@ -4,12 +4,15 @@ From iris.heap_lang Require Import proofmode notation.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
(* TODO (MR) re-introduce lemma after we prove twp_total *)
(*
Definition heap_total Σ `{heapPreG Σ} s e σ φ :
(∀ `{heapG Σ}, WP e @ s; ⊤ [{ v, ⌜φ v⌝ }]%I) →
sn erased_step ([e], σ).
Proof.
intros Hwp; eapply (twp_total _ _); iIntros (?) "".
intros Hwp; eapply (twp_total _ _) with (κs := []); iIntros (?) "".
iMod (gen_heap_init σ) as (?) "Hh".
iModIntro. iExists gen_heap_ctx; iFrame.
iModIntro. iExists (fun σ _ => gen_heap_ctx σ); iFrame.
iApply (Hwp (HeapG _ _ _)).
Qed.
*)
This diff is collapsed.
......@@ -16,7 +16,7 @@ Section ectx_language_mixin.
Context (empty_ectx : ectx).
Context (comp_ectx : ectx ectx ectx).
Context (fill : ectx expr expr).
Context (head_step : expr state option observation -> expr state list expr Prop).
Context (head_step : expr state option observation expr state list expr Prop).
Record EctxLanguageMixin := {
mixin_to_of_val v : to_val (of_val v) = Some v;
......@@ -55,7 +55,7 @@ Structure ectxLanguage := EctxLanguage {
empty_ectx : ectx;
comp_ectx : ectx ectx ectx;
fill : ectx expr expr;
head_step : expr state option observation -> expr state list expr Prop;
head_step : expr state option observation expr state list expr Prop;
ectx_language_mixin :
EctxLanguageMixin of_val to_val empty_ectx comp_ectx fill head_step
......@@ -210,7 +210,7 @@ Section ectx_language.
Lemma det_head_step_pure_exec (P : Prop) e1 e2 :
( σ, P head_reducible e1 σ)
( σ1 κ e2' σ2 efs,
P head_step e1 σ1 κ e2' σ2 efs κ = None /\ σ1 = σ2 e2=e2' efs = [])
P head_step e1 σ1 κ e2' σ2 efs κ = None σ1 = σ2 e2=e2' efs = [])
PureExec P e1 e2.
Proof.
intros Hp1 Hp2. split.
......
......@@ -16,43 +16,43 @@ Hint Resolve head_stuck_stuck.
Lemma wp_lift_head_step_fupd {s E Φ} e1 :
to_val e1 = None
( σ1, state_interp σ1 ={E,}=
( σ1 κs, state_interp σ1 κs ={E,}=
head_reducible e1 σ1
κ e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs ={,,E}=
state_interp σ2 WP e2 @ s; E {{ Φ }} [ list] ef efs, WP ef @ s; {{ _, True }})
κ κs' e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs κs = cons_obs κ κs' ={,,E}=
state_interp σ2 κs' WP e2 @ s; E {{ Φ }} [ list] ef efs, WP ef @ s; {{ _, True }})
WP e1 @ s; E {{ Φ }}.
Proof.
iIntros (?) "H". iApply wp_lift_step_fupd=>//. iIntros (σ1) "Hσ".
iIntros (?) "H". iApply wp_lift_step_fupd=>//. iIntros (σ1 κs) "Hσ".
iMod ("H" with "Hσ") as "[% H]"; iModIntro.
iSplit; first by destruct s; eauto. iIntros (κ e2 σ2 efs) "%".
iSplit; first by destruct s; eauto. iIntros (κ κs' e2 σ2 efs [Hstep ->]).
iApply "H"; eauto.
Qed.
Lemma wp_lift_head_step {s E Φ} e1 :
to_val e1 = None
( σ1, state_interp σ1 ={E,}=
( σ1 κs, state_interp σ1 κs ={E,}=
head_reducible e1 σ1
κ e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs ={,E}=
state_interp σ2 WP e2 @ s; E {{ Φ }} [ list] ef efs, WP ef @ s; {{ _, True }})
κ κs' e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs κs = cons_obs κ κs' ={,E}=
state_interp σ2 κs' WP e2 @ s; E {{ Φ }} [ list] ef efs, WP ef @ s; {{ _, True }})
WP e1 @ s; E {{ Φ }}.
Proof.
iIntros (?) "H". iApply wp_lift_head_step_fupd; [done|]. iIntros (?) "?".
iMod ("H" with "[$]") as "[$ H]". iIntros "!>" (κ e2 σ2 efs ?) "!> !>". by iApply "H".
iIntros (?) "H". iApply wp_lift_head_step_fupd; [done|]. iIntros (??) "?".
iMod ("H" with "[$]") as "[$ H]". iIntros "!>" (κ κs' e2 σ2 efs ?) "!> !>". by iApply "H".
Qed.
Lemma wp_lift_head_stuck E Φ e :
to_val e = None
sub_redexes_are_values e
( σ, state_interp σ ={E,}= head_stuck e σ⌝)
( σ κs, state_interp σ κs ={E,}= head_stuck e σ⌝)
WP e @ E ?{{ Φ }}.
Proof.
iIntros (??) "H". iApply wp_lift_stuck; first done.
iIntros (σ) "Hσ". iMod ("H" with "Hσ") as "%". by auto.
iIntros (σ κs) "Hσ". iMod ("H" with "Hσ") as "%". by auto.
Qed.
Lemma wp_lift_pure_head_step {s E E' Φ} e1 :
( σ1, head_reducible e1 σ1)
( σ1 κ e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs κ = None /\ σ1 = σ2)
( σ1 κ e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs κ = None σ1 = σ2)
(|={E,E'}=> κ e2 efs σ, head_step e1 σ κ e2 σ efs
WP e2 @ s; E {{ Φ }} [ list] ef efs, WP ef @ s; {{ _, True }})
WP e1 @ s; E {{ Φ }}.
......@@ -70,72 +70,73 @@ Lemma wp_lift_pure_head_stuck E Φ e :
WP e @ E ?{{ Φ }}%I.
Proof using Hinh.
iIntros (?? Hstuck). iApply wp_lift_head_stuck; [done|done|].
iIntros (σ) "_". iMod (fupd_intro_mask' E ) as "_"; first set_solver.
iIntros (σ κs) "_". iMod (fupd_intro_mask' E ) as "_"; first set_solver.
by auto.
Qed.
Lemma wp_lift_atomic_head_step_fupd {s E1 E2 Φ} e1 :
to_val e1 = None
( σ1, state_interp σ1 ={E1}=
( σ1 κs, state_interp σ1 κs ={E1}=
head_reducible e1 σ1
κ e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs ={E1,E2}=
state_interp σ2
κ κs' e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs κs = cons_obs κ κs' ={E1,E2}=
state_interp σ2 κs'
from_option Φ False (to_val e2) [ list] ef efs, WP ef @ s; {{ _, True }})
WP e1 @ s; E1 {{ Φ }}.
Proof.
iIntros (?) "H". iApply wp_lift_atomic_step_fupd; [done|].
iIntros (σ1) "Hσ1". iMod ("H" with "Hσ1") as "[% H]"; iModIntro.
iSplit; first by destruct s; auto. iIntros (κ e2 σ2 efs) "%".
iIntros (σ1 κs) "Hσ1". iMod ("H" with "Hσ1") as "[% H]"; iModIntro.
iSplit; first by destruct s; auto. iIntros (κ κs' e2 σ2 efs [Hstep ->]).
iApply "H"; eauto.
Qed.
Lemma wp_lift_atomic_head_step {s E Φ} e1 :
to_val e1 = None
( σ1, state_interp σ1 ={E}=
( σ1 κs, state_interp σ1 κs ={E}=
head_reducible e1 σ1
κ e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs ={E}=
state_interp σ2
κ κs' e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs κs = cons_obs κ κs' ={E}=
state_interp σ2 κs'
from_option Φ False (to_val e2) [ list] ef efs, WP ef @ s; {{ _, True }})
WP e1 @ s; E {{ Φ }}.
Proof.
iIntros (?) "H". iApply wp_lift_atomic_step; eauto.
iIntros (σ1) "Hσ1". iMod ("H" with "Hσ1") as "[% H]"; iModIntro.
iSplit; first by destruct s; auto. iNext. iIntros (κ e2 σ2 efs) "%".
iIntros (σ1 κs) "Hσ1". iMod ("H" with "Hσ1") as "[% H]"; iModIntro.
iSplit; first by destruct s; auto. iNext. iIntros (κ κs' e2 σ2 efs [Hstep ->]).
iApply "H"; eauto.
Qed.
Lemma wp_lift_atomic_head_step_no_fork_fupd {s E1 E2 Φ} e1 :
to_val e1 = None
( σ1, state_interp σ1 ={E1}=
( σ1 κs, state_interp σ1 κs ={E1}=
head_reducible e1 σ1
κ e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs ={E1,E2}=
efs = [] state_interp σ2 from_option Φ False (to_val e2))
κ κs' e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs κs = cons_obs κ κs' ={E1,E2}=
efs = [] state_interp σ2 κs' from_option Φ False (to_val e2))
WP e1 @ s; E1 {{ Φ }}.
Proof.
iIntros (?) "H". iApply wp_lift_atomic_head_step_fupd; [done|].
iIntros (σ1) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]"; iModIntro.
iIntros (κ v2 σ2 efs) "%". iMod ("H" $! κ v2 σ2 efs with "[# //]") as "H".
iIntros (σ1 κs) "Hσ1". iMod ("H" $! σ1 κs with "Hσ1") as "[$ H]"; iModIntro.
iIntros (κ κs' v2 σ2 efs [Hstep ->]).
iMod ("H" $! κ κs' v2 σ2 efs with "[# //]") as "H".
iIntros "!> !>". iMod "H" as "(% & $ & $)"; subst; auto.
Qed.
Lemma wp_lift_atomic_head_step_no_fork {s E Φ} e1 :
to_val e1 = None
( σ1, state_interp σ1 ={E}=
( σ1 κs, state_interp σ1 κs ={E}=
head_reducible e1 σ1
κ e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs ={E}=
efs = [] state_interp σ2 from_option Φ False (to_val e2))
κ κs' e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs κs = cons_obs κ κs' ={E}=
efs = [] state_interp σ2 κs' from_option Φ False (to_val e2))
WP e1 @ s; E {{ Φ }}.
Proof.
iIntros (?) "H". iApply wp_lift_atomic_head_step; eauto.
iIntros (σ1) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]"; iModIntro.
iNext; iIntros (κ v2 σ2 efs) "%".
iMod ("H" $! κ v2 σ2 efs with "[# //]") as "(% & $ & $)"; subst; auto.
iIntros (σ1 κs) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]"; iModIntro.
iNext; iIntros (κ κs' v2 σ2 efs Hstep).
iMod ("H" $! κ κs' v2 σ2 efs with "[# //]") as "(% & $ & $)". subst; auto.
Qed.
Lemma wp_lift_pure_det_head_step {s E E' Φ} e1 e2 efs :
( σ1, head_reducible e1 σ1)
( σ1 κ e2' σ2 efs',
head_step e1 σ1 κ e2' σ2 efs' κ = None /\ σ1 = σ2 e2 = e2' efs = efs')
head_step e1 σ1 κ e2' σ2 efs' κ = None σ1 = σ2 e2 = e2' efs = efs')
(|={E,E'}=> WP e2 @ s; E {{ Φ }} [ list] ef efs, WP ef @ s; {{ _, True }})
WP e1 @ s; E {{ Φ }}.
Proof using Hinh.
......@@ -147,7 +148,7 @@ Lemma wp_lift_pure_det_head_step_no_fork {s E E' Φ} e1 e2 :
to_val e1 = None
( σ1, head_reducible e1 σ1)
( σ1 κ e2' σ2 efs',
head_step e1 σ1 κ e2' σ2 efs' κ = None /\ σ1 = σ2 e2 = e2' [] = efs')
head_step e1 σ1 κ e2' σ2 efs' κ = None σ1 = σ2 e2 = e2' [] = efs')
(|={E,E'}=> WP e2 @ s; E {{ Φ }}) WP e1 @ s; E {{ Φ }}.
Proof using Hinh.
intros. rewrite -(wp_lift_pure_det_step e1 e2 []) /= ?right_id; eauto.
......@@ -158,7 +159,7 @@ Lemma wp_lift_pure_det_head_step_no_fork' {s E Φ} e1 e2 :
to_val e1 = None
( σ1, head_reducible e1 σ1)
( σ1 κ e2' σ2 efs',
head_step e1 σ1 κ e2' σ2 efs' κ = None /\ σ1 = σ2 e2 = e2' [] = efs')
head_step e1 σ1 κ e2' σ2 efs' κ = None σ1 = σ2 e2 = e2' [] = efs')
WP e2 @ s; E {{ Φ }} WP e1 @ s; E {{ Φ }}.
Proof using Hinh.
intros. rewrite -[(WP e1 @ s; _ {{ _ }})%I]wp_lift_pure_det_head_step_no_fork //.
......
......@@ -31,7 +31,7 @@ Section ectxi_language_mixin.
Context (of_val : val expr).
Context (to_val : expr option val).
Context (fill_item : ectx_item expr expr).
Context (head_step : expr state option observation -> expr state list expr Prop).
Context (head_step : expr state option observation expr state list expr Prop).
Record EctxiLanguageMixin := {
mixin_to_of_val v : to_val (of_val v) = Some v;
......@@ -59,7 +59,7 @@ Structure ectxiLanguage := EctxiLanguage {
of_val : val expr;
to_val : expr option val;
fill_item : ectx_item expr expr;
head_step : expr state option observation -> expr state list expr Prop;
head_step : expr state option observation expr state list expr Prop;
ectxi_language_mixin :
EctxiLanguageMixin of_val to_val fill_item head_step
......
......@@ -5,7 +5,7 @@ Section language_mixin.
Context {expr val state observation : Type}.
Context (of_val : val expr).
Context (to_val : expr option val).
(** We annotate the reduction relation with observations [k], which we will use in the definition
(** We annotate the reduction relation with observations [κ], which we will use in the definition
of weakest preconditions to keep track of creating and resolving prophecy variables. *)
Context (prim_step : expr state option observation expr state list expr Prop).
......@@ -100,28 +100,24 @@ Section language.
prim_step e1 σ1 κ e2 σ2 efs
step ρ1 κ ρ2.
Inductive nsteps : nat -> cfg Λ list (observation Λ) cfg Λ Prop :=
(* TODO (MR) introduce notation ::? for cons_obs and suggest for inclusion to stdpp? *)
Definition cons_obs {A} (x : option A) (xs : list A) :=
option_list x ++ xs.
Inductive nsteps : nat cfg Λ list (observation Λ) cfg Λ Prop :=
| nsteps_refl ρ :
nsteps 0 ρ [] ρ
| nsteps_l n ρ1 ρ2 ρ3 κ κs :
step ρ1 κ ρ2
nsteps n ρ2 κs ρ3
nsteps (S n) ρ1 (option_list κ ++ κs) ρ3.
(* Inductive steps : cfg Λ → list (observation Λ) → cfg Λ → Prop :=
| steps_refl ρ :
steps ρ [] ρ
| steps_l ρ1 ρ2 ρ3 κ κs :
step ρ1 κ ρ2 →
steps ρ2 κs ρ3 →
steps ρ1 (option_list κ ++ κs) ρ3. *)
nsteps (S n) ρ1 (cons_obs κ κs) ρ3.
Definition erased_step (ρ1 ρ2 : cfg Λ) := exists κ, step ρ1 κ ρ2.
Hint Constructors step nsteps.
Lemma erased_steps_nsteps ρ1 ρ2 :
rtc erased_step ρ1 ρ2 ->
rtc erased_step ρ1 ρ2
n κs, nsteps n ρ1 κs ρ2.
Proof.
induction 1; firstorder; eauto.
......@@ -173,7 +169,7 @@ Section language.
pure_exec_safe σ :
P reducible e1 σ;
pure_exec_puredet σ1 κ e2' σ2 efs :
P prim_step e1 σ1 κ e2' σ2 efs κ = None /\ σ1 = σ2 e2 = e2' efs = [];
P prim_step e1 σ1 κ e2' σ2 efs κ = None σ1 = σ2 e2 = e2' efs = [];
}.
Lemma hoist_pred_pure_exec (P : Prop) (e1 e2 : expr Λ) :
......
......@@ -13,42 +13,43 @@ Implicit Types Φ : val Λ → iProp Σ.
Lemma wp_lift_step_fupd s E Φ e1 :
to_val e1 = None
( σ1, state_interp σ1 ={E,}=
( σ1 κs, state_interp σ1 κs ={E,}=
if s is NotStuck then reducible e1 σ1 else True
κ e2 σ2 efs, prim_step e1 σ1 κ e2 σ2 efs ={,,E}=
state_interp σ2 WP e2 @ s; E {{ Φ }} [ list] ef efs, WP ef @ s; {{ _, True }})
κ κs' e2 σ2 efs, prim_step e1 σ1 κ e2 σ2 efs κs = cons_obs κ κs' ={,,E}=
state_interp σ2 κs' WP e2 @ s; E {{ Φ }} [ list] ef efs, WP ef @ s; {{ _, True }})
WP e1 @ s; E {{ Φ }}.
Proof.
rewrite wp_unfold /wp_pre=>->. iIntros "H" (σ1) "Hσ".
iMod ("H" with "Hσ") as "(%&H)". iModIntro. iSplit. by destruct s. done.
rewrite wp_unfold /wp_pre=>->. iIntros "H" (σ1 κs) "Hσ".
iMod ("H" with "Hσ") as "(%&H)". iModIntro. iSplit. by destruct s.
iIntros (????? [? ->]). iApply "H". eauto.
Qed.
Lemma wp_lift_stuck E Φ e :
to_val e = None
( σ, state_interp σ ={E,}= stuck e σ⌝)
( σ κs, state_interp σ κs ={E,}= stuck e σ⌝)
WP e @ E ?{{ Φ }}.
Proof.
rewrite wp_unfold /wp_pre=>->. iIntros "H" (σ1) "Hσ".
rewrite wp_unfold /wp_pre=>->. iIntros "H" (σ1 κs) "Hσ".
iMod ("H" with "Hσ") as %[? Hirr]. iModIntro. iSplit; first done.
iIntros (κ e2 σ2 efs) "% !> !>". by case: (Hirr κ e2 σ2 efs).
iIntros (κ ? e2 σ2 efs [? ->]). by case: (Hirr κ e2 σ2 efs).
Qed.
(** Derived lifting lemmas. *)
Lemma wp_lift_step s E Φ e1 :
to_val e1 = None
( σ1, state_interp σ1 ={E,}=
( σ1 κs, state_interp σ1 κs ={E,}=
if s is NotStuck then reducible e1 σ1 else True
κ e2 σ2 efs, prim_step e1 σ1 κ e2 σ2 efs ={,E}=
state_interp σ2 WP e2 @ s; E {{ Φ }} [ list] ef efs, WP ef @ s; {{ _, True }})
κ κs' e2 σ2 efs,