Skip to content

GitLab

Commit bfa32cfe authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files
Options

Rename stuff to be consistent with the paper.

parent 81137d7c
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 659 additions and 659 deletions
theories/c_translation/monad.v
View file @ bfa32cfe
......@@ -7,27 +7,27 @@ From iris_c.lib Require Import mset flock.
(* M A := ref (list loc) → Mutex → A *)
(* A → M A *)
Definition a_ret : val := λ: "a" <> <>, "a".
Definition c_ret : val := λ: "a" <> <>, "a".
(* (A → M B) → M A → M B *)
Definition a_bind : val := λ: "x" "f" "env" "l",
Definition c_bind : val := λ: "x" "f" "env" "l",
let: "a" := "x" "env" "l" in
"f" "a" "env" "l".
Notation "x ←ᶜ y ;;ᶜ z" :=
(a_bind y (λ: x, z))%E
(c_bind y (λ: x, z))%E
(at level 100, y at next level, z at level 200, right associativity) : expr_scope.
Notation "y ;;ᶜ z" := (a_bind y (λ: <>, z))%E
Notation "y ;;ᶜ z" := (c_bind y (λ: <>, z))%E
(at level 100, z at level 200, right associativity) : expr_scope.
(* M A → A *)
Definition a_run : val := λ: "x",
Definition c_run : val := λ: "x",
let: "env" := mset_create #() in
let: "l" := newlock #() in
"x" "env" "l".
(* M A → M A *)
Definition a_atomic : val := λ: "x" "env" "l",
Definition c_atomic : val := λ: "x" "env" "l",
acquire "l";;
let: "k" := newlock #() in
let: "a" := "x" #() "env" "k" in
......@@ -35,28 +35,28 @@ Definition a_atomic : val := λ: "x" "env" "l",
"a".
(* (ref (list loc) → A) → M A *)
Definition a_atomic_env : val := λ: "f" "env" "l",
Definition c_atomic_env : val := λ: "f" "env" "l",
acquire "l";;
let: "a" := "f" "env" in
release "l";;
"a".
(* M A → M B → M (A * B) *)
Definition a_par : val := λ: "x" "y" "env" "l",
Definition c_par : val := λ: "x" "y" "env" "l",
"x" "env" "l" ||| "y" "env" "l".
Notation "e1 |||ᶜ e2" := (a_par e1 e2)%E (at level 50) : expr_scope.
Notation "e1 |||ᶜ e2" := (c_par e1 e2)%E (at level 50) : expr_scope.
Definition amonadN := nroot .@ "amonad".
Definition cmonadN := nroot .@ "amonad".
Class amonadG (Σ : gFunctors) := AMonadG {
Class cmonadG (Σ : gFunctors) := AMonadG {
aheapG :> heapG Σ;
aflockG :> flockG Σ;
alocking_heapG :> locking_heapG Σ;
aspawnG :> spawnG Σ
}.
Section a_wp.
Context `{amonadG Σ}.
Section cwp.
Context `{cmonadG Σ}.
Definition env_inv (env : val) : iProp Σ :=
(∃ (X : gset val) (σ : gmap cloc (lvl * val)),
......@@ -65,70 +65,70 @@ Section a_wp.
full_locking_heap σ)%I.
Definition flock_resources (γ : flock_name) (I : gmap prop_id lock_res) :=
([∗ map] i ↦ X ∈ I, flock_res amonadN γ i X)%I.
([∗ map] i ↦ X ∈ I, flock_res cmonadN γ i X)%I.
(** DF: The outer `WP` here is needed to be able to perform some reductions inside a heap_lang context.
Without this, the `a_wp_awp` rule is not provable.
Without this, the `cwp_cwp` rule is not provable.
My intuitive explanation: we want to preform some reductions to `e` until it is actually a value that is a monadic computation.
In some sense it is a form of CPSing on a logical level.
But I still cannot precisely state why is it needed.
*)
Definition awp_def (e : expr)
Definition cwp_def (e : expr)
(R : iProp Σ) (Φ : val → iProp Σ) : iProp Σ :=
WP e {{ ev,
∀ (γ : flock_name) (env : val) (l : val) (I : gmap prop_id lock_res),
is_flock amonadN γ l -∗
is_flock cmonadN γ l -∗
flock_resources γ I -∗
([∗ map] X ∈ I, res_prop X) ≡ (env_inv env ∗ R) -∗
WP ev env l {{ v, Φ v ∗ flock_resources γ I }}
}}%I.
Definition awp_aux : seal (@awp_def). by eexists. Qed.
Definition awp := unseal awp_aux.
Definition awp_eq : @awp = @awp_def := seal_eq awp_aux.
End a_wp.
Definition cwp_aux : seal (@cwp_def). by eexists. Qed.
Definition cwp := unseal cwp_aux.
Definition cwp_eq : @cwp = @cwp_def := seal_eq cwp_aux.
End cwp.
Notation "'AWP' e @ R {{ Φ } }" := (awp e%E R%I Φ)
Notation "'CWP' e @ R {{ Φ } }" := (cwp e%E R%I Φ)
(at level 20, e, Φ at level 200, only parsing) : bi_scope.
Notation "'AWP' e {{ Φ } }" := (awp e%E True%I Φ)
Notation "'CWP' e {{ Φ } }" := (cwp e%E True%I Φ)
(at level 20, e, Φ at level 200, only parsing) : bi_scope.
Notation "'AWP' e @ R {{ v , Q } }" := (awp e%E R%I (λ v, Q))
Notation "'CWP' e @ R {{ v , Q } }" := (cwp e%E R%I (λ v, Q))
(at level 20, e, Q at level 200,
format "'[' 'AWP' e '/' '[ ' @ R {{ v , Q } } ']' ']'") : bi_scope.
Notation "'AWP' e {{ v , Q } }" := (awp e%E True%I (λ v, Q))
format "'[' 'CWP' e '/' '[ ' @ R {{ v , Q } } ']' ']'") : bi_scope.
Notation "'CWP' e {{ v , Q } }" := (cwp e%E True%I (λ v, Q))
(at level 20, e, Q at level 200,
format "'[' 'AWP' e '/' '[ ' {{ v , Q } } ']' ']'") : bi_scope.
format "'[' 'CWP' e '/' '[ ' {{ v , Q } } ']' ']'") : bi_scope.
Section a_wp_rules.
Context `{amonadG Σ}.
Section cwp_rules.
Context `{cmonadG Σ}.
Lemma a_wp_awp R Φ Ψ e :
AWP e @ R {{ Φ }} -∗
(∀ v : val, AWP v @ R {{ Φ }} -∗ Ψ v) -∗
Lemma cwp_wp R Φ Ψ e :
CWP e @ R {{ Φ }} -∗
(∀ v : val, CWP v @ R {{ Φ }} -∗ Ψ v) -∗
WP e {{ Ψ }}.
Proof.
iIntros "Hwp H". rewrite awp_eq /=. iApply (wp_wand with "Hwp").
iIntros "Hwp H". rewrite cwp_eq /=. iApply (wp_wand with "Hwp").
iIntros (v) "Hwp". iApply "H". by iApply wp_value'.
Qed.
Lemma wp_awp_bind R Φ K e :
WP e {{ v, AWP (fill K (of_val v)) @ R {{ Φ }} }} -∗
AWP fill K e @ R {{ Φ }}.
Proof. rewrite awp_eq. by apply: wp_bind. Qed.
Lemma wp_cwp_bind R Φ K e :
WP e {{ v, CWP (fill K (of_val v)) @ R {{ Φ }} }} -∗
CWP fill K e @ R {{ Φ }}.
Proof. rewrite cwp_eq. by apply: wp_bind. Qed.
Lemma wp_awp_bind_inv R Φ K e :
AWP fill K e @ R {{ Φ }} -∗
WP e {{ v, AWP fill K (of_val v) @ R {{ Φ }} }}.
Proof. rewrite awp_eq. by apply: wp_bind_inv. Qed.
Lemma wp_cwp_bind_inv R Φ K e :
CWP fill K e @ R {{ Φ }} -∗
WP e {{ v, CWP fill K (of_val v) @ R {{ Φ }} }}.
Proof. rewrite cwp_eq. by apply: wp_bind_inv. Qed.
Lemma awp_insert_res e Φ R1 R2 :
Lemma cwp_insert_res e Φ R1 R2 :
▷ R1 -∗
AWP e @ (R1 ∗ R2) {{ v, ▷ R1 ={⊤}=∗ Φ v }} -∗
AWP e @ R2 {{ Φ }}.
CWP e @ (R1 ∗ R2) {{ v, ▷ R1 ={⊤}=∗ Φ v }} -∗
CWP e @ R2 {{ Φ }}.
Proof.
iIntros "HR1 Hawp". rewrite awp_eq.
iApply (wp_wand with "Hawp").
iIntros "HR1 Hcwp". rewrite cwp_eq.
iApply (wp_wand with "Hcwp").
iIntros (v) "HΦ".
iIntros (γ env l I) "#Hflock Hres #Heq".
iMod (flock_res_alloc_strong _ (dom (gset prop_id) I) with "Hflock HR1") as (j ρ) "[% Hres']"; first done.
......@@ -149,58 +149,58 @@ Section a_wp_rules.
by iApply "HΦ".
Qed.
Lemma awp_fupd_wand e Φ Ψ R :
AWP e @ R {{ Φ }} -∗
Lemma cwp_fupd_wand e Φ Ψ R :
CWP e @ R {{ Φ }} -∗
(∀ v, Φ v ={⊤}=∗ Ψ v) -∗
AWP e @ R {{ Ψ }}.
CWP e @ R {{ Ψ }}.
Proof.
iIntros "Hwp H". rewrite awp_eq.
iIntros "Hwp H". rewrite cwp_eq.
iApply (wp_wand with "Hwp"); iIntros (v) "HΦ".
iIntros (γ env l I) "#Hflock Hres #Heq". iApply wp_fupd.
iApply (wp_wand with "[HΦ Hres]"). iApply ("HΦ" with "Hflock Hres Heq").
iIntros (w) "[HΦ $]". by iApply "H".
Qed.
Lemma awp_fupd e Φ R :
AWP e @ R {{ v, |={⊤}=> Φ v }} -∗ AWP e @ R {{ Φ }}.
Proof. iIntros "Hwp". iApply (awp_fupd_wand with "Hwp"); auto. Qed.
Lemma cwp_fupd e Φ R :
CWP e @ R {{ v, |={⊤}=> Φ v }} -∗ CWP e @ R {{ Φ }}.
Proof. iIntros "Hwp". iApply (cwp_fupd_wand with "Hwp"); auto. Qed.
Lemma fupd_awp e Φ R :
(|={⊤}=> AWP e @ R {{ v, Φ v }}) -∗ AWP e @ R {{ Φ }}.
Proof. rewrite awp_eq. by iIntros ">Hwp". Qed.
Lemma fupd_cwp e Φ R :
(|={⊤}=> CWP e @ R {{ v, Φ v }}) -∗ CWP e @ R {{ Φ }}.
Proof. rewrite cwp_eq. by iIntros ">Hwp". Qed.
Lemma awp_wand e Φ Ψ R :
AWP e @ R {{ Φ }} -∗
Lemma cwp_wand e Φ Ψ R :
CWP e @ R {{ Φ }} -∗
(∀ v, Φ v -∗ Ψ v) -∗
AWP e @ R {{ Ψ }}.
CWP e @ R {{ Ψ }}.
Proof.
iIntros "Hwp H". iApply (awp_fupd_wand with "Hwp"); iIntros (v) "HΦ !>".
iIntros "Hwp H". iApply (cwp_fupd_wand with "Hwp"); iIntros (v) "HΦ !>".
by iApply "H".
Qed.
Lemma awp_pure K φ n e1 e2 R Φ :
Lemma cwp_pure K φ n e1 e2 R Φ :
PureExec φ n e1 e2 →
φ →
▷^n AWP (fill K e2) @ R {{ Φ }} -∗
AWP (fill K e1) @ R {{ Φ }}.
▷^n CWP (fill K e2) @ R {{ Φ }} -∗
CWP (fill K e1) @ R {{ Φ }}.
Proof.
iIntros (? Hφ) "Hawp". iApply wp_awp_bind. wp_pure _.
by iApply wp_awp_bind_inv.
iIntros (? Hφ) "Hcwp". iApply wp_cwp_bind. wp_pure _.
by iApply wp_cwp_bind_inv.
Qed.
Lemma awp_ret e R Φ :
WP e {{ Φ }} -∗ AWP a_ret e @ R {{ Φ }}.
Lemma cwp_ret e R Φ :
WP e {{ Φ }} -∗ CWP c_ret e @ R {{ Φ }}.
Proof.
iIntros "Hwp". rewrite awp_eq /awp_def. wp_apply (wp_wand with "Hwp").
iIntros "Hwp". rewrite cwp_eq /cwp_def. wp_apply (wp_wand with "Hwp").
iIntros (v) "HΦ". wp_lam. wp_pures.
iIntros (γ env l I) "#Hlock Hres #Heq". wp_pures. iFrame.
Qed.
Lemma awp_bind (f : val) (e : expr) R Φ :
AWP e @ R {{ ev, AWP f ev @ R {{ Φ }} }} -∗
AWP a_bind e f @ R {{ Φ }}.
Lemma cwp_bind (f : val) (e : expr) R Φ :
CWP e @ R {{ ev, CWP f ev @ R {{ Φ }} }} -∗
CWP c_bind e f @ R {{ Φ }}.
Proof.
iIntros "Hwp". rewrite awp_eq /awp_def.
iIntros "Hwp". rewrite cwp_eq /cwp_def.
wp_apply (wp_wand with "Hwp"). iIntros (ev) "Hwp".
wp_lam. wp_pures.
iIntros (γ env l I) "#Hflock Hres #Heq". wp_pures. wp_bind (ev env l).
......@@ -209,11 +209,11 @@ Section a_wp_rules.
iIntros (v) "H". iApply ("H" with "Hflock Hres Heq").
Qed.
Lemma awp_atomic (ev : val) R Φ :
(R -∗ ▷ ∃ R', R' ∗ AWP ev #() @ R' {{ w, R' -∗ R ∗ Φ w }}) -∗
AWP a_atomic ev @ R {{ Φ }}.
Lemma cwp_atomic (ev : val) R Φ :
(R -∗ ▷ ∃ R', R' ∗ CWP ev #() @ R' {{ w, R' -∗ R ∗ Φ w }}) -∗
CWP c_atomic ev @ R {{ Φ }}.
Proof.
iIntros "Hwp". rewrite awp_eq /awp_def. wp_lam. wp_pures.
iIntros "Hwp". rewrite cwp_eq /cwp_def. wp_lam. wp_pures.
iIntros (γ env l I) "#Hlock1 Hres #Heq1". wp_pures.
wp_apply (acquire_flock_spec with "[$]").
iIntros "Hfl".
......@@ -222,7 +222,7 @@ Section a_wp_rules.
iDestruct "HI" as "[Henv HR]".
wp_pures; simpl.
iDestruct ("Hwp" with "HR") as (Q) "[HQ Hwp]".
wp_apply (newflock_spec amonadN); first done.
wp_apply (newflock_spec cmonadN); first done.
iIntros (k γ') "#Hlock2".
iMod (flock_res_alloc_strong _ ∅ _ _ (env_inv env ∗ Q)%I with "Hlock2 [$HQ $Henv]") as (s ρ) "[_ Hres]"; first done.
wp_let.
......@@ -242,12 +242,12 @@ Section a_wp_rules.
iIntros "$". wp_pures. iFrame.
Qed.
Lemma awp_atomic_env (ev : val) R Φ :
Lemma cwp_atomic_env (ev : val) R Φ :
(∀ env, env_inv env -∗ R -∗
WP ev env {{ w, ▷ (env_inv env ∗ R ∗ Φ w) }}) -∗
AWP a_atomic_env ev @ R {{ Φ }}.
CWP c_atomic_env ev @ R {{ Φ }}.
Proof.
iIntros "Hwp". rewrite awp_eq /awp_def. wp_lam. wp_pures.
iIntros "Hwp". rewrite cwp_eq /cwp_def. wp_lam. wp_pures.
iIntros (γ env l I) "#Hlock Hres #Heq". wp_pures.
wp_apply (acquire_flock_spec with "[$]").
iIntros "Hfl".
......@@ -264,13 +264,13 @@ Section a_wp_rules.
iIntros "$". wp_pures. iFrame.
Qed.
Lemma awp_par Ψ1 Ψ2 e1 e2 R Φ :
AWP e1 @ R {{ Ψ1 }} -∗
AWP e2 @ R {{ Ψ2 }} -∗
Lemma cwp_par Ψ1 Ψ2 e1 e2 R Φ :
CWP e1 @ R {{ Ψ1 }} -∗
CWP e2 @ R {{ Ψ2 }} -∗
▷ (∀ w1 w2, Ψ1 w1 -∗ Ψ2 w2 -∗ ▷ Φ (w1,w2)%V) -∗
AWP e1 |||ᶜ e2 @ R {{ Φ }}.
CWP e1 |||ᶜ e2 @ R {{ Φ }}.
Proof.
iIntros "Hwp1 Hwp2 HΦ". rewrite awp_eq /awp_def.
iIntros "Hwp1 Hwp2 HΦ". rewrite cwp_eq /cwp_def.
wp_apply (wp_wand with "Hwp2").
iIntros (ev2) "Hwp2".
wp_apply (wp_wand with "Hwp1").
......@@ -299,50 +299,50 @@ Section a_wp_rules.
iApply ("HΦ" with "[$] [$]").
Qed.
Global Instance frame_awp p R' e R Φ Ψ :
Global Instance frame_cwp p R' e R Φ Ψ :
(∀ v, Frame p R (Φ v) (Ψ v)) →
Frame p R (AWP e @ R' {{ Φ }}) (AWP e @ R' {{ Ψ }}).
Frame p R (CWP e @ R' {{ Φ }}) (CWP e @ R' {{ Ψ }}).
Proof.
rewrite /Frame. iIntros (HR) "[HR H]". iApply (awp_wand with "H").
rewrite /Frame. iIntros (HR) "[HR H]". iApply (cwp_wand with "H").
iIntros (v) "H". iApply HR; iFrame.
Qed.
Global Instance is_except_0_awp R e Φ : IsExcept0 (AWP e @ R {{ Φ }}).
Proof. rewrite /IsExcept0. iIntros "H". iApply fupd_awp. by iMod "H". Qed.
Global Instance is_except_0_cwp R e Φ : IsExcept0 (CWP e @ R {{ Φ }}).
Proof. rewrite /IsExcept0. iIntros "H". iApply fupd_cwp. by iMod "H". Qed.
Global Instance elim_modal_bupd_awp p R e P Φ :
ElimModal True p false (|==> P) P (AWP e @ R {{ Φ }}) (AWP e @ R {{ Φ }}).
Global Instance elim_modal_bupd_cwp p R e P Φ :
ElimModal True p false (|==> P) P (CWP e @ R {{ Φ }}) (CWP e @ R {{ Φ }}).
Proof.
rewrite /ElimModal bi.intuitionistically_if_elim; iIntros (_) "[HP HR]".
iApply fupd_awp. iMod "HP". by iApply "HR".
iApply fupd_cwp. iMod "HP". by iApply "HR".
Qed.
Global Instance elim_modal_fupd_wp p R e P Φ :
ElimModal True p false (|={⊤}=> P) P (AWP e @ R {{ Φ }}) (AWP e @ R {{ Φ }}).
ElimModal True p false (|={⊤}=> P) P (CWP e @ R {{ Φ }}) (CWP e @ R {{ Φ }}).
Proof.
rewrite /ElimModal bi.intuitionistically_if_elim; iIntros (_) "[HP HR]".
iApply fupd_awp. iMod "HP". by iApply "HR".
iApply fupd_cwp. iMod "HP". by iApply "HR".
Qed.
Global Instance add_modal_fupd_wp R e P Φ :
AddModal (|={⊤}=> P) P (AWP e @ R {{ Φ }}).
AddModal (|={⊤}=> P) P (CWP e @ R {{ Φ }}).
Proof. rewrite /AddModal. iIntros "[>HP H]". by iApply "H". Qed.
End a_wp_rules.
End cwp_rules.
Section a_wp_run.
Section cwp_run.
Context `{heapG Σ, flockG Σ, spawnG Σ, locking_heapPreG Σ}.
Lemma awp_run (ev : val) Φ :
(∀ `{amonadG Σ}, AWP ev {{ w, Φ w }}) -∗
WP a_run ev {{ Φ }}.
Lemma cwp_run (ev : val) Φ :
(∀ `{cmonadG Σ}, CWP ev {{ w, Φ w }}) -∗
WP c_run ev {{ Φ }}.
Proof.
iIntros "Hwp". wp_lam.
wp_bind (mset_create #()). iApply mset_create_spec; first done.
iNext. iIntros (env) "Henv". wp_let.
iMod locking_heap_init as (?) "Hσ".
pose (amg := AMonadG Σ _ _ _ _).
iSpecialize ("Hwp" $! amg). rewrite awp_eq /awp_def.
wp_apply (newflock_spec amonadN); first done.
iSpecialize ("Hwp" $! amg). rewrite cwp_eq /cwp_def.
wp_apply (newflock_spec cmonadN); first done.
iIntros (k γ') "#Hlock". iApply wp_fupd.
iMod (flock_res_alloc_strong _ ∅ _ _ (env_inv env)%I
with "Hlock [Henv Hσ]") as (s ρ) "[_ Hres]"; first done.
......@@ -357,11 +357,11 @@ Section a_wp_run.
rewrite /flock_resources big_sepM_singleton /=.
by iMod (flock_res_dealloc with "Hlock Hres") as "Henv".
Qed.
End a_wp_run.
End cwp_run.
(* Make sure that we only use the provided rules and don't break the abstraction *)
Typeclasses Opaque a_ret a_bind (* a_run *) a_atomic a_atomic_env a_par.
Opaque a_ret a_bind (* a_run *) a_atomic a_atomic_env a_par.
Typeclasses Opaque c_ret c_bind c_run c_atomic c_atomic_env c_par.
Opaque c_ret c_bind c_run c_atomic c_atomic_env c_par.
(* Definition locking_heapΣ : gFunctors := *)
(* #[heapΣ; GFunctor (auth.authR locking_heapUR)]. *)
......@@ -369,8 +369,8 @@ Opaque a_ret a_bind (* a_run *) a_atomic a_atomic_env a_par.
(* Instance subG_locking_heapG {Σ} : subG locking_heapΣ Σ → locking_heapPreG Σ. *)
(* Proof. solve_inG. Qed. *)
(* Definition awp_adequacy Σ R s v σ φ : *)
(* (R -∗ (∀ `{locking_heapG Σ}, awp (of_val v) R (λ w, R -∗ ⌜φ w⌝)))%I → *)
(* Definition cwp_adequacy Σ R s v σ φ : *)
(* (R -∗ (∀ `{locking_heapG Σ}, cwp (of_val v) R (λ w, R -∗ ⌜φ w⌝)))%I → *)
(* adequate MaybeStuck (a_run v) σ φ. *)
(* (∀ `{heapG Σ}, WP e @ s; ⊤ {{ v, ⌜φ v⌝ }}%I) → *)
(* Proof. *)
......
theories/c_translation/proofmode.v
View file @ bfa32cfe
......@@ -2,41 +2,41 @@ From iris.heap_lang Require Export proofmode notation.
From iris_c.c_translation Require Export monad.
From iris.proofmode Require Import coq_tactics.
Lemma tac_awp_bind `{amonadG Σ} K Δ R Φ e f :
Lemma tac_cwp_bind `{cmonadG Σ} K Δ R Φ e f :
f = (λ e, fill K e) → (* as an eta expanded hypothesis so that we can `simpl` it *)
envs_entails Δ (WP e {{ v, awp (f (of_val v)) R Φ }})%I →
envs_entails Δ (awp (fill K e) R Φ).
Proof. rewrite envs_entails_eq=> -> ->. by apply: wp_awp_bind. Qed.
envs_entails Δ (WP e {{ v, cwp (f (of_val v)) R Φ }})%I →
envs_entails Δ (cwp (fill K e) R Φ).
Proof. rewrite envs_entails_eq=> -> ->. by apply: wp_cwp_bind. Qed.
Ltac awp_bind_core K :=
Ltac cwp_bind_core K :=
lazymatch eval hnf in K with
| [] => idtac
| _ => eapply (tac_awp_bind K); [simpl; reflexivity|lazy beta]
| _ => eapply (tac_cwp_bind K); [simpl; reflexivity|lazy beta]
end.
Tactic Notation "awp_apply" open_constr(lem) :=
Tactic Notation "cwp_apply" open_constr(lem) :=
iPoseProofCore lem as false true (fun H =>
lazymatch goal with
| |- envs_entails _ (awp ?e ?R ?Q) =>
| |- envs_entails _ (cwp ?e ?R ?Q) =>
reshape_expr e ltac:(fun K e' =>
awp_bind_core K; iApplyHyp H; try iNext (*; try wp_expr_simpl*) ) ||
cwp_bind_core K; iApplyHyp H; try iNext (*; try wp_expr_simpl*) ) ||
lazymatch iTypeOf H with
| Some (_,?P) => fail "awp_apply: cannot apply" P
| Some (_,?P) => fail "cwp_apply: cannot apply" P
end
| _ => fail "awp_apply: not a 'awp'"
| _ => fail "cwp_apply: not a 'cwp'"
end).
Lemma tac_awp_pure `{amonadG Σ} Δ Δ' K e1 e2 e φ n R Φ :
Lemma tac_cwp_pure `{cmonadG Σ} Δ Δ' K e1 e2 e φ n R Φ :
e = fill K e1 →
PureExec φ n e1 e2 →
φ →
MaybeIntoLaterNEnvs n Δ Δ' →
envs_entails Δ' (awp (fill K e2) R Φ) →
envs_entails Δ (awp e R Φ).
envs_entails Δ' (cwp (fill K e2) R Φ) →
envs_entails Δ (cwp e R Φ).
Proof.
rewrite envs_entails_eq=> -> ??? HΔ'.
rewrite into_laterN_env_sound /=.
rewrite HΔ' -awp_pure //.
rewrite HΔ' -cwp_pure //.
Qed.
Tactic Notation "tac_bind_helper" :=
......@@ -52,48 +52,48 @@ Tactic Notation "tac_bind_helper" :=
replace e with (fill K' e') by (by rewrite ?fill_app))
end; reflexivity.
Tactic Notation "awp_pure" open_constr(efoc) :=
Tactic Notation "cwp_pure" open_constr(efoc) :=
iStartProof;
lazymatch goal with
| |- envs_entails _ (awp ?e ?R ?Q) =>
| |- envs_entails _ (cwp ?e ?R ?Q) =>
let e := eval simpl in e in
reshape_expr e ltac:(fun K e' =>
unify e' efoc;
eapply (tac_awp_pure _ _ _ _ _ (fill K e'));
eapply (tac_cwp_pure _ _ _ _ _ (fill K e'));
[tac_bind_helper (* e = fill K e' *)
|apply _ (* PureExec *)
|try fast_done (* The pure condition for PureExec *)
|apply _ (* IntoLaters *)
|simpl
])
|| fail "awp_pure: cannot find" efoc "in" e "or" efoc "is not a redex"
| _ => fail "awp_pure: not an 'awp'"
|| fail "cwp_pure: cannot find" efoc "in" e "or" efoc "is not a redex"
| _ => fail "cwp_pure: not an 'cwp'"
end.
(* See Iris for documentation on this tactic *)
Ltac awp_pures :=
Ltac cwp_pures :=
iStartProof;
repeat (awp_pure _; []). (* The `;[]` makes sure that no side-condition
repeat (cwp_pure _; []). (* The `;[]` makes sure that no side-condition
magically spawns. *)
Tactic Notation "awp_rec" :=
Tactic Notation "cwp_rec" :=
let H := fresh in
assert (H := AsRecV_recv_locked);
awp_pure (App _ _);
cwp_pure (App _ _);
clear H.
Tactic Notation "awp_if" := awp_pure (If _ _ _).
Tactic Notation "awp_if_true" := awp_pure (If (LitV (LitBool true)) _ _).
Tactic Notation "awp_if_false" := awp_pure (If (LitV (LitBool false)) _ _).
Tactic Notation "awp_unop" := awp_pure (UnOp _ _).
Tactic Notation "awp_binop" := awp_pure (BinOp _ _ _).
Tactic Notation "awp_op" := awp_unop || awp_binop.
Tactic Notation "awp_lam" := awp_rec.
Tactic Notation "awp_let" := awp_lam.
Tactic Notation "awp_seq" := awp_lam.
Tactic Notation "awp_proj" := awp_pure (Fst _) || awp_pure (Snd _).
Tactic Notation "awp_case" := awp_pure (Case _ _ _).
Tactic Notation "awp_match" := awp_case; awp_let.
Tactic Notation "awp_inj" := awp_pure (InjL _) || wp_pure (InjR _).
Tactic Notation "awp_pair" := awp_pure (Pair _ _).
Tactic Notation "awp_closure" := awp_pure (Rec _ _ _).
Tactic Notation "cwp_if" := cwp_pure (If _ _ _).
Tactic Notation "cwp_if_true" := cwp_pure (If (LitV (LitBool true)) _ _).
Tactic Notation "cwp_if_false" := cwp_pure (If (LitV (LitBool false)) _ _).
Tactic Notation "cwp_unop" := cwp_pure (UnOp _ _).