Skip to content

GitLab

Commit 25ed5c9c authored by Ralf Jung's avatar Ralf Jung
Browse files

generalize to lists of observations per program step

parent fc59d6d0
Hide whitespace changes
Inline Side-by-side
theories/heap_lang/lang.v
View file @ 25ed5c9c
......@@ -448,82 +448,83 @@ Definition state_upd_used_proph (f: gset proph → gset proph) (σ: state) :=
{| heap := σ.(heap); used_proph := f σ.(used_proph) |}.
Arguments state_upd_used_proph _ !_ /.
Inductive head_step : expr → state → option observation → expr → state → list (expr) → Prop :=
Inductive head_step : expr → state → list observation → expr → state → list (expr) → Prop :=
| BetaS f x e1 e2 v2 e' σ :
to_val e2 = Some v2 →
Closed (f :b: x :b: []) e1 →
e' = subst' x (of_val v2) (subst' f (Rec f x e1) e1) →
head_step (App (Rec f x e1) e2) σ None e' σ []
head_step (App (Rec f x e1) e2) σ [] e' σ []
| UnOpS op e v v' σ :
to_val e = Some v →
un_op_eval op v = Some v' →
head_step (UnOp op e) σ None (of_val v') σ []
head_step (UnOp op e) σ [] (of_val v') σ []
| BinOpS op e1 e2 v1 v2 v' σ :
to_val e1 = Some v1 → to_val e2 = Some v2 →
bin_op_eval op v1 v2 = Some v' →
head_step (BinOp op e1 e2) σ None (of_val v') σ []
head_step (BinOp op e1 e2) σ [] (of_val v') σ []
| IfTrueS e1 e2 σ :
head_step (If (Lit $ LitBool true) e1 e2) σ None e1 σ []
head_step (If (Lit $ LitBool true) e1 e2) σ [] e1 σ []
| IfFalseS e1 e2 σ :
head_step (If (Lit $ LitBool false) e1 e2) σ None e2 σ []
head_step (If (Lit $ LitBool false) e1 e2) σ [] e2 σ []
| FstS e1 v1 e2 v2 σ :
to_val e1 = Some v1 → to_val e2 = Some v2 →
head_step (Fst (Pair e1 e2)) σ None e1 σ []
head_step (Fst (Pair e1 e2)) σ [] e1 σ []
| SndS e1 v1 e2 v2 σ :
to_val e1 = Some v1 → to_val e2 = Some v2 →
head_step (Snd (Pair e1 e2)) σ None e2 σ []
head_step (Snd (Pair e1 e2)) σ [] e2 σ []
| CaseLS e0 v0 e1 e2 σ :
to_val e0 = Some v0 →
head_step (Case (InjL e0) e1 e2) σ None (App e1 e0) σ []
head_step (Case (InjL e0) e1 e2) σ [] (App e1 e0) σ []
| CaseRS e0 v0 e1 e2 σ :
to_val e0 = Some v0 →
head_step (Case (InjR e0) e1 e2) σ None (App e2 e0) σ []
head_step (Case (InjR e0) e1 e2) σ [] (App e2 e0) σ []
| ForkS e σ:
head_step (Fork e) σ None (Lit LitUnit) σ [e]
head_step (Fork e) σ [] (Lit LitUnit) σ [e]
| AllocS e v σ l :
to_val e = Some v → σ.(heap) !! l = None →
head_step (Alloc e) σ
None (Lit $ LitLoc l) (state_upd_heap <[l:=v]> σ)
[]
(Lit $ LitLoc l) (state_upd_heap <[l:=v]> σ)
[]
| LoadS l v σ :
σ.(heap) !! l = Some v →
head_step (Load (Lit $ LitLoc l)) σ None (of_val v) σ []
head_step (Load (Lit $ LitLoc l)) σ [] (of_val v) σ []
| StoreS l e v σ :
to_val e = Some v → is_Some (σ.(heap) !! l) →
head_step (Store (Lit $ LitLoc l) e) σ
None
[]
(Lit LitUnit) (state_upd_heap <[l:=v]> σ)
[]
| CasFailS l e1 v1 e2 v2 vl σ :
to_val e1 = Some v1 → to_val e2 = Some v2 →
σ.(heap) !! l = Some vl → vl ≠ v1 →
vals_cas_compare_safe vl v1 →
head_step (CAS (Lit $ LitLoc l) e1 e2) σ None (Lit $ LitBool false) σ []
head_step (CAS (Lit $ LitLoc l) e1 e2) σ [] (Lit $ LitBool false) σ []
| CasSucS l e1 v1 e2 v2 σ :
to_val e1 = Some v1 → to_val e2 = Some v2 →
σ.(heap) !! l = Some v1 →
vals_cas_compare_safe v1 v1 →
head_step (CAS (Lit $ LitLoc l) e1 e2) σ
None
[]
(Lit $ LitBool true) (state_upd_heap <[l:=v2]> σ)
[]
| FaaS l i1 e2 i2 σ :
to_val e2 = Some (LitV (LitInt i2)) →
σ.(heap) !! l = Some (LitV (LitInt i1)) →
head_step (FAA (Lit $ LitLoc l) e2) σ
None
[]
(Lit $ LitInt i1) (state_upd_heap <[l:=LitV (LitInt (i1 + i2))]> σ)
[]
| NewProphS σ p :
p ∉ σ.(used_proph) →
head_step NewProph σ
None
[]
(Lit $ LitProphecy p) (state_upd_used_proph ({[ p ]} ∪) σ)
[]
| ResolveProphS e1 p e2 v σ :
to_val e1 = Some (LitV $ LitProphecy p) →
to_val e2 = Some v →
head_step (ResolveProph e1 e2) σ (Some (p, v)) (Lit LitUnit) σ [].
head_step (ResolveProph e1 e2) σ [(p, v)] (Lit LitUnit) σ [].
(** Basic properties about the language *)
Instance fill_item_inj Ki : Inj (=) (=) (fill_item Ki).
......@@ -553,12 +554,12 @@ Qed.
Lemma alloc_fresh e v σ :
let l := fresh (dom (gset loc) σ.(heap)) in
to_val e = Some v →
head_step (Alloc e) σ None (Lit (LitLoc l)) (state_upd_heap <[l:=v]> σ) [].
head_step (Alloc e) σ [] (Lit (LitLoc l)) (state_upd_heap <[l:=v]> σ) [].
Proof. by intros; apply AllocS, (not_elem_of_dom (D:=gset loc)), is_fresh. Qed.
Lemma new_proph_fresh σ :
let p := fresh σ.(used_proph) in
head_step NewProph σ None (Lit $ LitProphecy p) (state_upd_used_proph ({[ p ]} ∪) σ) [].
head_step NewProph σ [] (Lit $ LitProphecy p) (state_upd_used_proph ({[ p ]} ∪) σ) [].
Proof. constructor. apply is_fresh. Qed.
(* Misc *)
......
theories/heap_lang/lifting.v
View file @ 25ed5c9c
......@@ -292,7 +292,6 @@ Lemma wp_resolve_proph e1 e2 p v w:
{{{ p ⥱ v }}} ResolveProph e1 e2 {{{ RET (LitV LitUnit); ⌜v = Some w⌝ }}}.
Proof.
iIntros (<- <- Φ) "Hp HΦ". iApply wp_lift_atomic_head_step_no_fork; auto.
unfold cons_obs. simpl.
iIntros (σ1 κ κs) "[Hσ HR] !>". iDestruct "HR" as (R [Hfr Hdom]) "HR".
iDestruct (@proph_map_valid with "HR Hp") as %Hlookup.
iSplit; first by eauto.
......
theories/program_logic/adequacy.v
View file @ 25ed5c9c
......@@ -73,7 +73,7 @@ Notation wptp s t := ([∗ list] ef ∈ t, WP ef @ s; ⊤ {{ _, True }})%I.
Lemma wp_step s E e1 σ1 κ κs e2 σ2 efs Φ :
prim_step e1 σ1 κ e2 σ2 efs →
world' E σ1 (cons_obs κ κs) ∗ WP e1 @ s; E {{ Φ }}
world' E σ1 (κ ++ κs) ∗ WP e1 @ s; E {{ Φ }}
==∗ ▷ |==> ◇ (world' E σ2 κs ∗ WP e2 @ s; E {{ Φ }} ∗ wptp s efs).
Proof.
rewrite {1}wp_unfold /wp_pre. iIntros (?) "[(Hw & HE & Hσ) H]".
......@@ -85,7 +85,7 @@ Qed.
Lemma wptp_step s e1 t1 t2 κ κs σ1 σ2 Φ :
step (e1 :: t1,σ1) κ (t2, σ2) →
world σ1 (cons_obs κ κs) ∗ WP e1 @ s; ⊤ {{ Φ }} ∗ wptp s t1
world σ1 (κ ++ κs) ∗ WP e1 @ s; ⊤ {{ Φ }} ∗ wptp s t1
==∗ ∃ e2 t2',
⌜t2 = e2 :: t2'⌝ ∗ ▷ |==> ◇ (world σ2 κs ∗ WP e2 @ s; ⊤ {{ Φ }} ∗ wptp s t2').
Proof.
......@@ -107,7 +107,7 @@ Proof.
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. }
iIntros (Hsteps) "H". inversion_clear Hsteps as [|?? [t1' σ1']].
rewrite /cons_obs. rewrite <- app_assoc.
rewrite <- app_assoc.
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.
......@@ -145,7 +145,7 @@ Proof.
rewrite wp_unfold /wp_pre. iIntros "(Hw&HE&Hσ) H".
destruct (to_val e) as [v|] eqn:?.
{ iIntros "!> !> !%". left. by exists v. }
rewrite uPred_fupd_eq. iMod ("H" $! _ None with "Hσ [-]") as ">(?&?&%&?)"; first by iFrame.
rewrite uPred_fupd_eq. iMod ("H" $! _ [] with "Hσ [-]") as ">(?&?&%&?)"; first by iFrame.
iIntros "!> !> !%". by right.
Qed.
......
theories/program_logic/ectx_language.v
View file @ 25ed5c9c
......@@ -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 → list 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 → list observation → expr → state → list expr → Prop;
ectx_language_mixin :
EctxLanguageMixin of_val to_val empty_ectx comp_ectx fill head_step
......@@ -100,7 +100,7 @@ Section ectx_language.
Definition head_reducible (e : expr Λ) (σ : state Λ) :=
∃ κ e' σ' efs, head_step e σ κ e' σ' efs.
Definition head_reducible_no_obs (e : expr Λ) (σ : state Λ) :=
∃ e' σ' efs, head_step e σ None e' σ' efs.
∃ e' σ' efs, head_step e σ [] e' σ' efs.
Definition head_irreducible (e : expr Λ) (σ : state Λ) :=
∀ κ e' σ' efs, ¬head_step e σ κ e' σ' efs.
Definition head_stuck (e : expr Λ) (σ : state Λ) :=
......@@ -111,7 +111,7 @@ Section ectx_language.
Definition sub_redexes_are_values (e : expr Λ) :=
∀ K e', e = fill K e' → to_val e' = None → K = empty_ectx.
Inductive prim_step (e1 : expr Λ) (σ1 : state Λ) (κ : option (observation Λ))
Inductive prim_step (e1 : expr Λ) (σ1 : state Λ) (κ : list (observation Λ))
(e2 : expr Λ) (σ2 : state Λ) (efs : list (expr Λ)) : Prop :=
Ectx_step K e1' e2' :
e1 = fill K e1' → e2 = fill K e2' →
......@@ -217,7 +217,7 @@ Section ectx_language.
Record pure_head_step (e1 e2 : expr Λ) := {
pure_head_step_safe σ1 : head_reducible_no_obs e1 σ1;
pure_head_step_det σ1 κ e2' σ2 efs :
head_step e1 σ1 κ e2' σ2 efs → κ = None ∧ σ1 = σ2 ∧ e2 = e2' ∧ efs = []
head_step e1 σ1 κ e2' σ2 efs → κ = [] ∧ σ1 = σ2 ∧ e2 = e2' ∧ efs = []
}.
Lemma pure_head_step_pure_step e1 e2 : pure_head_step e1 e2 → pure_step e1 e2.
......
theories/program_logic/ectx_lifting.v
View file @ 25ed5c9c
......@@ -16,7 +16,7 @@ Hint Resolve head_stuck_stuck.
Lemma wp_lift_head_step_fupd {s E Φ} e1 :
to_val e1 = None →
(∀ σ1 κ κs, state_interp σ1 (cons_obs κ κs) ={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 ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
......@@ -30,7 +30,7 @@ Qed.
Lemma wp_lift_head_step {s E Φ} e1 :
to_val e1 = None →
(∀ σ1 κ κs, state_interp σ1 (cons_obs κ κs) ={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 ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
......@@ -52,7 +52,7 @@ 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 → κ = [] ∧ σ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 {{ Φ }}.
......@@ -76,7 +76,7 @@ Qed.
Lemma wp_lift_atomic_head_step_fupd {s E1 E2 Φ} e1 :
to_val e1 = None →
(∀ σ1 κ κs, state_interp σ1 (cons_obs κ κs) ={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 ∗
......@@ -91,7 +91,7 @@ Qed.
Lemma wp_lift_atomic_head_step {s E Φ} e1 :
to_val e1 = None →
(∀ σ1 κ κs, state_interp σ1 (cons_obs κ κs) ={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 ∗
......@@ -106,7 +106,7 @@ Qed.
Lemma wp_lift_atomic__head_step_no_fork_fupd {s E1 E2 Φ} e1 :
to_val e1 = None →
(∀ σ1 κ κs, state_interp σ1 (cons_obs κ κs) ={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 κs ∗ from_option Φ False (to_val e2))
......@@ -121,7 +121,7 @@ Qed.
Lemma wp_lift_atomic_head_step_no_fork {s E Φ} e1 :
to_val e1 = None →
(∀ σ1 κ κs, state_interp σ1 (cons_obs κ κs) ={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 κs ∗ from_option Φ False (to_val e2))
......@@ -136,7 +136,7 @@ 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' → κ = [] ∧ σ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.
......@@ -148,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' → κ = [] ∧ σ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.
......@@ -159,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' → κ = [] ∧ σ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 //.
......
theories/program_logic/ectxi_language.v
View file @ 25ed5c9c
......@@ -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 → list 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 → list observation → expr → state → list expr → Prop;
ectxi_language_mixin :
EctxiLanguageMixin of_val to_val fill_item head_step
......
theories/program_logic/language.v
View file @ 25ed5c9c
......@@ -8,7 +8,7 @@ Section language_mixin.
(** We annotate the reduction relation with observations [κ], which we will
use in the definition of weakest preconditions to predict future
observations and assert correctness of the predictions. *)
Context (prim_step : expr → state → option observation → expr → state → list expr → Prop).
Context (prim_step : expr → state → list observation → expr → state → list expr → Prop).
Record LanguageMixin := {
mixin_to_of_val v : to_val (of_val v) = Some v;
......@@ -24,7 +24,7 @@ Structure language := Language {
observation : Type;
of_val : val → expr;
to_val : expr → option val;
prim_step : expr → state → option observation → expr → state → list expr → Prop;
prim_step : expr → state → list observation → expr → state → list expr → Prop;
language_mixin : LanguageMixin of_val to_val prim_step
}.
Delimit Scope expr_scope with E.
......@@ -75,7 +75,7 @@ Section language.
∃ κ e' σ' efs, prim_step e σ κ e' σ' efs.
(* Total WP only permits reductions without observations *)
Definition reducible_no_obs (e : expr Λ) (σ : state Λ) :=
∃ e' σ' efs, prim_step e σ None e' σ' efs.
∃ e' σ' efs, prim_step e σ [] e' σ' efs.
Definition irreducible (e : expr Λ) (σ : state Λ) :=
∀ κ e' σ' efs, ¬prim_step e σ κ e' σ' efs.
Definition stuck (e : expr Λ) (σ : state Λ) :=
......@@ -97,7 +97,7 @@ Section language.
prim_step e σ κ e' σ' efs →
if a is WeaklyAtomic then irreducible e' σ' else is_Some (to_val e').
Inductive step (ρ1 : cfg Λ) (κ : option (observation Λ)) (ρ2 : cfg Λ) : Prop :=
Inductive step (ρ1 : cfg Λ) (κ : list (observation Λ)) (ρ2 : cfg Λ) : Prop :=
| step_atomic e1 σ1 e2 σ2 efs t1 t2 :
ρ1 = (t1 ++ e1 :: t2, σ1) →
ρ2 = (t1 ++ e2 :: t2 ++ efs, σ2) →
......@@ -105,17 +105,13 @@ Section language.
step ρ1 κ ρ2.
Hint Constructors step.
(* 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 (cons_obs κ κs) ρ3.
nsteps (S n) ρ1 (κ ++ κs) ρ3.
Hint Constructors nsteps.
Definition erased_step (ρ1 ρ2 : cfg Λ) := ∃ κ, step ρ1 κ ρ2.
......@@ -180,7 +176,7 @@ Section language.
Record pure_step (e1 e2 : expr Λ) := {
pure_step_safe σ1 : reducible_no_obs e1 σ1;
pure_step_det σ1 κ e2' σ2 efs :
prim_step e1 σ1 κ e2' σ2 efs → κ = None ∧ σ1 = σ2 ∧ e2 = e2' ∧ efs = []
prim_step e1 σ1 κ e2' σ2 efs → κ = [] ∧ σ1 = σ2 ∧ e2 = e2' ∧ efs = []
}.
(* TODO: Exclude the case of [n=0], either here, or in [wp_pure] to avoid it
......
theories/program_logic/lifting.v
View file @ 25ed5c9c
......@@ -15,7 +15,7 @@ Hint Resolve reducible_no_obs_reducible.
Lemma wp_lift_step_fupd s E Φ e1 :
to_val e1 = None →
(∀ σ1 κ κs, state_interp σ1 (cons_obs κ κs) ={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 κs ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
......@@ -39,7 +39,7 @@ Qed.
(** Derived lifting lemmas. *)
Lemma wp_lift_step s E Φ e1 :
to_val e1 = None →
(∀ σ1 κ κs, state_interp σ1 (cons_obs κ κs) ={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 κs ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
......@@ -51,7 +51,7 @@ Qed.
Lemma wp_lift_pure_step `{Inhabited (state Λ)} s E E' Φ e1 :
(∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
(∀ κ σ1 e2 σ2 efs, prim_step e1 σ1 κ e2 σ2 efs → κ = None ∧ σ1 = σ2) →
(∀ κ σ1 e2 σ2 efs, prim_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ1 = σ2) →
(|={E,E'}▷=> ∀ κ e2 efs σ, ⌜prim_step e1 σ κ e2 σ efs⌝ →
WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
⊢ WP e1 @ s; E {{ Φ }}.
......@@ -82,7 +82,7 @@ Qed.
use the generic lemmas here. *)
Lemma wp_lift_atomic_step_fupd {s E1 E2 Φ} e1 :
to_val e1 = None →
(∀ σ1 κ κs, state_interp σ1 (cons_obs κ κs) ={E1}=∗
(∀ σ1 κ κs, state_interp σ1 (κ ++ κs) ={E1}=∗
⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗
∀ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ ={E1,E2}▷=∗
state_interp σ2 κs ∗
......@@ -102,7 +102,7 @@ Qed.
Lemma wp_lift_atomic_step {s E Φ} e1 :
to_val e1 = None →
(∀ σ1 κ κs, state_interp σ1 (cons_obs κ κs) ={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 κs ∗
......@@ -117,7 +117,7 @@ Qed.
Lemma wp_lift_pure_det_step `{Inhabited (state Λ)} {s E E' Φ} e1 e2 efs :
(∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
(∀ σ1 κ e2' σ2 efs', prim_step e1 σ1 κ e2' σ2 efs' → κ = None ∧ σ1 = σ2 ∧ e2 = e2' ∧ efs = efs')→
(∀ σ1 κ e2' σ2 efs', prim_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ1 = σ2 ∧ e2 = e2' ∧ efs = efs')→
(|={E,E'}▷=> WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
⊢ WP e1 @ s; E {{ Φ }}.
Proof.
......
theories/program_logic/ownp.v
View file @ 25ed5c9c
......@@ -118,7 +118,7 @@ Section lifting.
Lemma ownP_lift_step s E Φ e1 :
(|={E,∅}=> ∃ σ1 κs, ⌜if s is NotStuck then reducible e1 σ1 else to_val e1 = None⌝ ∗
▷ ownP_state σ1 ∗ ▷ ownP_obs κs ∗
▷ ∀ κ κs' e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs ∧ κs = cons_obs κ κs'⌝ -∗
▷ ∀ κ κs' e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs ∧ κs = κ ++ κs'⌝ -∗
ownP_state σ2 ∗ ownP_obs κs'
={∅,E}=∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
⊢ WP e1 @ s; E {{ Φ }}.
......@@ -158,7 +158,7 @@ Section lifting.
Lemma ownP_lift_pure_step `{Inhabited (state Λ)} s E Φ e1 :
(∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
(∀ σ1 κ e2 σ2 efs, prim_step e1 σ1 κ e2 σ2 efs → κ = None ∧ σ1 = σ2) →
(∀ σ1 κ e2 σ2 efs, prim_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ1 = σ2) →
(▷ ∀ κ e2 efs σ, ⌜prim_step e1 σ κ e2 σ efs⌝ →
WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
⊢ WP e1 @ s; E {{ Φ }}.
......@@ -176,7 +176,7 @@ Section lifting.
Lemma ownP_lift_atomic_step {s E Φ} e1 σ1 κs :
(if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
(▷ (ownP_state σ1 ∗ ownP_obs κs) ∗
▷ ∀ κ κs' e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs ∧ κs = cons_obs κ κs'⌝ -∗
▷ ∀ κ κs' e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs ∧ κs = κ ++ κs'⌝ -∗
ownP_state σ2 -∗ ownP_obs κs' -∗
from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
⊢ WP e1 @ s; E {{ Φ }}.
......@@ -194,7 +194,7 @@ Section lifting.
(if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
(∀ κ' e2' σ2' efs', prim_step e1 σ1 κ' e2' σ2' efs' →
κ = κ' ∧ σ2 = σ2' ∧ to_val e2' = Some v2 ∧ efs = efs') →
▷ (ownP_state σ1 ∗ ownP_obs (cons_obs κ κs)) ∗ ▷ (ownP_state σ2 -∗ ownP_obs κs -∗
▷ (ownP_state σ1 ∗ ownP_obs (κ ++ κs)) ∗ ▷ (ownP_state σ2 -∗ ownP_obs κs -∗
Φ v2 ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
⊢ WP e1 @ s; E {{ Φ }}.
Proof.
......@@ -208,7 +208,7 @@ Section lifting.
(if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
(∀ κ' e2' σ2' efs', prim_step e1 σ1 κ' e2' σ2' efs' →
κ = κ' ∧ σ2 = σ2' ∧ to_val e2' = Some v2 ∧ [] = efs') →
{{{ ▷ (ownP_state σ1 ∗ ownP_obs (cons_obs κ κs)) }}} e1 @ s; E {{{ RET v2; ownP_state σ2 ∗ ownP_obs κs}}}.
{{{ ▷ (ownP_state σ1 ∗ ownP_obs (κ ++ κs)) }}} e1 @ s; E {{{ RET v2; ownP_state σ2 ∗ ownP_obs κs}}}.
Proof.
intros. rewrite -(ownP_lift_atomic_det_step σ1 κ κs v2 σ2 []); [|done..].
rewrite big_sepL_nil right_id. apply bi.wand_intro_r. iIntros "[Hs Hs']".
......@@ -217,7 +217,7 @@ Section lifting.
Lemma ownP_lift_pure_det_step `{Inhabited (state Λ)} {s E Φ} e1 e2 efs :
(∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
(∀ σ1 κ e2' σ2 efs', prim_step e1 σ1 κ e2' σ2 efs' → κ = None ∧ σ1 = σ2 ∧ e2 = e2' ∧ efs = efs')→
(∀ σ1 κ e2' σ2 efs', prim_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ1 = σ2 ∧ e2 = e2' ∧ efs = efs')→
▷ (WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤{{ _, True }})
⊢ WP e1 @ s; E {{ Φ }}.
Proof.
......@@ -227,7 +227,7 @@ Section lifting.
Lemma ownP_lift_pure_det_step_no_fork `{Inhabited (state Λ)} {s E Φ} e1 e2 :
(∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
(∀ σ1 κ e2' σ2 efs', prim_step e1 σ1 κ e2' σ2 efs' → κ = None ∧ σ1 = σ2 ∧ e2 = e2' ∧ [] = efs') →
(∀ σ1 κ e2' σ2 efs', prim_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ1 = σ2 ∧ e2 = e2' ∧ [] = efs') →
▷ WP e2 @ s; E {{ Φ }} ⊢ WP e1 @ s; E {{ Φ }}.
Proof.
intros. rewrite -(wp_lift_pure_det_step e1 e2 []) ?big_sepL_nil ?right_id; eauto.
......@@ -246,7 +246,7 @@ Section ectx_lifting.
Lemma ownP_lift_head_step s E Φ e1 :
(|={E,∅}=> ∃ σ1 κs, ⌜head_reducible e1 σ1⌝ ∗ ▷ (ownP_state σ1 ∗ ownP_obs κs) ∗
▷ ∀ κ κs' e2 σ2 efs, ⌜head_step e1 σ1