LogrelCC.cl_rules
From iris.base_logic Require Export gen_heap.
From LogrelCC.program_logic Require Export weakestpre.
From LogrelCC.program_logic Require Import CC_ectx_lifting
CC_ectxi_language CC_ectx_lifting.
From LogrelCC.program_logic Require Export cl_weakestpre.
From LogrelCC Require Export lang rules_unary.
From iris.proofmode Require Import tactics.
From stdpp Require Import fin_maps.
Set Default Proof Using "Type".
Import uPred.
Section cl_lifting.
Context `{heapG Σ}.
Implicit Types P Q : iProp Σ.
Implicit Types Φ : val → iProp Σ.
Lemma clwp_fork E e Φ :
▷ CLWP Unit @ E {{ Φ }} ∗
▷ CLWP e {{ _, True }} ⊢ CLWP Fork e @ E {{ Φ }}.
Proof.
iIntros "[Hu Hf]"; rewrite !unfold_clwp.
iIntros (K Ψ) "HK"; simpl in *.
iApply wp_fork.
iSplitL "Hu HK"; first by iApply "Hu". iNext.
iApply ("Hf" $! []); iIntros (?) "?"; iApply wp_value; eauto using to_of_val.
Qed.
Lemma clwp_rec E e1 e1' e2 Φ `{!AsVal e2}:
e1 = (Rec e1') → ▷ CLWP e1'.[e1, e2/] @ E {{ Φ }} ⊢ CLWP (App e1 e2) @ E {{ Φ }}.
Proof.
iIntros (->) "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_rec; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_bin_op E op e1 e2 v1 v2 w Φ `{!IntoVal e1 v1, !IntoVal e2 v2} :
binop_eval op v1 v2 = Some w →
▷ CLWP (of_val w) @ E {{ Φ }} ⊢ CLWP (BinOp op e1 e2) @ E {{ Φ }}.
Proof.
iIntros (?) "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_bin_op; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_if_true E e1 e2 Φ :
▷ CLWP e1 @ E {{ Φ }} ⊢ CLWP (If (#♭ true) e1 e2) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_if_true; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_if_false E e1 e2 Φ :
▷ CLWP e2 @ E {{ Φ }} ⊢ CLWP (If (#♭ false) e1 e2) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_if_false; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_fst E e1 e2 v1 Φ `{!IntoVal e1 v1, !AsVal e2} :
▷ CLWP e1 @ E {{ Φ }} ⊢ CLWP (Fst (Pair e1 e2)) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_fst; eauto; iNext. by iApply "H".
Qed.
Lemma clwp_snd E e1 e2 v2 Φ `{!AsVal e1, !IntoVal e2 v2} :
▷ CLWP e2 @ E {{ Φ }} ⊢ CLWP (Snd (Pair e1 e2)) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_snd; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_case_injl E e0 e1 e2 Φ `{!AsVal e0} :
▷ CLWP e1.[e0/] @ E {{ Φ }} ⊢ CLWP (Case (InjL e0) e1 e2) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_case_injl; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_case_injr E e0 e1 e2 Φ `{!AsVal e0} :
▷ CLWP e2.[e0/] @ E {{ Φ }} ⊢ CLWP (Case (InjR e0) e1 e2) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_case_injr; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_unfold E e v Φ `{!IntoVal e v} :
▷ CLWP e @ E {{ Φ }} ⊢ CLWP (Unfold (Fold e)) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_unfold; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_tapp E e Φ :
▷ CLWP e @ E {{ Φ }} ⊢ CLWP (TApp (TLam e)) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_tapp; eauto; iNext; by iApply "H".
Qed.
From LogrelCC.program_logic Require Export weakestpre.
From LogrelCC.program_logic Require Import CC_ectx_lifting
CC_ectxi_language CC_ectx_lifting.
From LogrelCC.program_logic Require Export cl_weakestpre.
From LogrelCC Require Export lang rules_unary.
From iris.proofmode Require Import tactics.
From stdpp Require Import fin_maps.
Set Default Proof Using "Type".
Import uPred.
Section cl_lifting.
Context `{heapG Σ}.
Implicit Types P Q : iProp Σ.
Implicit Types Φ : val → iProp Σ.
Lemma clwp_fork E e Φ :
▷ CLWP Unit @ E {{ Φ }} ∗
▷ CLWP e {{ _, True }} ⊢ CLWP Fork e @ E {{ Φ }}.
Proof.
iIntros "[Hu Hf]"; rewrite !unfold_clwp.
iIntros (K Ψ) "HK"; simpl in *.
iApply wp_fork.
iSplitL "Hu HK"; first by iApply "Hu". iNext.
iApply ("Hf" $! []); iIntros (?) "?"; iApply wp_value; eauto using to_of_val.
Qed.
Lemma clwp_rec E e1 e1' e2 Φ `{!AsVal e2}:
e1 = (Rec e1') → ▷ CLWP e1'.[e1, e2/] @ E {{ Φ }} ⊢ CLWP (App e1 e2) @ E {{ Φ }}.
Proof.
iIntros (->) "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_rec; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_bin_op E op e1 e2 v1 v2 w Φ `{!IntoVal e1 v1, !IntoVal e2 v2} :
binop_eval op v1 v2 = Some w →
▷ CLWP (of_val w) @ E {{ Φ }} ⊢ CLWP (BinOp op e1 e2) @ E {{ Φ }}.
Proof.
iIntros (?) "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_bin_op; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_if_true E e1 e2 Φ :
▷ CLWP e1 @ E {{ Φ }} ⊢ CLWP (If (#♭ true) e1 e2) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_if_true; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_if_false E e1 e2 Φ :
▷ CLWP e2 @ E {{ Φ }} ⊢ CLWP (If (#♭ false) e1 e2) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_if_false; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_fst E e1 e2 v1 Φ `{!IntoVal e1 v1, !AsVal e2} :
▷ CLWP e1 @ E {{ Φ }} ⊢ CLWP (Fst (Pair e1 e2)) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_fst; eauto; iNext. by iApply "H".
Qed.
Lemma clwp_snd E e1 e2 v2 Φ `{!AsVal e1, !IntoVal e2 v2} :
▷ CLWP e2 @ E {{ Φ }} ⊢ CLWP (Snd (Pair e1 e2)) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_snd; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_case_injl E e0 e1 e2 Φ `{!AsVal e0} :
▷ CLWP e1.[e0/] @ E {{ Φ }} ⊢ CLWP (Case (InjL e0) e1 e2) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_case_injl; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_case_injr E e0 e1 e2 Φ `{!AsVal e0} :
▷ CLWP e2.[e0/] @ E {{ Φ }} ⊢ CLWP (Case (InjR e0) e1 e2) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_case_injr; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_unfold E e v Φ `{!IntoVal e v} :
▷ CLWP e @ E {{ Φ }} ⊢ CLWP (Unfold (Fold e)) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_unfold; eauto; iNext; by iApply "H".
Qed.
Lemma clwp_tapp E e Φ :
▷ CLWP e @ E {{ Φ }} ⊢ CLWP (TApp (TLam e)) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_tapp; eauto; iNext; by iApply "H".
Qed.
Heap
Lemma clwp_alloc E e v Φ `{!IntoVal e v} :
▷ (∀ l, l ↦ᵢ v -∗ CLWP (Loc l) @ E {{ Φ }}) ⊢ CLWP (Alloc e) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_alloc; eauto; iNext. iIntros (l) "Hl".
iSpecialize ("H" with "Hl").
rewrite !unfold_clwp. by iApply "H".
Qed.
Lemma clwp_load E l q v Φ:
▷ (l ↦ᵢ{q} v -∗ CLWP (of_val v) @ E {{ Φ }}) ∗ ▷ l ↦ᵢ{q} v
⊢ CLWP (Load (Loc l)) @ E {{ Φ }}.
Proof.
iIntros "[H1 H2]"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_load; eauto. iFrame. iNext. iIntros "Hl".
iSpecialize ("H1" with "Hl").
by iApply "H1".
Qed.
Lemma clwp_store E l v' e v Φ `{!IntoVal e v} :
▷ (l ↦ᵢ v -∗ CLWP Unit @ E {{ Φ }}) ∗ ▷ l ↦ᵢ v'
⊢ CLWP Store (Loc l) e @ E {{ Φ }}.
Proof.
iIntros "[H1 H2]"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_store; eauto. iFrame. iNext. iIntros "Hl".
iSpecialize ("H1" with "Hl").
by iApply "H1".
Qed.
Lemma clwp_cas_fail E l q v' e1 v1 e2 v2 Φ `{!IntoVal e1 v1, !IntoVal e2 v2} :
v' ≠ v1 →
▷ (l ↦ᵢ{q} v' -∗ CLWP (#♭ false) @ E {{ Φ }}) ∗ ▷ l ↦ᵢ{q} v'
⊢ CLWP CAS (Loc l) e1 e2 @ E {{ Φ }}.
Proof.
iIntros (?) "[H1 H2]"; rewrite !unfold_clwp;
iIntros (K Ψ) "HK"; simpl in *.
iApply wp_cas_fail; eauto. iFrame. iNext. iIntros "Hl".
iSpecialize ("H1" with "Hl").
by iApply "H1".
Qed.
Lemma clwp_cas_suc E l e1 v1 e2 v2 Φ `{!IntoVal e1 v1, !IntoVal e2 v2} :
▷ (l ↦ᵢ v2 -∗ CLWP (#♭ true) @ E {{ Φ }}) ∗ ▷ l ↦ᵢ v1
⊢ CLWP CAS (Loc l) e1 e2 @ E {{ Φ }}.
Proof.
iIntros "[H1 H2]"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_cas_suc; iFrame. iNext. iIntros "Hl".
iSpecialize ("H1" with "Hl").
by iApply "H1".
Qed.
Lemma clwp_atomic E1 E2 e Φ :
is_atomic e →
(|={E1,E2}=> WP e @ E2 {{ v, |={E2,E1}=> Φ v }}) ⊢ CLWP e @ E1 {{ Φ }}.
Proof.
iIntros (Ha) "H".
iApply clwp_atomic;
auto using is_atomic_normal, is_atomic_sub_values, is_atomic_correct.
Qed.
Lemma clwp_bind K E e Φ :
CLWP e @ E {{ v, CLWP fill K (of_val v) @ E {{ Φ }} }}
⊢ CLWP fill K e @ E {{ Φ }}.
Proof. by iApply clwp_bind. Qed.
Lemma clwp_Lam E e1 e1' e2 Φ :
e1 = (Lam e1') → AsVal e2 →
▷ CLWP e1'.[e2/] @ E {{ Φ }} ⊢ CLWP App e1 e2 @ E {{ Φ }}.
Proof.
iIntros (? ?) "H". rewrite !unfold_clwp /=.
iIntros (K Ψ) "HΨ". iApply wp_Lam; eauto. by iApply "H".
Qed.
Lemma clwp_LetIn E e1 e2 Φ : AsVal e1 →
▷ CLWP e2.[e1/] @ E {{ Φ }} ⊢ CLWP LetIn e1 e2 @ E {{ Φ }}.
Proof.
iIntros (?) "H". rewrite !unfold_clwp /=.
iIntros (K Ψ) "HΨ". iApply wp_LetIn. by iApply "H".
Qed.
Lemma clwp_Seq E e1 e2 Φ : AsVal e1 →
▷ CLWP e2 @ E {{ Φ }} ⊢ CLWP Seq e1 e2 @ E {{ Φ }}.
Proof.
iIntros (?) "H". rewrite !unfold_clwp /=.
iIntros (K Ψ) "HΨ". iApply wp_Seq. by iApply "H".
Qed.
End cl_lifting.
▷ (∀ l, l ↦ᵢ v -∗ CLWP (Loc l) @ E {{ Φ }}) ⊢ CLWP (Alloc e) @ E {{ Φ }}.
Proof.
iIntros "H"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_alloc; eauto; iNext. iIntros (l) "Hl".
iSpecialize ("H" with "Hl").
rewrite !unfold_clwp. by iApply "H".
Qed.
Lemma clwp_load E l q v Φ:
▷ (l ↦ᵢ{q} v -∗ CLWP (of_val v) @ E {{ Φ }}) ∗ ▷ l ↦ᵢ{q} v
⊢ CLWP (Load (Loc l)) @ E {{ Φ }}.
Proof.
iIntros "[H1 H2]"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_load; eauto. iFrame. iNext. iIntros "Hl".
iSpecialize ("H1" with "Hl").
by iApply "H1".
Qed.
Lemma clwp_store E l v' e v Φ `{!IntoVal e v} :
▷ (l ↦ᵢ v -∗ CLWP Unit @ E {{ Φ }}) ∗ ▷ l ↦ᵢ v'
⊢ CLWP Store (Loc l) e @ E {{ Φ }}.
Proof.
iIntros "[H1 H2]"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_store; eauto. iFrame. iNext. iIntros "Hl".
iSpecialize ("H1" with "Hl").
by iApply "H1".
Qed.
Lemma clwp_cas_fail E l q v' e1 v1 e2 v2 Φ `{!IntoVal e1 v1, !IntoVal e2 v2} :
v' ≠ v1 →
▷ (l ↦ᵢ{q} v' -∗ CLWP (#♭ false) @ E {{ Φ }}) ∗ ▷ l ↦ᵢ{q} v'
⊢ CLWP CAS (Loc l) e1 e2 @ E {{ Φ }}.
Proof.
iIntros (?) "[H1 H2]"; rewrite !unfold_clwp;
iIntros (K Ψ) "HK"; simpl in *.
iApply wp_cas_fail; eauto. iFrame. iNext. iIntros "Hl".
iSpecialize ("H1" with "Hl").
by iApply "H1".
Qed.
Lemma clwp_cas_suc E l e1 v1 e2 v2 Φ `{!IntoVal e1 v1, !IntoVal e2 v2} :
▷ (l ↦ᵢ v2 -∗ CLWP (#♭ true) @ E {{ Φ }}) ∗ ▷ l ↦ᵢ v1
⊢ CLWP CAS (Loc l) e1 e2 @ E {{ Φ }}.
Proof.
iIntros "[H1 H2]"; rewrite !unfold_clwp; iIntros (K Ψ) "HK"; simpl in *.
iApply wp_cas_suc; iFrame. iNext. iIntros "Hl".
iSpecialize ("H1" with "Hl").
by iApply "H1".
Qed.
Lemma clwp_atomic E1 E2 e Φ :
is_atomic e →
(|={E1,E2}=> WP e @ E2 {{ v, |={E2,E1}=> Φ v }}) ⊢ CLWP e @ E1 {{ Φ }}.
Proof.
iIntros (Ha) "H".
iApply clwp_atomic;
auto using is_atomic_normal, is_atomic_sub_values, is_atomic_correct.
Qed.
Lemma clwp_bind K E e Φ :
CLWP e @ E {{ v, CLWP fill K (of_val v) @ E {{ Φ }} }}
⊢ CLWP fill K e @ E {{ Φ }}.
Proof. by iApply clwp_bind. Qed.
Lemma clwp_Lam E e1 e1' e2 Φ :
e1 = (Lam e1') → AsVal e2 →
▷ CLWP e1'.[e2/] @ E {{ Φ }} ⊢ CLWP App e1 e2 @ E {{ Φ }}.
Proof.
iIntros (? ?) "H". rewrite !unfold_clwp /=.
iIntros (K Ψ) "HΨ". iApply wp_Lam; eauto. by iApply "H".
Qed.
Lemma clwp_LetIn E e1 e2 Φ : AsVal e1 →
▷ CLWP e2.[e1/] @ E {{ Φ }} ⊢ CLWP LetIn e1 e2 @ E {{ Φ }}.
Proof.
iIntros (?) "H". rewrite !unfold_clwp /=.
iIntros (K Ψ) "HΨ". iApply wp_LetIn. by iApply "H".
Qed.
Lemma clwp_Seq E e1 e2 Φ : AsVal e1 →
▷ CLWP e2 @ E {{ Φ }} ⊢ CLWP Seq e1 e2 @ E {{ Φ }}.
Proof.
iIntros (?) "H". rewrite !unfold_clwp /=.
iIntros (K Ψ) "HΨ". iApply wp_Seq. by iApply "H".
Qed.
End cl_lifting.