Commit 68e8477d authored by Robbert Krebbers's avatar Robbert Krebbers

Get rid of γs in locks.

parent 8c1119c4
...@@ -8,32 +8,29 @@ Structure lock Σ `{!heapG Σ} := Lock { ...@@ -8,32 +8,29 @@ Structure lock Σ `{!heapG Σ} := Lock {
acquire : val; acquire : val;
release : val; release : val;
(* -- predicates -- *) (* -- predicates -- *)
(* name is used to associate locked with is_lock *) is_lock (N: namespace) (lk: val) (R: iProp Σ) : iProp Σ;
name : Type; locked (lk: val) : iProp Σ;
is_lock (N: namespace) (γ: name) (lock: val) (R: iProp Σ) : iProp Σ;
locked (γ: name) : iProp Σ;
(* -- general properties -- *) (* -- general properties -- *)
is_lock_ne N γ lk : NonExpansive (is_lock N γ lk); is_lock_ne N lk : NonExpansive (is_lock N lk);
is_lock_persistent N γ lk R : Persistent (is_lock N γ lk R); is_lock_persistent N lk R : Persistent (is_lock N lk R);
locked_timeless γ : Timeless (locked γ); locked_timeless lk : Timeless (locked lk);
locked_exclusive γ : locked γ - locked γ - False; locked_exclusive lk : locked lk - locked lk - False;
(* -- operation specs -- *) (* -- operation specs -- *)
newlock_spec N (R : iProp Σ) : newlock_spec N (R : iProp Σ) :
{{{ R }}} newlock #() {{{ lk γ, RET lk; is_lock N γ lk R }}}; {{{ R }}} newlock #() {{{ lk, RET lk; is_lock N lk R }}};
acquire_spec N γ lk R : acquire_spec N lk R :
{{{ is_lock N γ lk R }}} acquire lk {{{ RET #(); locked γ R }}}; {{{ is_lock N lk R }}} acquire lk {{{ RET #(); locked lk R }}};
release_spec N γ lk R : release_spec N lk R :
{{{ is_lock N γ lk R locked γ R }}} release lk {{{ RET #(); True }}} {{{ is_lock N lk R locked lk R }}} release lk {{{ RET #(); True }}}
}. }.
Arguments newlock {_ _} _. Arguments newlock {_ _} _.
Arguments acquire {_ _} _. Arguments acquire {_ _} _.
Arguments release {_ _} _. Arguments release {_ _} _.
Arguments is_lock {_ _} _ _ _ _ _. Arguments is_lock {_ _} _ _ _ _.
Arguments locked {_ _} _ _. Arguments locked {_ _} _ _.
Existing Instances is_lock_ne is_lock_persistent locked_timeless. Existing Instances is_lock_ne is_lock_persistent locked_timeless.
Instance is_lock_proper Σ `{!heapG Σ} (L: lock Σ) N γ lk: Instance is_lock_proper Σ `{!heapG Σ} (L: lock Σ) N lk:
Proper (() ==> ()) (is_lock L N γ lk) := ne_proper _. Proper (() ==> ()) (is_lock L N lk) := ne_proper _.
...@@ -26,51 +26,58 @@ Section proof. ...@@ -26,51 +26,58 @@ Section proof.
Definition lock_inv (γ : gname) (l : loc) (R : iProp Σ) : iProp Σ := Definition lock_inv (γ : gname) (l : loc) (R : iProp Σ) : iProp Σ :=
( b : bool, l #b if b then True else own γ (Excl ()) R)%I. ( b : bool, l #b if b then True else own γ (Excl ()) R)%I.
Definition is_lock (γ : gname) (lk : val) (R : iProp Σ) : iProp Σ := Definition is_lock (lk : val) (R : iProp Σ) : iProp Σ :=
( l: loc, lk = #l inv N (lock_inv γ l R))%I. ( γ (l: loc), lk = #l meta l nroot γ inv N (lock_inv γ l R))%I.
Definition locked (γ : gname) : iProp Σ := own γ (Excl ()). Definition locked (lk : val) : iProp Σ :=
( γ (l: loc), lk = #l meta l nroot γ own γ (Excl ()))%I.
Lemma locked_exclusive (γ : gname) : locked γ - locked γ - False. Lemma locked_exclusive lk : locked lk - locked lk - False.
Proof. iIntros "H1 H2". by iDestruct (own_valid_2 with "H1 H2") as %?. Qed. Proof.
iDestruct 1 as (γ1 l1 ?) "[#Hm1 H1]".
iDestruct 1 as (γ2 l2 ?) "[#Hm2 H2]"; simplify_eq/=.
iDestruct (meta_agree with "Hm1 Hm2") as %<-.
by iDestruct (own_valid_2 with "H1 H2") as %?.
Qed.
Global Instance lock_inv_ne γ l : NonExpansive (lock_inv γ l). Global Instance lock_inv_ne γ lk : NonExpansive (lock_inv γ lk).
Proof. solve_proper. Qed. Proof. solve_proper. Qed.
Global Instance is_lock_ne γ l : NonExpansive (is_lock γ l). Global Instance is_lock_ne lk : NonExpansive (is_lock lk).
Proof. solve_proper. Qed. Proof. solve_proper. Qed.
(** The main proofs. *) (** The main proofs. *)
Global Instance is_lock_persistent γ l R : Persistent (is_lock γ l R). Global Instance is_lock_persistent lk R : Persistent (is_lock lk R).
Proof. apply _. Qed. Proof. apply _. Qed.
Global Instance locked_timeless γ : Timeless (locked γ). Global Instance locked_timeless lk : Timeless (locked lk).
Proof. apply _. Qed. Proof. apply _. Qed.
Lemma newlock_spec (R : iProp Σ): Lemma newlock_spec (R : iProp Σ):
{{{ R }}} newlock #() {{{ lk γ, RET lk; is_lock γ lk R }}}. {{{ R }}} newlock #() {{{ lk, RET lk; is_lock lk R }}}.
Proof. Proof.
iIntros (Φ) "HR HΦ". rewrite -wp_fupd /newlock /=. iIntros (Φ) "HR HΦ". rewrite -wp_fupd /newlock /=.
wp_lam. wp_alloc l as "Hl". wp_lam. wp_apply (wp_alloc with "[//]"); iIntros (l) "[Hl Hm]".
iMod (own_alloc (Excl ())) as (γ) "Hγ"; first done. iMod (own_alloc (Excl ())) as (γ) "Hγ"; first done.
iMod (meta_set _ _ γ nroot with "Hm") as "#Hm"; first done.
iMod (inv_alloc N _ (lock_inv γ l R) with "[-HΦ]") as "#?". iMod (inv_alloc N _ (lock_inv γ l R) with "[-HΦ]") as "#?".
{ iIntros "!>". iExists false. by iFrame. } { iIntros "!>". iExists false. by iFrame. }
iModIntro. iApply "HΦ". iExists l. eauto. iModIntro. iApply "HΦ". iExists γ, l. eauto.
Qed. Qed.
Lemma try_acquire_spec γ lk R : Lemma try_acquire_spec lk R :
{{{ is_lock γ lk R }}} try_acquire lk {{{ is_lock lk R }}} try_acquire lk
{{{ b, RET #b; if b is true then locked γ R else True }}}. {{{ b, RET #b; if b is true then locked lk R else True }}}.
Proof. Proof.
iIntros (Φ) "#Hl HΦ". iDestruct "Hl" as (l ->) "#Hinv". iIntros (Φ) "#Hl HΦ". iDestruct "Hl" as (γ l ->) "#[Hm Hinv]".
wp_rec. iInv N as ([]) "[Hl HR]". wp_rec. iInv N as ([]) "[Hl HR]".
- wp_cas_fail. iModIntro. iSplitL "Hl"; first (iNext; iExists true; eauto). - wp_cas_fail. iModIntro. iSplitL "Hl"; first (iNext; iExists true; eauto).
iApply ("HΦ" $! false). done. iApply ("HΦ" $! false). done.
- wp_cas_suc. iDestruct "HR" as "[Hγ HR]". - wp_cas_suc. iDestruct "HR" as "[Hγ HR]".
iModIntro. iSplitL "Hl"; first (iNext; iExists true; eauto). iModIntro. iSplitL "Hl"; first (iNext; iExists true; eauto).
rewrite /locked. by iApply ("HΦ" $! true with "[$Hγ $HR]"). rewrite /locked. iApply ("HΦ" $! true with "[$HR Hγ]"); eauto.
Qed. Qed.
Lemma acquire_spec γ lk R : Lemma acquire_spec lk R :
{{{ is_lock γ lk R }}} acquire lk {{{ RET #(); locked γ R }}}. {{{ is_lock lk R }}} acquire lk {{{ RET #(); locked lk R }}}.
Proof. Proof.
iIntros (Φ) "#Hl HΦ". iLöb as "IH". wp_rec. iIntros (Φ) "#Hl HΦ". iLöb as "IH". wp_rec.
wp_apply (try_acquire_spec with "Hl"). iIntros ([]). wp_apply (try_acquire_spec with "Hl"). iIntros ([]).
...@@ -78,11 +85,13 @@ Section proof. ...@@ -78,11 +85,13 @@ Section proof.
- iIntros "_". wp_if. iApply ("IH" with "[HΦ]"). auto. - iIntros "_". wp_if. iApply ("IH" with "[HΦ]"). auto.
Qed. Qed.
Lemma release_spec γ lk R : Lemma release_spec lk R :
{{{ is_lock γ lk R locked γ R }}} release lk {{{ RET #(); True }}}. {{{ is_lock lk R locked lk R }}} release lk {{{ RET #(); True }}}.
Proof. Proof.
iIntros (Φ) "(Hlock & Hlocked & HR) HΦ". iIntros (Φ) "(Hlock & Hlocked & HR) HΦ".
iDestruct "Hlock" as (l ->) "#Hinv". iDestruct "Hlock" as (γ l ->) "#[Hm Hinv]".
iDestruct "Hlocked" as (γ' l' ?) "[#Hm' Hlocked]"; simplify_eq/=.
iDestruct (meta_agree with "Hm Hm'") as %<-.
rewrite /release /=. wp_lam. iInv N as (b) "[Hl _]". rewrite /release /=. wp_lam. iInv N as (b) "[Hl _]".
wp_store. iSplitR "HΦ"; last by iApply "HΦ". wp_store. iSplitR "HΦ"; last by iApply "HΦ".
iModIntro. iNext. iExists false. by iFrame. iModIntro. iNext. iExists false. by iFrame.
......
...@@ -45,48 +45,56 @@ Section proof. ...@@ -45,48 +45,56 @@ Section proof.
own γ ( (Excl' o, GSet (set_seq 0 n))) own γ ( (Excl' o, GSet (set_seq 0 n)))
((own γ ( (Excl' o, GSet )) R) own γ ( (ε, GSet {[ o ]}))))%I. ((own γ ( (Excl' o, GSet )) R) own γ ( (ε, GSet {[ o ]}))))%I.
Definition is_lock (γ : gname) (lk : val) (R : iProp Σ) : iProp Σ := Definition is_lock (lk : val) (R : iProp Σ) : iProp Σ :=
( lo ln : loc, ( γ (lo ln : loc),
lk = (#lo, #ln)%V inv N (lock_inv γ lo ln R))%I. lk = (#lo, #ln)%V meta lo nroot γ inv N (lock_inv γ lo ln R))%I.
Definition issued (γ : gname) (x : nat) : iProp Σ := Definition issued (lk : val) (x : nat) : iProp Σ :=
own γ ( (ε, GSet {[ x ]}))%I. ( γ (lo ln : loc),
lk = (#lo, #ln)%V meta lo nroot γ own γ ( (ε, GSet {[ x ]})))%I.
Definition locked (γ : gname) : iProp Σ := ( o, own γ ( (Excl' o, GSet )))%I. Definition locked (lk : val) : iProp Σ :=
( γ (lo ln : loc) o,
lk = (#lo, #ln)%V meta lo nroot γ own γ ( (Excl' o, GSet )))%I.
Global Instance lock_inv_ne γ lo ln : Global Instance lock_inv_ne γ lo ln :
NonExpansive (lock_inv γ lo ln). NonExpansive (lock_inv γ lo ln).
Proof. solve_proper. Qed. Proof. solve_proper. Qed.
Global Instance is_lock_ne γ lk : NonExpansive (is_lock γ lk). Global Instance is_lock_ne lk : NonExpansive (is_lock lk).
Proof. solve_proper. Qed. Proof. solve_proper. Qed.
Global Instance is_lock_persistent γ lk R : Persistent (is_lock γ lk R). Global Instance is_lock_persistent lk R : Persistent (is_lock lk R).
Proof. apply _. Qed. Proof. apply _. Qed.
Global Instance locked_timeless γ : Timeless (locked γ). Global Instance locked_timeless lk : Timeless (locked lk).
Proof. apply _. Qed. Proof. apply _. Qed.
Lemma locked_exclusive (γ : gname) : locked γ - locked γ - False. Lemma locked_exclusive lk : locked lk - locked lk - False.
Proof. Proof.
iDestruct 1 as (o1) "H1". iDestruct 1 as (o2) "H2". iDestruct 1 as (γ1 lo1 ln1 o1 ?) "[#Hm1 H1]".
iDestruct 1 as (γ2 lo2 ln2 o2 ?) "[#Hm2 H2]"; simplify_eq/=.
iDestruct (meta_agree with "Hm1 Hm2") as %<-.
iDestruct (own_valid_2 with "H1 H2") as %[[] _]. iDestruct (own_valid_2 with "H1 H2") as %[[] _].
Qed. Qed.
Lemma newlock_spec (R : iProp Σ) : Lemma newlock_spec (R : iProp Σ) :
{{{ R }}} newlock #() {{{ lk γ, RET lk; is_lock γ lk R }}}. {{{ R }}} newlock #() {{{ lk, RET lk; is_lock lk R }}}.
Proof. Proof.
iIntros (Φ) "HR HΦ". rewrite -wp_fupd. wp_lam. iIntros (Φ) "HR HΦ". rewrite -wp_fupd. wp_lam.
wp_alloc ln as "Hln". wp_alloc lo as "Hlo". wp_alloc ln as "Hln". wp_apply (wp_alloc with "[//]"); iIntros (lo) "[Hlo Hm]".
iMod (own_alloc ( (Excl' 0%nat, GSet ) (Excl' 0%nat, GSet ))) as (γ) "[Hγ Hγ']". iMod (own_alloc ( (Excl' 0%nat, GSet ) (Excl' 0%nat, GSet ))) as (γ) "[Hγ Hγ']".
{ by apply auth_both_valid. } { by apply auth_both_valid. }
iMod (meta_set _ _ γ nroot with "Hm") as "#Hm"; first done.
iMod (inv_alloc _ _ (lock_inv γ lo ln R) with "[-HΦ]"). iMod (inv_alloc _ _ (lock_inv γ lo ln R) with "[-HΦ]").
{ iNext. rewrite /lock_inv. { iNext. rewrite /lock_inv.
iExists 0%nat, 0%nat. iFrame. iLeft. by iFrame. } iExists 0%nat, 0%nat. iFrame. iLeft. by iFrame. }
wp_pures. iModIntro. iApply ("HΦ" $! (#lo, #ln)%V γ). iExists lo, ln. eauto. wp_pures. iModIntro. iApply ("HΦ" $! (#lo, #ln)%V). iExists γ, lo, ln. eauto.
Qed. Qed.
Lemma wait_loop_spec γ lk x R : Lemma wait_loop_spec lk x R :
{{{ is_lock γ lk R issued γ x }}} wait_loop #x lk {{{ RET #(); locked γ R }}}. {{{ is_lock lk R issued lk x }}} wait_loop #x lk {{{ RET #(); locked lk R }}}.
Proof. Proof.
iIntros (Φ) "[Hl Ht] HΦ". iDestruct "Hl" as (lo ln ->) "#Hinv". iIntros (Φ) "[Hl Ht] HΦ". iDestruct "Hl" as (γ lo' ln' ->) "#[Hm Hinv]".
iDestruct "Ht" as (γ' lo ln ?) "[#Hm' Ht]"; simplify_eq/=.
iDestruct (meta_agree with "Hm Hm'") as %<-.
iLöb as "IH". wp_rec. subst. wp_pures. wp_bind (! _)%E. iLöb as "IH". wp_rec. subst. wp_pures. wp_bind (! _)%E.
iInv N as (o n) "(Hlo & Hln & Ha)". iInv N as (o n) "(Hlo & Hln & Ha)".
wp_load. destruct (decide (x = o)) as [->|Hneq]. wp_load. destruct (decide (x = o)) as [->|Hneq].
...@@ -94,7 +102,7 @@ Section proof. ...@@ -94,7 +102,7 @@ Section proof.
+ iModIntro. iSplitL "Hlo Hln Hainv Ht". + iModIntro. iSplitL "Hlo Hln Hainv Ht".
{ iNext. iExists o, n. iFrame. } { iNext. iExists o, n. iFrame. }
wp_pures. case_bool_decide; [|done]. wp_if. wp_pures. case_bool_decide; [|done]. wp_if.
iApply ("HΦ" with "[-]"). rewrite /locked. iFrame. eauto. iApply ("HΦ" with "[-]"). rewrite /locked. iFrame. eauto 20.
+ iDestruct (own_valid_2 with "Ht Haown") as % [_ ?%gset_disj_valid_op]. + iDestruct (own_valid_2 with "Ht Haown") as % [_ ?%gset_disj_valid_op].
set_solver. set_solver.
- iModIntro. iSplitL "Hlo Hln Ha". - iModIntro. iSplitL "Hlo Hln Ha".
...@@ -103,10 +111,10 @@ Section proof. ...@@ -103,10 +111,10 @@ Section proof.
wp_if. iApply ("IH" with "Ht"). iNext. by iExact "HΦ". wp_if. iApply ("IH" with "Ht"). iNext. by iExact "HΦ".
Qed. Qed.
Lemma acquire_spec γ lk R : Lemma acquire_spec lk R :
{{{ is_lock γ lk R }}} acquire lk {{{ RET #(); locked γ R }}}. {{{ is_lock lk R }}} acquire lk {{{ RET #(); locked lk R }}}.
Proof. Proof.
iIntros (ϕ) "Hl HΦ". iDestruct "Hl" as (lo ln ->) "#Hinv". iIntros (ϕ) "Hl HΦ". iDestruct "Hl" as (γ lo ln ->) "#[Hm Hinv]".
iLöb as "IH". wp_rec. wp_bind (! _)%E. simplify_eq/=. wp_proj. iLöb as "IH". wp_rec. wp_bind (! _)%E. simplify_eq/=. wp_proj.
iInv N as (o n) "[Hlo [Hln Ha]]". iInv N as (o n) "[Hlo [Hln Ha]]".
wp_load. iModIntro. iSplitL "Hlo Hln Ha". wp_load. iModIntro. iSplitL "Hlo Hln Ha".
...@@ -123,8 +131,8 @@ Section proof. ...@@ -123,8 +131,8 @@ Section proof.
{ iNext. iExists o', (S n). { iNext. iExists o', (S n).
rewrite Nat2Z.inj_succ -Z.add_1_r. by iFrame. } rewrite Nat2Z.inj_succ -Z.add_1_r. by iFrame. }
wp_if. wp_if.
iApply (wait_loop_spec γ (#lo, #ln) with "[-HΦ]"). iApply (wait_loop_spec (#lo, #ln) with "[-HΦ]").
+ iFrame. rewrite /is_lock; eauto 10. + iFrame. rewrite /is_lock /issued; eauto 20.
+ by iNext. + by iNext.
- wp_cas_fail. iModIntro. - wp_cas_fail. iModIntro.
iSplitL "Hlo' Hln' Hauth Haown". iSplitL "Hlo' Hln' Hauth Haown".
...@@ -132,11 +140,12 @@ Section proof. ...@@ -132,11 +140,12 @@ Section proof.
wp_if. by iApply "IH"; auto. wp_if. by iApply "IH"; auto.
Qed. Qed.
Lemma release_spec γ lk R : Lemma release_spec lk R :
{{{ is_lock γ lk R locked γ R }}} release lk {{{ RET #(); True }}}. {{{ is_lock lk R locked lk R }}} release lk {{{ RET #(); True }}}.
Proof. Proof.
iIntros (Φ) "(Hl & Hγ & HR) HΦ". iDestruct "Hl" as (lo ln ->) "#Hinv". iIntros (Φ) "(Hl & Hγ & HR) HΦ". iDestruct "Hl" as (γ' lo' ln' ->) "#[Hm Hinv]".
iDestruct "Hγ" as (o) "Hγo". iDestruct "Hγ" as (γ lo ln o ?) "[#Hm' Hγo]"; simplify_eq/=.
iDestruct (meta_agree with "Hm Hm'") as %<-.
wp_lam. wp_proj. wp_bind (! _)%E. wp_lam. wp_proj. wp_bind (! _)%E.
iInv N as (o' n) "(>Hlo & >Hln & >Hauth & Haown)". iInv N as (o' n) "(>Hlo & >Hln & >Hauth & Haown)".
wp_load. wp_load.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment