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.

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.