LogrelCC.examples.refinement.lock
From iris.proofmode Require Import tactics.
From LogrelCC Require Export rules_binary typing.
From iris.base_logic Require Import invariants.
From LogrelCC Require Export rules_binary typing.
From iris.base_logic Require Import invariants.
Definition acquire : expr :=
Rec (If (CAS (Var 1) (#♭ false) (#♭ true)) (Unit) (App (Var 0) (Var 1))).
Rec (If (CAS (Var 1) (#♭ false) (#♭ true)) (Unit) (App (Var 0) (Var 1))).
Definition with_lock (e : expr) (l : expr) : expr :=
Lam
(LetIn (App acquire l.[ren (+1)])
(LetIn (App e.[ren (+2)] (Var 1))
(LetIn (App release l.[ren (+3)]) (Var 1)))).
Definition with_lockV (e l : expr) : val :=
LamV
(LetIn (App acquire l.[ren (+1)])
(LetIn (App e.[ren (+2)] (Var 1))
(LetIn (App release l.[ren (+3)]) (Var 1)))).
Lemma with_lock_to_val e l : to_val (with_lock e l) = Some (with_lockV e l).
Proof. trivial. Qed.
Lemma with_lock_of_val e l : of_val (with_lockV e l) = with_lock e l.
Proof. trivial. Qed.
Global Opaque with_lockV.
Lemma newlock_closed f : newlock.[f] = newlock.
Proof. by asimpl. Qed.
Hint Rewrite newlock_closed : autosubst.
Lemma acquire_closed f : acquire.[f] = acquire.
Proof. by asimpl. Qed.
Hint Rewrite acquire_closed : autosubst.
Lemma release_closed f : release.[f] = release.
Proof. by asimpl. Qed.
Hint Rewrite release_closed : autosubst.
Lemma with_lock_subst (e l : expr) f :
(with_lock e l).[f] = with_lock e.[f] l.[f].
Proof. unfold with_lock; asimpl; trivial. Qed.
Hint Rewrite with_lock_subst : autosubst.
Lemma with_lock_closed e l:
(∀ f : var → expr, e.[f] = e) →
(∀ f : var → expr, l.[f] = l) →
∀ f, (with_lock e l).[f] = with_lock e l.
Proof. intros Hcl1 Hcl2 f; asimpl. by rewrite Hcl1 Hcl2. Qed.
Definition LockType := Tref TBool.
Lemma newlock_type Γ : typed Γ newlock LockType.
Proof. repeat constructor. Qed.
Lemma acquire_type Γ : typed Γ acquire (TArrow LockType TUnit).
Proof. do 3 econstructor; eauto using EqTBool; repeat constructor. Qed.
Lemma release_type Γ : typed Γ release (TArrow LockType TUnit).
Proof. eapply Lam_typed; repeat econstructor. Qed.
Lemma with_lock_type e l Γ τ τ' :
typed Γ e (TArrow τ τ') →
typed Γ l LockType →
typed Γ (with_lock e l) (TArrow τ τ').
Proof.
intros H1 H2. eapply Lam_typed.
repeat eapply LetIn_typed.
- rewrite -(acquire_closed (ren (+1))); econstructor;
eapply (context_weakening [_]); eauto using acquire_type.
- repeat econstructor; eauto.
eapply (context_weakening [_; _]); eauto.
- rewrite -(release_closed (ren (+3))); econstructor;
eapply (context_weakening [_;_;_]); eauto using release_type.
- by econstructor.
Qed.
Section proof.
Context `{cfgSG Σ}.
Context `{heapG Σ}.
Lemma steps_newlock E ρ j K :
nclose specN ⊆ E →
spec_ctx ρ ∗ j ⤇ fill K newlock
⊢ |={E}=> ∃ l, j ⤇ fill K (Loc l) ∗ l ↦ₛ (#♭v false).
Proof.
iIntros (HNE) "[#Hspec Hj]".
by iMod (step_alloc _ _ j K with "[Hj]") as "Hj"; eauto.
Qed.
Global Opaque newlock.
Lemma steps_acquire E ρ j K l :
nclose specN ⊆ E →
spec_ctx ρ ∗ l ↦ₛ (#♭v false) ∗ j ⤇ fill K (App acquire (Loc l))
⊢ |={E}=> j ⤇ fill K Unit ∗ l ↦ₛ (#♭v true).
Proof.
iIntros (HNE) "[#Hspec [Hl Hj]]". unfold acquire.
iMod (step_rec _ _ j K with "[Hj]") as "Hj"; try iFrame; eauto. asimpl.
iMod (step_cas_suc _ _ j ((IfCtx _ _) :: K) with "[Hj Hl]") as "[Hj Hl]";
try iFrame; eauto.
iMod (step_if_true with "[Hj]") as "Hj"; eauto.
Qed.
Global Opaque acquire.
Lemma steps_release E ρ j K l b:
nclose specN ⊆ E →
spec_ctx ρ ∗ l ↦ₛ (#♭v b) ∗ j ⤇ fill K (App release (Loc l))
⊢ |={E}=> j ⤇ fill K Unit ∗ l ↦ₛ (#♭v false).
Proof.
iIntros (HNE) "[#Hspec [Hl Hj]]". unfold release.
iMod (step_Lam _ _ j K with "[Hj]") as "Hj"; try iFrame; eauto.
iMod (step_store with "[Hj Hl]") as "[Hj Hl]"; try iFrame; eauto.
Qed.
Global Opaque release.
Lemma steps_with_lock E ρ j K e l P Q v w:
nclose specN ⊆ E →
(∀ K', spec_ctx ρ ∗ P ∗ j ⤇ fill K' (App e (of_val w))
⊢ |={E}=> j ⤇ fill K' (of_val v) ∗ Q) →
spec_ctx ρ ∗ P ∗ l ↦ₛ (#♭v false)
∗ j ⤇ fill K (App (with_lock e (Loc l)) (of_val w))
⊢ |={E}=> j ⤇ fill K (of_val v) ∗ Q ∗ l ↦ₛ (#♭v false).
Proof.
iIntros (HNE He) "[#Hspec [HP [Hl Hj]]]".
iMod (step_Lam _ _ j K with "[$Hj]") as "Hj"; eauto.
asimpl.
iMod (steps_acquire _ _ j ((LetInCtx _) :: K) with "[Hj Hl]")
as "[Hj Hl]"; eauto.
{ simpl. iFrame "Hspec Hl"; eauto. }
simpl. asimpl.
iMod (step_LetIn _ _ j K with "[Hj]") as "Hj"; eauto; eauto.
asimpl.
iMod (He ((LetInCtx _) :: K) with "[Hj HP]") as "[Hj HQ]"; eauto.
{ simpl. iFrame "Hspec HP"; eauto. }
simpl. asimpl.
iMod (step_LetIn _ _ j K with "[Hj]") as "Hj"; eauto; eauto.
asimpl.
iMod (steps_release _ _ j ((LetInCtx _) :: K) _ _ with "[Hj Hl]")
as "[Hj Hl]"; eauto.
{ simpl. iFrame "#"; iFrame. }
simpl; asimpl.
iMod (step_LetIn _ _ j K with "[Hj]") as "Hj"; eauto; eauto.
asimpl. iModIntro; iFrame.
Qed.
Global Opaque with_lock.
End proof.
Lam
(LetIn (App acquire l.[ren (+1)])
(LetIn (App e.[ren (+2)] (Var 1))
(LetIn (App release l.[ren (+3)]) (Var 1)))).
Definition with_lockV (e l : expr) : val :=
LamV
(LetIn (App acquire l.[ren (+1)])
(LetIn (App e.[ren (+2)] (Var 1))
(LetIn (App release l.[ren (+3)]) (Var 1)))).
Lemma with_lock_to_val e l : to_val (with_lock e l) = Some (with_lockV e l).
Proof. trivial. Qed.
Lemma with_lock_of_val e l : of_val (with_lockV e l) = with_lock e l.
Proof. trivial. Qed.
Global Opaque with_lockV.
Lemma newlock_closed f : newlock.[f] = newlock.
Proof. by asimpl. Qed.
Hint Rewrite newlock_closed : autosubst.
Lemma acquire_closed f : acquire.[f] = acquire.
Proof. by asimpl. Qed.
Hint Rewrite acquire_closed : autosubst.
Lemma release_closed f : release.[f] = release.
Proof. by asimpl. Qed.
Hint Rewrite release_closed : autosubst.
Lemma with_lock_subst (e l : expr) f :
(with_lock e l).[f] = with_lock e.[f] l.[f].
Proof. unfold with_lock; asimpl; trivial. Qed.
Hint Rewrite with_lock_subst : autosubst.
Lemma with_lock_closed e l:
(∀ f : var → expr, e.[f] = e) →
(∀ f : var → expr, l.[f] = l) →
∀ f, (with_lock e l).[f] = with_lock e l.
Proof. intros Hcl1 Hcl2 f; asimpl. by rewrite Hcl1 Hcl2. Qed.
Definition LockType := Tref TBool.
Lemma newlock_type Γ : typed Γ newlock LockType.
Proof. repeat constructor. Qed.
Lemma acquire_type Γ : typed Γ acquire (TArrow LockType TUnit).
Proof. do 3 econstructor; eauto using EqTBool; repeat constructor. Qed.
Lemma release_type Γ : typed Γ release (TArrow LockType TUnit).
Proof. eapply Lam_typed; repeat econstructor. Qed.
Lemma with_lock_type e l Γ τ τ' :
typed Γ e (TArrow τ τ') →
typed Γ l LockType →
typed Γ (with_lock e l) (TArrow τ τ').
Proof.
intros H1 H2. eapply Lam_typed.
repeat eapply LetIn_typed.
- rewrite -(acquire_closed (ren (+1))); econstructor;
eapply (context_weakening [_]); eauto using acquire_type.
- repeat econstructor; eauto.
eapply (context_weakening [_; _]); eauto.
- rewrite -(release_closed (ren (+3))); econstructor;
eapply (context_weakening [_;_;_]); eauto using release_type.
- by econstructor.
Qed.
Section proof.
Context `{cfgSG Σ}.
Context `{heapG Σ}.
Lemma steps_newlock E ρ j K :
nclose specN ⊆ E →
spec_ctx ρ ∗ j ⤇ fill K newlock
⊢ |={E}=> ∃ l, j ⤇ fill K (Loc l) ∗ l ↦ₛ (#♭v false).
Proof.
iIntros (HNE) "[#Hspec Hj]".
by iMod (step_alloc _ _ j K with "[Hj]") as "Hj"; eauto.
Qed.
Global Opaque newlock.
Lemma steps_acquire E ρ j K l :
nclose specN ⊆ E →
spec_ctx ρ ∗ l ↦ₛ (#♭v false) ∗ j ⤇ fill K (App acquire (Loc l))
⊢ |={E}=> j ⤇ fill K Unit ∗ l ↦ₛ (#♭v true).
Proof.
iIntros (HNE) "[#Hspec [Hl Hj]]". unfold acquire.
iMod (step_rec _ _ j K with "[Hj]") as "Hj"; try iFrame; eauto. asimpl.
iMod (step_cas_suc _ _ j ((IfCtx _ _) :: K) with "[Hj Hl]") as "[Hj Hl]";
try iFrame; eauto.
iMod (step_if_true with "[Hj]") as "Hj"; eauto.
Qed.
Global Opaque acquire.
Lemma steps_release E ρ j K l b:
nclose specN ⊆ E →
spec_ctx ρ ∗ l ↦ₛ (#♭v b) ∗ j ⤇ fill K (App release (Loc l))
⊢ |={E}=> j ⤇ fill K Unit ∗ l ↦ₛ (#♭v false).
Proof.
iIntros (HNE) "[#Hspec [Hl Hj]]". unfold release.
iMod (step_Lam _ _ j K with "[Hj]") as "Hj"; try iFrame; eauto.
iMod (step_store with "[Hj Hl]") as "[Hj Hl]"; try iFrame; eauto.
Qed.
Global Opaque release.
Lemma steps_with_lock E ρ j K e l P Q v w:
nclose specN ⊆ E →
(∀ K', spec_ctx ρ ∗ P ∗ j ⤇ fill K' (App e (of_val w))
⊢ |={E}=> j ⤇ fill K' (of_val v) ∗ Q) →
spec_ctx ρ ∗ P ∗ l ↦ₛ (#♭v false)
∗ j ⤇ fill K (App (with_lock e (Loc l)) (of_val w))
⊢ |={E}=> j ⤇ fill K (of_val v) ∗ Q ∗ l ↦ₛ (#♭v false).
Proof.
iIntros (HNE He) "[#Hspec [HP [Hl Hj]]]".
iMod (step_Lam _ _ j K with "[$Hj]") as "Hj"; eauto.
asimpl.
iMod (steps_acquire _ _ j ((LetInCtx _) :: K) with "[Hj Hl]")
as "[Hj Hl]"; eauto.
{ simpl. iFrame "Hspec Hl"; eauto. }
simpl. asimpl.
iMod (step_LetIn _ _ j K with "[Hj]") as "Hj"; eauto; eauto.
asimpl.
iMod (He ((LetInCtx _) :: K) with "[Hj HP]") as "[Hj HQ]"; eauto.
{ simpl. iFrame "Hspec HP"; eauto. }
simpl. asimpl.
iMod (step_LetIn _ _ j K with "[Hj]") as "Hj"; eauto; eauto.
asimpl.
iMod (steps_release _ _ j ((LetInCtx _) :: K) _ _ with "[Hj Hl]")
as "[Hj Hl]"; eauto.
{ simpl. iFrame "#"; iFrame. }
simpl; asimpl.
iMod (step_LetIn _ _ j K with "[Hj]") as "Hj"; eauto; eauto.
asimpl. iModIntro; iFrame.
Qed.
Global Opaque with_lock.
End proof.