Skip to content

GitLab

C
c
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 _ _).
Tactic Notation "cwp_binop" := cwp_pure (BinOp _ _ _).
Tactic Notation "cwp_op" := cwp_unop || cwp_binop.
Tactic Notation "cwp_lam" := cwp_rec.
Tactic Notation "cwp_let" := cwp_lam.
Tactic Notation "cwp_seq" := cwp_lam.
Tactic Notation "cwp_proj" := cwp_pure (Fst _) || cwp_pure (Snd _).
Tactic Notation "cwp_case" := cwp_pure (Case _ _ _).
Tactic Notation "cwp_match" := cwp_case; cwp_let.
Tactic Notation "cwp_inj" := cwp_pure (InjL _) || wp_pure (InjR _).
Tactic Notation "cwp_pair" := cwp_pure (Pair _ _).
Tactic Notation "cwp_closure" := cwp_pure (Rec _ _ _).