|
|
From iris.prelude Require Import options.
|
|
|
From iris.proofmode Require Import tactics.
|
|
|
From iris.heap_lang Require Import lang notation.
|
|
|
From iris.base_logic Require Export invariants.
|
|
|
From semantics.pl.heap_lang Require Export primitive_laws_nolater.
|
|
|
From semantics.pl.heap_lang Require Import adequacy proofmode.
|
|
|
|
|
|
|
|
|
Module hoare.
|
|
|
(* We make "ghost_state" an axiom for now to simplify the Coq development.
|
|
|
In the future, we will quantify over it. *)
|
|
|
Axiom ghost_state: heapGS heapΣ.
|
|
|
#[export] Existing Instance ghost_state.
|
|
|
|
|
|
(* the type of preconditions and postconditions *)
|
|
|
Notation iProp := (iProp heapΣ).
|
|
|
Implicit Types
|
|
|
(P Q R: iProp)
|
|
|
(φ ψ: Prop)
|
|
|
(e: expr)
|
|
|
(v: val).
|
|
|
|
|
|
Lemma ent_equiv P Q :
|
|
|
(P ⊣⊢ Q) ↔ (P ⊢ Q) ∧ (Q ⊢ P).
|
|
|
Proof. apply bi.equiv_entails. Qed.
|
|
|
|
|
|
(* Rules for entailment *)
|
|
|
Lemma ent_refl P:
|
|
|
P ⊢ P.
|
|
|
Proof. eauto. Qed.
|
|
|
|
|
|
Lemma ent_trans P Q R:
|
|
|
(P ⊢ Q) → (Q ⊢ R) → (P ⊢ R).
|
|
|
Proof. by intros ->. Qed.
|
|
|
|
|
|
(* NOTE: True = ⌜True⌝ *)
|
|
|
|
|
|
(* NOTE: False = ⌜False⌝ *)
|
|
|
|
|
|
Lemma ent_prove_pure P φ:
|
|
|
φ → P ⊢ ⌜φ⌝.
|
|
|
Proof. eauto. Qed.
|
|
|
|
|
|
Lemma ent_assume_pure P Q φ:
|
|
|
(P ⊢ ⌜φ⌝) →
|
|
|
(φ → P ⊢ Q) →
|
|
|
P ⊢ Q.
|
|
|
Proof.
|
|
|
iIntros (Hent Hpost) "P". iPoseProof (Hent with "P") as "%".
|
|
|
by iApply Hpost.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_and_elim_r P Q :
|
|
|
P ∧ Q ⊢ Q.
|
|
|
Proof.
|
|
|
iIntros "[_ $]".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_and_elim_l P Q :
|
|
|
P ∧ Q ⊢ P.
|
|
|
Proof.
|
|
|
iIntros "[$ _ ]".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_and_intro P Q R :
|
|
|
(P ⊢ Q) →
|
|
|
(P ⊢ R) →
|
|
|
P ⊢ Q ∧ R.
|
|
|
Proof.
|
|
|
iIntros (HQ HR) "HP". iSplit.
|
|
|
+ by iApply HQ.
|
|
|
+ by iApply HR.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_or_introl P Q :
|
|
|
P ⊢ P ∨ Q.
|
|
|
Proof. eauto. Qed.
|
|
|
|
|
|
Lemma ent_or_intror P Q :
|
|
|
Q ⊢ P ∨ Q.
|
|
|
Proof. eauto. Qed.
|
|
|
|
|
|
Lemma ent_or_elim P Q R :
|
|
|
(P ⊢ R) →
|
|
|
(Q ⊢ R) →
|
|
|
P ∨ Q ⊢ R.
|
|
|
Proof.
|
|
|
iIntros (HP HQ) "[HP | HQ]"; [by iApply HP | by iApply HQ].
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_all_intro {X} P Φ :
|
|
|
(∀ x : X, P ⊢ Φ x) →
|
|
|
P ⊢ ∀ x : X, Φ x.
|
|
|
Proof.
|
|
|
iIntros (Hx) "HP". iIntros(x).
|
|
|
by iApply Hx.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_all_elim {X} (x : X) (Φ : _ → iProp) :
|
|
|
(∀ x, Φ x) ⊢ Φ x.
|
|
|
Proof. eauto. Qed.
|
|
|
|
|
|
Lemma ent_exist_intro {X} (x : X) P Φ :
|
|
|
(P ⊢ Φ x) →
|
|
|
P ⊢ ∃ x, Φ x.
|
|
|
Proof.
|
|
|
iIntros (HP) "HP". iExists x. by iApply HP.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_exist_elim {X} Φ Q :
|
|
|
(∀ x : X, (Φ x ⊢ Q)) →
|
|
|
(∃ x, Φ x) ⊢ Q.
|
|
|
Proof.
|
|
|
iIntros (HQ) "(%x & Hx)". by iApply HQ.
|
|
|
Qed.
|
|
|
|
|
|
(** Separating conjunction rules *)
|
|
|
Lemma ent_sep_comm P Q:
|
|
|
P ∗ Q ⊣⊢ Q ∗ P.
|
|
|
Proof. iSplit; iIntros "[$ $]". Qed.
|
|
|
|
|
|
Lemma ent_sep_assoc P1 P2 P3:
|
|
|
P1 ∗ (P2 ∗ P3) ⊣⊢ (P1 ∗ P2) ∗ P3.
|
|
|
Proof.
|
|
|
iSplit.
|
|
|
- iIntros "[$ [$ $]]".
|
|
|
- iIntros "[[$ $] $]".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_sep_split P P' Q Q':
|
|
|
(P ⊢ Q) → (P' ⊢ Q') → (P ∗ P') ⊢ Q ∗ Q'.
|
|
|
Proof.
|
|
|
by intros -> ->.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_sep_true P :
|
|
|
P ⊢ True ∗ P.
|
|
|
Proof.
|
|
|
iIntros "$".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_sep_weaken P Q:
|
|
|
P ∗ Q ⊢ P.
|
|
|
Proof.
|
|
|
iIntros "[$ _]".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_pointsto_sep l v w :
|
|
|
l ↦ v ∗ l ↦ w ⊢ False.
|
|
|
Proof.
|
|
|
iIntros "[Ha Hb]".
|
|
|
iPoseProof (mapsto_ne with "Ha Hb") as "%Hneq".
|
|
|
done.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_exists_sep {X} (Φ : X → iProp) P :
|
|
|
(∃ x : X, Φ x) ∗ P ⊢ (∃ x : X, Φ x ∗ P).
|
|
|
Proof.
|
|
|
iIntros "((%x & Hx) & Hp)". eauto with iFrame.
|
|
|
Qed.
|
|
|
|
|
|
(** Magic wand rules *)
|
|
|
Lemma ent_wand_intro P Q R :
|
|
|
(P ∗ Q ⊢ R) →
|
|
|
(P ⊢ Q -∗ R).
|
|
|
Proof.
|
|
|
iIntros (Hr) "HP HQ". iApply Hr. iFrame.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_wand_elim P Q R :
|
|
|
(P ⊢ Q -∗ R) →
|
|
|
P ∗ Q ⊢ R.
|
|
|
Proof.
|
|
|
iIntros (Hr) "[HP HQ]". iApply (Hr with "HP HQ").
|
|
|
Qed.
|
|
|
|
|
|
|
|
|
(** Hoare rules *)
|
|
|
Implicit Types
|
|
|
(Φ Ψ: val → iProp).
|
|
|
Definition hoare P (e: expr) Φ := P ⊢ WP e {{ Φ }}.
|
|
|
|
|
|
Global Notation "{{ P } } e {{ Φ } }" := (hoare P%I e%E Φ%I)
|
|
|
(at level 20, P, e, Φ at level 200,
|
|
|
format "{{ P } } e {{ Φ } }") : stdpp_scope.
|
|
|
|
|
|
Global Notation "{{ P } } e {{ v , Q } }" := (hoare P%I e%E (λ v, Q)%I)
|
|
|
(at level 20, P, e, Q at level 200,
|
|
|
format "{{ P } } e {{ v , Q } }") : stdpp_scope.
|
|
|
|
|
|
(* Rules for Hoare triples *)
|
|
|
Lemma hoare_value v Φ:
|
|
|
{{ Φ v }} v {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros "H". by iApply wp_value.
|
|
|
Qed.
|
|
|
|
|
|
Lemma hoare_con P Q Φ Ψ e:
|
|
|
(P ⊢ Q) →
|
|
|
(∀ v, Ψ v ⊢ Φ v) →
|
|
|
{{ Q }} e {{ Ψ }} →
|
|
|
{{ P }} e {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros (Hpre Hpost Hhoare) "P".
|
|
|
iApply wp_mono; eauto.
|
|
|
iApply Hhoare. by iApply Hpre.
|
|
|
Qed.
|
|
|
|
|
|
|
|
|
Lemma hoare_bind K P Φ Ψ e:
|
|
|
{{ P }} e {{ Ψ }} →
|
|
|
(∀ v, {{ Ψ v }} fill K (Val v) {{ Φ }}) →
|
|
|
{{ P }} (fill K e) {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros (Hexpr Hctx) "P".
|
|
|
iApply wp_bind'.
|
|
|
iApply wp_mono; eauto.
|
|
|
by iApply Hexpr.
|
|
|
Qed.
|
|
|
|
|
|
Lemma hoare_pure P φ Φ e:
|
|
|
(P ⊢ ⌜φ⌝) →
|
|
|
(φ → {{ P }} e {{ Φ }}) →
|
|
|
{{ P }} e {{ Φ }}.
|
|
|
Proof.
|
|
|
intros Hent Hhoare.
|
|
|
iIntros "P". iPoseProof (Hent with "P") as "%".
|
|
|
by iApply Hhoare.
|
|
|
Qed.
|
|
|
|
|
|
Lemma hoare_exist_pre {X} (Φ : X → _) Ψ e :
|
|
|
(∀ x : X, {{ Φ x }} e {{ Ψ }}) →
|
|
|
{{ ∃ x : X, Φ x }} e {{ Ψ }}.
|
|
|
Proof.
|
|
|
iIntros (Hs) "(%x & Hx)". by iApply Hs.
|
|
|
Qed.
|
|
|
|
|
|
Lemma hoare_pure_step P Ψ e1 e2 :
|
|
|
pure_step e1 e2 →
|
|
|
{{ P }} e2 {{ Ψ }} →
|
|
|
{{ P }} e1 {{ Ψ }}.
|
|
|
Proof.
|
|
|
iIntros (Hpure He2) "HP".
|
|
|
iApply (lifting.wp_pure_step_later _ _ _ _ _ True).
|
|
|
- intros _. econstructor 2; [done | econstructor].
|
|
|
- done.
|
|
|
- iNext. iApply He2. done.
|
|
|
Qed.
|
|
|
|
|
|
Lemma hoare_pure_steps P Ψ e1 e2 :
|
|
|
rtc pure_step e1 e2 →
|
|
|
{{ P }} e2 {{ Ψ }} →
|
|
|
{{ P }} e1 {{ Ψ }}.
|
|
|
Proof.
|
|
|
induction 1; eauto using hoare_pure_step.
|
|
|
Qed.
|
|
|
|
|
|
(** Pure step rules *)
|
|
|
Lemma PureExec_1_equiv e1 e2 :
|
|
|
(∃ ϕ, ϕ ∧ PureExec ϕ 1 e1 e2) ↔
|
|
|
pure_step e1 e2.
|
|
|
Proof.
|
|
|
split.
|
|
|
- intros (ϕ & H & Hp). by specialize (Hp H) as ?%nsteps_once_inv.
|
|
|
- intros Hp. exists True. split; first done.
|
|
|
intros _. econstructor; first done. constructor.
|
|
|
Qed.
|
|
|
|
|
|
Lemma PureExec_1_elim (ϕ : Prop) e1 e2 :
|
|
|
ϕ → PureExec ϕ 1 e1 e2 →
|
|
|
pure_step e1 e2.
|
|
|
Proof.
|
|
|
intros H Hp. apply PureExec_1_equiv. eauto.
|
|
|
Qed.
|
|
|
|
|
|
Lemma pure_step_fill K (e1 e2: expr):
|
|
|
pure_step e1 e2 → pure_step (fill K e1) (fill K e2).
|
|
|
Proof.
|
|
|
intros Hp. apply PureExec_1_equiv.
|
|
|
exists True. split; first done.
|
|
|
apply pure_exec_ctx; first apply _.
|
|
|
intros _. apply nsteps_once. done.
|
|
|
Qed.
|
|
|
|
|
|
Lemma rtc_pure_step_fill K (e1 e2: expr):
|
|
|
rtc pure_step e1 e2 → rtc pure_step (fill K e1) (fill K e2).
|
|
|
Proof.
|
|
|
induction 1; first reflexivity.
|
|
|
econstructor; last done. by eapply pure_step_fill.
|
|
|
Qed.
|
|
|
Lemma pure_step_add (n m : Z) :
|
|
|
pure_step (#n + #m) (#(n + m)).
|
|
|
Proof.
|
|
|
eapply PureExec_1_elim; last apply _. done.
|
|
|
Qed.
|
|
|
Lemma pure_step_sub (n m : Z) :
|
|
|
pure_step (#n - #m) (#(n - m)).
|
|
|
Proof.
|
|
|
eapply PureExec_1_elim; last apply _. done.
|
|
|
Qed.
|
|
|
Lemma pure_step_mul (n m : Z) :
|
|
|
pure_step (#n * #m) (#(n * m)).
|
|
|
Proof.
|
|
|
eapply PureExec_1_elim; last apply _. done.
|
|
|
Qed.
|
|
|
Lemma pure_step_quot (n m : Z) :
|
|
|
m ≠ 0 → pure_step (#n `quot` #m) (#(Z.quot n m)).
|
|
|
Proof.
|
|
|
intros _. eapply PureExec_1_elim; last apply _. done.
|
|
|
Qed.
|
|
|
Lemma pure_step_eq (n m : Z) :
|
|
|
n = m → pure_step (#n = #m) #true.
|
|
|
Proof.
|
|
|
intros. eapply PureExec_1_elim; last apply _.
|
|
|
unfold bin_op_eval. simpl.
|
|
|
rewrite bool_decide_eq_true_2; subst; done.
|
|
|
Qed.
|
|
|
Lemma pure_step_neq (n m : Z) :
|
|
|
n ≠ m → pure_step (#n = #m) #false.
|
|
|
Proof.
|
|
|
intros. eapply PureExec_1_elim; last apply _.
|
|
|
unfold bin_op_eval. simpl.
|
|
|
rewrite bool_decide_eq_false_2; first done.
|
|
|
intros [= Heq]; done.
|
|
|
Qed.
|
|
|
Lemma pure_step_beta f x e v :
|
|
|
pure_step ((rec: f x := e)%V v) (subst' x v (subst' f (rec: f x := e) e)).
|
|
|
Proof.
|
|
|
eapply PureExec_1_elim; last apply _. done.
|
|
|
Qed.
|
|
|
Lemma pure_step_if_true e1 e2 :
|
|
|
pure_step (if: #true then e1 else e2) e1.
|
|
|
Proof.
|
|
|
eapply PureExec_1_elim; last apply _. done.
|
|
|
Qed.
|
|
|
Lemma pure_step_if_false e1 e2 :
|
|
|
pure_step (if: #false then e1 else e2) e2.
|
|
|
Proof.
|
|
|
eapply PureExec_1_elim; last apply _. done.
|
|
|
Qed.
|
|
|
Lemma pure_step_match_injl v x1 x2 e1 e2 :
|
|
|
pure_step (match: InjLV v with InjL x1 => e1 | InjR x2 => e2 end) ((λ: x1, e1) v).
|
|
|
Proof.
|
|
|
by eapply PureExec_1_elim; last apply _.
|
|
|
Qed.
|
|
|
Lemma pure_step_match_injr v x1 x2 e1 e2 :
|
|
|
pure_step (match: InjRV v with InjL x1 => e1 | InjR x2 => e2 end) ((λ: x2, e2) v).
|
|
|
Proof.
|
|
|
by eapply PureExec_1_elim; last apply _.
|
|
|
Qed.
|
|
|
Lemma pure_step_fst v1 v2 :
|
|
|
pure_step (Fst (v1, v2)%V) v1.
|
|
|
Proof.
|
|
|
by eapply PureExec_1_elim; last apply _.
|
|
|
Qed.
|
|
|
Lemma pure_step_snd v1 v2 :
|
|
|
pure_step (Snd (v1, v2)%V) v2.
|
|
|
Proof.
|
|
|
by eapply PureExec_1_elim; last apply _.
|
|
|
Qed.
|
|
|
|
|
|
(** In our Coq formalization, a bit of an additional effort arises due to the handling of values:
|
|
|
values are always represented using the [Val] constructor, and fully reduced expressions take an additional
|
|
|
step of computation to get to a [Val].
|
|
|
See for instance the constructors [PairS], [InjLS], [InjRS].
|
|
|
|
|
|
Therefore, we need an additional rule, [pure_step_val].
|
|
|
*)
|
|
|
Lemma pure_step_val_fun f x e :
|
|
|
rtc pure_step (rec: f x := e)%E (rec: f x := e)%V.
|
|
|
Proof.
|
|
|
eapply rtc_nsteps. exists 1. eapply pure_exec. done.
|
|
|
Qed.
|
|
|
Lemma pure_step_val_pair e1 e2 v1 v2 :
|
|
|
rtc pure_step e1 v1 →
|
|
|
rtc pure_step e2 v2 →
|
|
|
rtc pure_step (e1, e2)%E (v1, v2)%V.
|
|
|
Proof.
|
|
|
etransitivity; first etransitivity.
|
|
|
+ by eapply rtc_pure_step_fill with (K := [PairRCtx _]).
|
|
|
+ by eapply rtc_pure_step_fill with (K := [PairLCtx _]).
|
|
|
+ simpl. eapply rtc_nsteps. exists 1. eapply pure_exec. done.
|
|
|
Qed.
|
|
|
Lemma pure_step_val_injl e1 v1 :
|
|
|
rtc pure_step e1 v1 →
|
|
|
rtc pure_step (InjL e1) (InjLV v1).
|
|
|
Proof.
|
|
|
etransitivity.
|
|
|
+ by eapply rtc_pure_step_fill with (K := [InjLCtx]).
|
|
|
+ simpl. eapply rtc_nsteps. exists 1. eapply pure_exec. done.
|
|
|
Qed.
|
|
|
Lemma pure_step_val_injr e1 v1 :
|
|
|
rtc pure_step e1 v1 →
|
|
|
rtc pure_step (InjR e1) (InjRV v1).
|
|
|
Proof.
|
|
|
etransitivity.
|
|
|
+ by eapply rtc_pure_step_fill with (K := [InjRCtx]).
|
|
|
+ simpl. eapply rtc_nsteps. exists 1. eapply pure_exec. done.
|
|
|
Qed.
|
|
|
Local Hint Resolve pure_step_val_fun pure_step_val_pair pure_step_val_injl pure_step_val_injr : core.
|
|
|
|
|
|
(** For convenience: a lemma to cover all of these cases, with a precondition that
|
|
|
can be easily solved by eatuto *)
|
|
|
Inductive expr_is_val : expr → val → Prop :=
|
|
|
| expr_is_val_base v:
|
|
|
expr_is_val (Val v) v
|
|
|
| expr_is_val_fun f x e:
|
|
|
expr_is_val (rec: f x := e)%E (rec: f x := e)%V
|
|
|
| expr_is_val_pair e1 e2 v1 v2:
|
|
|
expr_is_val e1 v1 →
|
|
|
expr_is_val e2 v2 →
|
|
|
expr_is_val (e1, e2)%E (v1, v2)%V
|
|
|
| expr_is_val_inj_l e v:
|
|
|
expr_is_val e v →
|
|
|
expr_is_val (InjL e)%E (InjLV v)%V
|
|
|
| expr_is_val_inj_r e v:
|
|
|
expr_is_val e v →
|
|
|
expr_is_val (InjR e)%E (InjRV v)%V.
|
|
|
#[export]
|
|
|
Hint Constructors expr_is_val : core.
|
|
|
Lemma expr_is_val_of_val v :
|
|
|
expr_is_val (of_val v) v.
|
|
|
Proof.
|
|
|
destruct v; simpl; constructor.
|
|
|
Qed.
|
|
|
#[export]
|
|
|
Hint Resolve expr_is_val_of_val : core.
|
|
|
|
|
|
Lemma pure_step_val e v:
|
|
|
expr_is_val e v →
|
|
|
rtc pure_step e v.
|
|
|
Proof.
|
|
|
intros Hexpr. induction Hexpr; eauto. econstructor.
|
|
|
Qed.
|
|
|
|
|
|
Lemma hoare_new v :
|
|
|
{{ True }} ref v {{ w, ∃ l : loc, ⌜w = #l⌝ ∗ l ↦ v }}.
|
|
|
Proof.
|
|
|
iIntros "_". wp_alloc l as "Hl". iApply wp_value. eauto with iFrame.
|
|
|
Qed.
|
|
|
|
|
|
Lemma hoare_load l v:
|
|
|
{{ l ↦ v }} ! #l {{ w, ⌜w = v⌝ ∗ l ↦ v }}.
|
|
|
Proof.
|
|
|
iIntros "Hl". wp_load. iApply wp_value. iFrame. done.
|
|
|
Qed.
|
|
|
|
|
|
Lemma hoare_store l (v w: val):
|
|
|
{{ l ↦ v }} #l <- w {{ _, l ↦ w }}.
|
|
|
Proof.
|
|
|
iIntros "Hl". wp_store. iApply wp_value. iFrame.
|
|
|
Qed.
|
|
|
|
|
|
Lemma hoare_frame P F Φ e:
|
|
|
{{ P }} e {{ Φ }} →
|
|
|
{{ P ∗ F }} e {{ v, Φ v ∗ F }}.
|
|
|
Proof.
|
|
|
iIntros (Hhoare) "[P $]". by iApply Hhoare.
|
|
|
Qed.
|
|
|
|
|
|
(* Prevent printing of magic wands *)
|
|
|
Notation "P -∗ Q" := (bi_entails P Q) (only parsing) : stdpp_scope.
|
|
|
|
|
|
|
|
|
(** Weakest precondition rules *)
|
|
|
Lemma ent_wp_value Φ v :
|
|
|
Φ v ⊢ WP of_val v {{ w, Φ w }}.
|
|
|
Proof.
|
|
|
iIntros "Hv". by iApply wp_value.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_wp_wand' Φ Ψ e :
|
|
|
(∀ v, Φ v -∗ Ψ v) -∗ WP e {{ Φ }} -∗ WP e {{ Ψ }}.
|
|
|
Proof.
|
|
|
iIntros "Hp Hwp". iApply (wp_wand with "Hwp Hp").
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_wp_wand Φ Ψ e :
|
|
|
(∀ v, Φ v -∗ Ψ v) ∗ WP e {{ Φ }} ⊢ WP e {{ Ψ }}.
|
|
|
Proof.
|
|
|
iIntros "[Hp Hwp]". iApply (wp_wand with "Hwp Hp").
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_wp_bind e K Φ :
|
|
|
WP e {{ v, WP fill K (Val v) {{ Φ }} }} ⊢ WP fill K e {{ Φ }}.
|
|
|
Proof.
|
|
|
iApply wp_bind.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_wp_pure_step e e' Φ :
|
|
|
pure_step e e' →
|
|
|
WP e' {{ Φ }} ⊢ WP e {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros (Hpure) "Hwp". iApply (lifting.wp_pure_step_later _ _ _ _ _ True 1); last iApply "Hwp"; last done.
|
|
|
intros _. apply nsteps_once. apply Hpure.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_wp_new v Φ :
|
|
|
(∀ l : loc, l ↦ v -∗ Φ #l) ⊢ WP ref (Val v) {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros "Hs". wp_alloc l as "Hl". wp_value_head. by iApply "Hs".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_wp_load l v Φ :
|
|
|
l ↦ v ∗ (l ↦ v -∗ Φ v) ⊢ WP !#l {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros "(Hl & Hp)". wp_load. wp_value_head. by iApply "Hp".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_wp_store l v w Φ :
|
|
|
l ↦ w ∗ (l ↦ v -∗ Φ #()) ⊢ WP #l <- Val v {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros "(Hl & Hp)". wp_store. wp_value_head. by iApply "Hp".
|
|
|
Qed.
|
|
|
|
|
|
|
|
|
(** Persistency *)
|
|
|
Lemma ent_pers_dup P :
|
|
|
□ P ⊢ (□ P) ∗ (□ P).
|
|
|
Proof.
|
|
|
iIntros "#HP". eauto.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_pers_elim P :
|
|
|
□ P ⊢ P.
|
|
|
Proof.
|
|
|
iIntros "#$".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_pers_mono P Q :
|
|
|
(P ⊢ Q) →
|
|
|
□ P ⊢ □ Q.
|
|
|
Proof.
|
|
|
iIntros (HPQ) "#HP !>". by iApply HPQ.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_pers_pure (ϕ : Prop) :
|
|
|
⌜ϕ⌝ ⊢ (□ ⌜ϕ⌝ : iProp).
|
|
|
Proof.
|
|
|
iIntros "#$".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_pers_and_sep P Q :
|
|
|
(□ P) ∧ Q ⊢ (□ P) ∗ Q.
|
|
|
Proof.
|
|
|
iIntros "(#$ & $)".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_pers_idemp P :
|
|
|
□ P ⊢ □ □ P.
|
|
|
Proof.
|
|
|
iIntros "#$".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_pers_all {X} (Φ : X → iProp) :
|
|
|
(∀ x : X, □ Φ x) ⊢ □ ∀ x : X, Φ x.
|
|
|
Proof.
|
|
|
iIntros "#Hx" (x). iApply "Hx".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_pers_exists {X} (Φ : X → iProp) :
|
|
|
(□ ∃ x : X, Φ x) ⊢ ∃ x : X, □ Φ x.
|
|
|
Proof.
|
|
|
iIntros "(%x & #Hx)". iExists x. done.
|
|
|
Qed.
|
|
|
|
|
|
(** Invariants *)
|
|
|
Implicit Type
|
|
|
(F : iProp)
|
|
|
(N : namespace)
|
|
|
(E : coPset)
|
|
|
.
|
|
|
Lemma ent_inv_pers F N :
|
|
|
inv N F ⊢ □ inv N F.
|
|
|
Proof.
|
|
|
iIntros "#$".
|
|
|
Qed.
|
|
|
Lemma ent_inv_alloc F P N E e Φ :
|
|
|
(P ∗ inv N F ⊢ WP e @ E {{ Φ }}) →
|
|
|
(P ∗ F ⊢ WP e @ E {{ Φ }}).
|
|
|
Proof.
|
|
|
iIntros (Ha) "[HP HF]".
|
|
|
iMod (inv_alloc N with "HF") as "#Hinv".
|
|
|
iApply Ha. iFrame "Hinv ∗".
|
|
|
Qed.
|
|
|
Lemma inv_alloc N F E e Φ :
|
|
|
F -∗
|
|
|
(inv N F -∗ WP e @ E {{ Φ }}) -∗
|
|
|
WP e @ E {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros "HF Hs".
|
|
|
iMod (inv_alloc N with "HF") as "#Hinv".
|
|
|
by iApply "Hs".
|
|
|
Qed.
|
|
|
|
|
|
(** We require a sidecondition here, namely that [F] is "timeless". All propositions we have seen up to now are in fact timeless.
|
|
|
We will see propositions that do not satisfy this requirement and which need a stronger rule for invariants soon.
|
|
|
*)
|
|
|
Lemma ent_inv_open `{!Timeless F} P N E e Φ :
|
|
|
(P ∗ F ⊢ WP e @ (E ∖ ↑N) {{ v, F ∗ Φ v }}) →
|
|
|
↑N ⊆ E →
|
|
|
(P ∗ inv N F ⊢ WP e @ E {{ Φ }}).
|
|
|
Proof.
|
|
|
iIntros (Ha Hincl) "(HP & #Hinv)".
|
|
|
iMod (inv_acc_timeless with "Hinv") as "(HF & Hcl)"; first done.
|
|
|
iApply wp_fupd'. iApply wp_wand_r.
|
|
|
iSplitR "Hcl". { iApply Ha. iFrame. }
|
|
|
iIntros (v) "[HF Hphi]". iMod ("Hcl" with "HF"). done.
|
|
|
Qed.
|
|
|
Lemma inv_open `{!Timeless F} N E e Φ :
|
|
|
↑N ⊆ E →
|
|
|
inv N F -∗
|
|
|
(F -∗ WP e @ (E ∖ ↑N) {{ v, F ∗ Φ v }})%I -∗
|
|
|
WP e @ E {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros (Hincl) "#Hinv Hs".
|
|
|
iMod (inv_acc_timeless with "Hinv") as "(HF & Hcl)"; first done.
|
|
|
iApply wp_fupd'. iApply wp_wand_r.
|
|
|
iSplitR "Hcl". { iApply "Hs". iFrame. }
|
|
|
iIntros (v) "[HF Hphi]". iMod ("Hcl" with "HF"). done.
|
|
|
Qed.
|
|
|
|
|
|
|
|
|
(** Later *)
|
|
|
Lemma ent_later_intro P :
|
|
|
P ⊢ ▷ P.
|
|
|
Proof.
|
|
|
iIntros "$".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_later_mono P Q :
|
|
|
(P ⊢ Q) →
|
|
|
(▷ P ⊢ ▷ Q).
|
|
|
Proof.
|
|
|
iIntros (Hs) "HP!>". by iApply Hs.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_löb P :
|
|
|
(▷ P ⊢ P) →
|
|
|
True ⊢ P.
|
|
|
Proof.
|
|
|
iIntros (Hs) "_".
|
|
|
iLöb as "IH". by iApply Hs.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_later_sep P Q :
|
|
|
▷ (P ∗ Q) ⊣⊢ (▷ P) ∗ (▷ Q).
|
|
|
Proof.
|
|
|
iSplit; iIntros "[$ $]".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_later_exists `{Inhabited X} (Φ : X → iProp) :
|
|
|
(▷ (∃ x : X, Φ x)) ⊣⊢ ∃ x : X, ▷ Φ x.
|
|
|
Proof. apply bi.later_exist. Qed.
|
|
|
|
|
|
Lemma ent_later_all {X} (Φ : X → iProp) :
|
|
|
▷ (∀ x : X, Φ x) ⊣⊢ ∀ x : X, ▷ Φ x.
|
|
|
Proof. apply bi.later_forall. Qed.
|
|
|
|
|
|
Lemma ent_later_pers P :
|
|
|
▷ □ P ⊣⊢ □ ▷ P.
|
|
|
Proof.
|
|
|
iSplit; iIntros "#H !> !>"; done.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_later_wp_pure_step e e' Φ :
|
|
|
pure_step e e' →
|
|
|
▷ WP e' {{ Φ }} ⊢ WP e {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros (Hpure%PureExec_1_equiv) "Hwp".
|
|
|
destruct Hpure as (ϕ & Hphi & Hpure).
|
|
|
iApply (lifting.wp_pure_step_later _ _ _ _ _ _ 1); done.
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_later_wp_new v Φ :
|
|
|
▷ (∀ l : loc, l ↦ v -∗ Φ #l) ⊢ WP ref v {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros "Hp". wp_alloc l as "Hl". iApply wp_value. by iApply "Hp".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_later_wp_load l v Φ :
|
|
|
l ↦ v ∗ ▷ (l ↦ v -∗ Φ v) ⊢ WP ! #l {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros "[Hl Hp]". wp_load. iApply wp_value. by iApply "Hp".
|
|
|
Qed.
|
|
|
|
|
|
Lemma ent_later_wp_store l v w Φ :
|
|
|
l ↦ v ∗ ▷ (l ↦ w -∗ Φ #()) ⊢ WP #l <- w {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros "[Hl Hp]". wp_store. iApply wp_value. by iApply "Hp".
|
|
|
Qed.
|
|
|
End hoare.
|
|
|
|
|
|
Module impred_invariants.
|
|
|
Import hoare.
|
|
|
Implicit Type
|
|
|
(F : iProp)
|
|
|
(N : namespace)
|
|
|
(E : coPset)
|
|
|
.
|
|
|
|
|
|
Lemma ent_inv_open P F N E e Φ :
|
|
|
(P ∗ ▷ F ⊢ WP e @ (E ∖ ↑N) {{ v, ▷ F ∗ Φ v }}) →
|
|
|
↑N ⊆ E →
|
|
|
(P ∗ inv N F ⊢ WP e @ E {{ Φ }}).
|
|
|
Proof.
|
|
|
iIntros (Ha Hincl) "(HP & #Hinv)".
|
|
|
iMod (inv_acc with "Hinv") as "(HF & Hcl)"; first done.
|
|
|
iApply wp_fupd'. iApply wp_wand_r.
|
|
|
iSplitR "Hcl". { iApply Ha. iFrame. }
|
|
|
iIntros (v) "[HF Hphi]". iMod ("Hcl" with "HF"). done.
|
|
|
Qed.
|
|
|
Lemma inv_open N E F e Φ :
|
|
|
↑N ⊆ E →
|
|
|
inv N F -∗
|
|
|
(▷ F -∗ WP e @ (E ∖ ↑N) {{ v, ▷ F ∗ Φ v }})%I -∗
|
|
|
WP e @ E {{ Φ }}.
|
|
|
Proof.
|
|
|
iIntros (Hincl) "#Hinv Hs".
|
|
|
iMod (inv_acc with "Hinv") as "(HF & Hcl)"; first done.
|
|
|
iApply wp_fupd'. iApply wp_wand_r.
|
|
|
iSplitR "Hcl". { iApply "Hs". iFrame. }
|
|
|
iIntros (v) "[HF Hphi]". iMod ("Hcl" with "HF"). done.
|
|
|
Qed.
|
|
|
End impred_invariants.
|