LogrelCC.examples.refinement.lock_unary_spec

From iris.algebra Require Import excl.
From iris.proofmode Require Import tactics.
From LogrelCC Require Export rules_unary rules_binary typing lang cl_rules.
From LogrelCC.examples.refinement Require Import lock.
From iris.base_logic Require Import invariants.

Section lock_unary_spec.
  Context `{heapG Σ}.
  Context `{inG Σ (exclR unitR)}.

  Local Transparent newlock acquire release.

  Definition locked γ := own γ (Excl ()).

  Definition lockN (l : loc) := nroot .@ "lock" .@ l.

  Definition is_lock γ l P :=
    inv (lockN l) ((l ↦ᵢ (#♭v false) P locked γ)
                                l ↦ᵢ (#♭v true))%I.

  Global Instance is_lock_persistent γ l Φ : Persistent (is_lock γ l Φ).
  Proof. apply _. Qed.

  Lemma clwp_newlock :
    True CLWP newlock {{v, l γ, v = LocV l ( P E, P ={E}=∗ is_lock γ l P) }}.
  Proof.
    iIntros "_"; rewrite /newlock /is_lock.
    iApply clwp_alloc; auto. iNext.
    iIntros (l) "Hl".
    iMod (own_alloc (Excl ())) as (γ) "Hld"; first done.
    iApply clwp_value; eauto; iExists _, _; iSplit; eauto.
    iIntros (P E) "HP".
    iMod (inv_alloc _ _
           ((l ↦ᵢ (#♭v false) P locked γ) l ↦ᵢ (#♭v true))%I with "[-]")
      as "Hinv"; last eauto.
    { iNext; iLeft; iFrame. }
  Qed.

  Lemma clwp_acquire E γ l P :
    nclose (lockN l) E
    is_lock γ l P CLWP App acquire (Loc l) @ E {{v, P locked γ}}.
  Proof.
    iIntros (HE) "#Hi"; rewrite /acquire.
    iLöb as "IH".
    iApply clwp_rec; eauto using to_of_val. iNext. asimpl.
    iApply (clwp_bind [IfCtx _ _]); simpl.
    iApply clwp_atomic; eauto.
    iInv (lockN l) as "[(Hl & HP & Ht)|Hl]" "Hcl".
    - iModIntro. iApply (wp_cas_suc' with "[$Hl HP Ht Hcl]"); eauto.
      iNext. iIntros "Hl". iApply wp_value; eauto.
      iMod ("Hcl" with "[Hl]") as "_"; first by iRight.
      iModIntro. iApply clwp_if_true; iNext.
      iApply clwp_value; eauto. iFrame.
    - iModIntro. iApply (wp_cas_fail' with "[$Hl Hcl]"); eauto.
      iNext. iIntros "Hl". iApply wp_value; eauto.
      iMod ("Hcl" with "[Hl]") as "_"; first by iRight.
      iModIntro. iApply clwp_if_false. iNext. auto.
  Qed.

  Lemma clwp_release E γ l P :
    nclose (lockN l) E
    is_lock γ l P locked γ P CLWP App release (Loc l) @ E {{v, True}}.
  Proof.
    iIntros (HE) "(#Hi & Hld & HP)"; rewrite /release.
    iApply clwp_Lam; eauto. asimpl. iNext.
    iApply clwp_atomic; eauto.
    iInv (lockN l) as "[(Hl & HQ & >Ht)|Hl]" "Hcl".
    - by iDestruct (own_valid_2 with "Hld Ht") as %Hv.
    - iModIntro. iApply (wp_store' with "[-]"); eauto; iFrame.
      iNext. iIntros "Hl".
      iApply wp_value; eauto.
      by iMod ("Hcl" with "[-]") as "_"; first by iNext; iLeft; iFrame.
  Qed.

End lock_unary_spec.

Typeclasses Opaque locked.
Global Opaque locked.
Typeclasses Opaque is_lock.
Global Opaque is_lock.