Skip to content

R
ReLoC-v1
Commit 4c60831d authored by Dan Frumin's avatar Dan Frumin
Browse files
Options

Massively simplify the ticket lock refinement 

Thanks to Robbert
parent 299978e2
Show whitespace changes
Inline Side-by-side
Showing with 54 additions and 182 deletions
theories/examples/ticket_lock.v
View file @ 4c60831d
......@@ -70,10 +70,6 @@ Section refinement.
Definition ticket (γ : gname) (n : nat) := own γ (◯ GSet {[ n ]}).
(** total number of issued tickets is `n` *)
Definition issuedTickets (γ : gname) (n : nat) := own γ (● GSet (seq_set 0 n)).
(** the locks `(ln, lo)` and `l'` are linked together in the pool `γP` *)
Definition inPool (γP : gname) (lo ln : loc) (γ : gname) (l' : loc) := own γP (◯ {[(lo, ln, γ), l']}).
(** the set `P` is in fact the lock pool associated with `γP` *)
Definition isPool (γP : gname) (P : lockPool) := own γP (● P).
Lemma ticket_nondup γ n : ticket γ n -∗ ticket γ n -∗ False.
Proof.
......@@ -98,52 +94,12 @@ Section refinement.
by iFrame.
Qed.
Instance inPool_persistent γP lo ln γ l' : Persistent (inPool γP lo ln γ l').
Proof. apply _. Qed.
Lemma inPool_lookup γP lo ln γ l' P :
inPool γP lo ln γ l' -∗ isPool γP P -∗
⌜(lo, ln, γ, l') ∈ P⌝.
Proof.
iIntros "Hrs Ho".
iDestruct (own_valid_2 with "Ho Hrs") as %Hfoo.
iPureIntro.
apply auth_valid_discrete in Hfoo.
simpl in Hfoo. destruct Hfoo as [Hfoo _].
revert Hfoo. rewrite left_id.
by rewrite gset_included elem_of_subseteq_singleton.
Qed.
Lemma isPool_insert γP lo ln γ l' P :
isPool γP P ==∗
inPool γP lo ln γ l' ∗ isPool γP ({[(lo, ln, γ, l')]} ∪ P).
Proof.
iIntros "HP".
iMod (own_update with "HP") as "[HP Hls]".
{ eapply auth_update_alloc.
eapply (gset_local_update _ _ ({[(lo, ln, γ, l')]} ∪ P)).
apply union_subseteq_r. }
iFrame "HP".
rewrite -gset_op_union.
by iDestruct "Hls" as "[#Hls _]".
Qed.
Lemma newIsPool (P : lockPool) : (|==> ∃ γP, isPool γP P)%I.
Proof.
apply (own_alloc (● (P : lockPoolR))).
by apply auth_auth_valid.
Qed.
Instance isPool_timeless γP P : Timeless (isPool γP P).
Proof. apply _. Qed.
Instance inPool_timeless γP lo ln γ l' : Timeless (inPool γP lo ln γ l').
Proof. apply _. Qed.
Instance ticket_timeless γ n : Timeless (ticket γ n).
Proof. apply _. Qed.
Instance issuedTickets_timeless γ n : Timeless (issuedTickets γ n).
Proof. apply _. Qed.
Opaque ticket issuedTickets inPool isPool.
Opaque ticket issuedTickets.
(** * Invariants and abstracts for them *)
Definition lockInv (lo ln : loc) (γ : gname) (l' : loc) : iProp Σ :=
......@@ -156,84 +112,34 @@ Section refinement.
Instance lockInv_timeless lo ln γ l' : Timeless (lockInv lo ln γ l').
Proof. apply _. Qed.
Definition lockPoolInv (P : lockPool) : iProp Σ :=
([∗ set] rs ∈ P, match rs with
| ((lo, ln, γ), l') => lockInv lo ln γ l'
end)%I.
Instance lockPoolInv_timeless P : Timeless (lockPoolInv P).
Proof.
apply big_sepS_timeless.
intros [[[? ?] ?] ?]. apply _.
Qed.
Lemma lockPoolInv_empty : lockPoolInv ∅.
Proof. by rewrite /lockPoolInv big_sepS_empty. Qed.
Lemma lockPool_open γP (P : lockPool) (lo ln : loc) (γ : gname) (l' : loc) :
isPool γP P -∗
inPool γP lo ln γ l' -∗
lockPoolInv P -∗
isPool γP P ∗ (lockInv lo ln γ l') ∗ (lockInv lo ln γ l' -∗ lockPoolInv P).
Proof.
iIntros "HP #Hin HPinv".
iDestruct (inPool_lookup with "Hin HP") as %Hin.
rewrite /lockPoolInv.
iDestruct (big_sepS_elem_of_acc _ P _ with "HPinv") as "[Hrs Hreg]"; first apply Hin.
by iFrame.
Qed.
Lemma lockPool_insert γP (P : lockPool) (lo ln : loc) γ l' :
isPool γP P -∗
lockPoolInv P -∗
lockInv lo ln γ l' ==∗
isPool γP ({[(lo, ln, γ, l')]} ∪ P)
∗ lockPoolInv ({[(lo, ln, γ, l')]} ∪ P)
∗ inPool γP lo ln γ l'.
Proof.
iIntros "HP HPinv".
iDestruct 1 as (n o b) "(Hlo & Hln & Hissued & Hl' & Hticket)".
iMod (isPool_insert γP lo ln γ l' P with "HP") as "[$ $]".
rewrite /lockInv.
iAssert (⌜(lo, ln, γ, l') ∈ P⌝ → False)%I as %Hbaz.
{ iIntros (HP).
rewrite /lockPoolInv.
rewrite (big_sepS_elem_of _ P _ HP).
iDestruct "HPinv" as (? ? ?) "(Hlo' & Hln' & ?)".
iDestruct (mapsto_valid_2 with "Hlo' Hlo") as %Hfoo.
compute in Hfoo; contradiction. }
rewrite /lockPoolInv.
rewrite big_sepS_insert; last assumption.
iFrame. iExists _,_,_. by iFrame.
Qed.
Opaque lockPoolInv.
Definition moduleInv γp : iProp Σ :=
(∃ (P : lockPool), isPool γp P ∗ lockPoolInv P)%I.
Definition N := logrelN.@"locked".
Program Definition lockInt (γp : gname) := λne vv,
Program Definition lockInt := λne vv,
(∃ (lo ln : loc) (γ : gname) (l' : loc),
⌜vv.1 = (#lo, #ln)%V⌝ ∗ ⌜vv.2 = #l'⌝
∗ inPool γp lo ln γ l')%I.
∗ inv (N.@(lo,ln,l')) (lockInv lo ln γ l'))%I.
Next Obligation. solve_proper. Qed.
Instance lockInt_persistent γp ww : Persistent (lockInt γp ww).
(* Program Definition lockInt (γp : gname) := λne vv, *)
(* (∃ (lo ln : loc) (γ : gname) (l' : loc), *)
(* ⌜vv.1 = (#lo, #ln)%V⌝ ∗ ⌜vv.2 = #l'⌝ *)
(* ∗ inPool γp lo ln γ l')%I. *)
(* Next Obligation. solve_proper. Qed. *)
Instance lockInt_persistent ww : Persistent (lockInt ww).
Proof. apply _. Qed.
(** * Refinement proofs *)
Definition N := logrelN.@"locked".
Local Ltac openI N := iInv N as (P) ">[HP HPinv]" "Hcl".
Local Ltac openI N :=
iInv N as (o n b) ">(Hlo & Hln & Hissued & Hl' & Hbticket)" "Hcl".
Local Ltac closeI := iMod ("Hcl" with "[-]") as "_";
first by (iNext; iExists _; iFrame).
first by (iNext; iExists _,_,_; iFrame).
(* Allocating a new lock *)
Lemma newlock_refinement Δ Γ γp:
inv N (moduleInv γp) -∗
{(lockInt γp :: Δ); ⤉Γ} ⊨ newlock ≤log≤ lock.newlock : (Unit → TVar 0).
Lemma newlock_refinement Δ Γ:
{(lockInt:: Δ); ⤉Γ} ⊨ newlock ≤log≤ lock.newlock : (Unit → TVar 0).
Proof.
iIntros "#Hinv".
unlock newlock.
iApply bin_log_related_arrow_val; eauto.
{ by unlock lock.newlock. }
......@@ -247,61 +153,52 @@ Section refinement.
{ solve_ndisj. }
iIntros (l') "Hl'".
(* Establishing the invariant *)
openI N.
iMod newIssuedTickets as (γ) "Hγ".
iMod (lockPool_insert _ _ lo ln with "HP HPinv [Hlo Hln Hl' Hγ]") as "(HP & HPinv & #Hin)".
{ iExists _,_,_; by iFrame. }
closeI.
rel_vals; iModIntro; iAlways.
iExists _,_,_,_. by iFrame "Hin".
iMod (inv_alloc (N.@(lo,ln,l')) _ (lockInv lo ln γ l') with "[-]") as "#Hinv".
{ iNext. iExists _,_,_. iFrame. }
rel_vals. iModIntro. iAlways.
iExists _,_,_,_. iFrame "Hinv". eauto.
Qed.
(* Acquiring a lock *)
(* helper lemma *)
Lemma wait_loop_refinement Δ Γ γp (lo ln : loc) γ (l' : loc) (m : nat) :
inv N (moduleInv γp) -∗
inPool γp lo ln γ l' -∗ (* two locks are linked *)
Lemma wait_loop_refinement Δ Γ (lo ln : loc) γ (l' : loc) (m : nat) :
inv (N.@(lo,ln,l')) (lockInv lo ln γ l') -∗
ticket γ m -∗
{(lockInt γp :: Δ); ⤉Γ} ⊨
{(lockInt :: Δ); ⤉Γ} ⊨
wait_loop #m (#lo, #ln) ≤log≤ lock.acquire #l' : TUnit.
Proof.
iIntros "#Hinv #Hin Hticket".
iIntros "#Hinv Hticket".
rel_rec_l.
iLöb as "IH".
unlock {2}wait_loop. simpl.
rel_let_l. rel_proj_l.
rel_load_l_atomic.
openI N.
iDestruct (lockPool_open with "HP Hin HPinv") as "(HP & Hls & HPinv)".
rewrite {1}/lockInv.
iDestruct "Hls" as (o n b) "(Hlo & Hln & Hissued & Hl' & Hrest)".
openI (N.@(lo, ln, l')).
iModIntro. iExists _; iFrame; iNext.
iIntros "Hlo".
rel_op_l.
case_decide; subst; rel_if_l.
(* Whether the ticket is called out *)
- destruct b.
{ iDestruct (ticket_nondup with "Hticket Hrest") as %[]. }
{ iDestruct (ticket_nondup with "Hticket Hbticket") as %[]. }
rel_apply_r (bin_log_related_acquire_r with "Hl'").
{ solve_ndisj. }
iIntros "Hl'".
iSpecialize ("HPinv" with "[Hlo Hln Hl' Hissued Hticket]").
{ iExists _,_,_. by iFrame. }
closeI.
iApply bin_log_related_unit.
- iMod ("Hcl" with "[-Hticket]") as "_".
{ iNext. iExists P; iFrame.
iApply "HPinv". iExists _,_,_; by iFrame. }
{ iNext. iExists _,_,_; by iFrame. }
rel_rec_l.
unlock wait_loop. simpl_subst/=. by iApply "IH".
Qed.
(** Logically atomic spec for `acquire`.
Parameter type: nat
Precondition:
λo, ∃ n, lo ↦ᵢ o ∗ ln ↦ᵢ n ∗ issuedTickets γ n
Postcondition:
λo, ∃ n, lo ↦ᵢ o ∗ ln ↦ᵢ n ∗ issuedTickets γ n ∗ ticket γ o *)
(** Logically atomic spec for `acquire`. *)
(* Parameter type: nat *)
(* Precondition: *)
(* λo, ∃ n, lo ↦ᵢ o ∗ ln ↦ᵢ n ∗ issuedTickets γ n *)
(* Postcondition: *)
(* λo, ∃ n, lo ↦ᵢ o ∗ ln ↦ᵢ n ∗ issuedTickets γ n ∗ ticket γ o *)
Lemma acquire_l_logatomic R P γ Δ Γ E1 E2 K lo ln t τ :
P -∗
□ (|={E1,E2}=> ∃ o n : nat, lo ↦ᵢ #o ∗ ln ↦ᵢ #n ∗ issuedTickets γ n ∗ R o ∗
......@@ -352,11 +249,9 @@ Section refinement.
rel_rec_l. iApply ("IH" with "HP Hm").
Qed.
Lemma acquire_refinement Δ Γ γp :
inv N (moduleInv γp) -∗
{(lockInt γp :: Δ); ⤉Γ} ⊨ acquire ≤log≤ lock.acquire : (TVar 0 → Unit).
Lemma acquire_refinement Δ Γ :
{lockInt :: Δ; ⤉Γ} ⊨ acquire ≤log≤ lock.acquire : (TVar 0 → Unit).
Proof.
iIntros "#Hinv".
iApply bin_log_related_arrow_val; eauto.
{ by unlock acquire. }
{ by unlock lock.acquire. }
......@@ -368,20 +263,16 @@ Section refinement.
if b then ticket γ o else True)%I
True%I γ); first done.
iAlways.
openI N.
iDestruct (lockPool_open with "HP Hin HPinv") as "(HP & Hls & HPinv)".
rewrite {1}/lockInv.
iDestruct "Hls" as (o n b) "(Hlo & Hln & Hissued & Hl' & Hticket)".
openI (N.@(lo, ln, l')).
iModIntro. iExists _,_; iFrame.
iSplitL "Hticket Hl'".
iSplitL "Hbticket Hl'".
{ iExists _. iFrame. }
clear b o n.
iSplit.
- iDestruct 1 as (o' n') "(Hlo & Hln & Hissued & Hrest)".
iDestruct "Hrest" as (b) "[Hl' Ht]".
iApply ("Hcl" with "[-]").
iNext. iExists P; iFrame.
iApply "HPinv". iExists _,_,_. by iFrame.
iNext. iExists _,_,_. by iFrame.
- iIntros (o n) "(Hlo & Hln & Hissued & Ht & Hrest) _".
iDestruct "Hrest" as (b) "[Hl' Ht']".
destruct b.
......@@ -390,40 +281,31 @@ Section refinement.
{ solve_ndisj. }
iIntros "Hl'".
iMod ("Hcl" with "[-]") as "_".
{ iNext. iExists P; iFrame.
iApply "HPinv". iExists _,_,_; by iFrame. }
{ iNext. iExists _,_,_; by iFrame. }
iApply bin_log_related_unit.
Qed.
Lemma acquire_refinement_direct Δ Γ γp :
inv N (moduleInv γp) -∗
{(lockInt γp :: Δ); ⤉Γ} ⊨ acquire ≤log≤ lock.acquire : (TVar 0 → Unit).
Lemma acquire_refinement_direct Δ Γ :
{(lockInt :: Δ); ⤉Γ} ⊨ acquire ≤log≤ lock.acquire : (TVar 0 → Unit).
Proof.
iIntros "#Hinv".
unlock acquire; simpl.
iApply bin_log_related_arrow_val; eauto.
{ by unlock lock.acquire. }
iAlways. iIntros (? ?) "/= #Hl".
iDestruct "Hl" as (lo ln γ l') "(% & % & Hin)". simplify_eq.
rel_let_l. repeat rel_proj_l.
(* rel_rec_l. (* TODO: cannot find the reduct *) *)
rel_apply_l (bin_log_FG_increment_logatomic _ (issuedTickets γ)%I True%I); first done.
iAlways.
openI N.
iDestruct (lockPool_open with "HP Hin HPinv") as "(HP & Hls & HPinv)".
rewrite {1}/lockInv.
iDestruct "Hls" as (o n b) "(Hlo & Hln & Hissued & Hl' & Hticket)".
openI (N.@(lo, ln, l')).
iModIntro. iExists _; iFrame.
iSplit.
- iDestruct 1 as (m) "[Hln ?]".
iApply ("Hcl" with "[-]").
iNext. iExists P; iFrame.
iApply "HPinv". iExists _,_,_; by iFrame.
iNext. iExists _,_,_; by iFrame.
- iIntros (m) "[Hln Hissued] _".
iMod (issueNewTicket with "Hissued") as "[Hissued Hm]".
iMod ("Hcl" with "[-Hm]") as "_".
{ iNext. iExists P; iFrame.
iApply "HPinv". iExists _,_,_; by iFrame. }
{ iNext. iExists _,_,_; by iFrame. }
rel_let_l.
by iApply wait_loop_refinement.
Qed.
......@@ -471,11 +353,9 @@ Section refinement.
iExists _; iFrame.
Qed.
Lemma release_refinement Δ Γ γp :
inv N (moduleInv γp) -∗
{(lockInt γp :: Δ); ⤉Γ} ⊨ release ≤log≤ lock.release : (TVar 0 → Unit).
Lemma release_refinement Δ Γ :
{(lockInt :: Δ); ⤉Γ} ⊨ release ≤log≤ lock.release : (TVar 0 → Unit).
Proof.
iIntros "#Hinv".
unlock release.
iApply bin_log_related_arrow_val; eauto.
{ by unlock lock.release. }
......@@ -488,19 +368,15 @@ Section refinement.
∗ if b then ticket γ o else True)%I).
rel_apply_l (wkincr_atomic_l R True%I); first done.
iAlways.
openI N.
iDestruct (lockPool_open with "HP Hin HPinv") as "(HP & Hls & HPinv)".
rewrite {1}/lockInv.
iDestruct "Hls" as (o n b) "(Hlo & Hrest)".
openI (N.@(lo, ln, l')).
iModIntro. iExists _; iFrame.
rewrite {1}/R. iSplitL "Hrest".
{ iExists _,_; iFrame. } clear o n b.
rewrite {1}/R. iSplitR "Hcl".
{ iExists _,_; by iFrame. } clear o n b.
iSplit.
- iDestruct 1 as (o) "[Hlo HR]".
unfold R. iDestruct "HR" as (n b) "HR".
iApply "Hcl".
iNext. iExists P; iFrame.
iApply "HPinv". iExists _,_,_; by iFrame.
iNext. iExists _,_,_; by iFrame.
- iIntros (?) "[Hlo HR] _".
iDestruct "Hlo" as (o) "Hlo".
unfold R. iDestruct "HR" as (n b) "(Hln & Hissued & Hl' & Hticket)".
......@@ -508,8 +384,7 @@ Section refinement.
{ solve_ndisj. }
iIntros "Hl'".
iMod ("Hcl" with "[-]") as "_".
{ iNext. iExists P; iFrame.
iApply "HPinv". iExists _,_,_. by iFrame. }
{ iNext. iExists _,_,_. by iFrame. }
iApply bin_log_related_unit.
Qed.
......@@ -519,13 +394,10 @@ Section refinement.
Pack (lock.newlock, lock.acquire, lock.release) : lockT.
Proof.
iIntros (Δ).
iMod (newIsPool ∅) as (γp) "HP".
iMod (inv_alloc N _ (moduleInv γp) with "[HP]") as "#Hinv".
{ iNext. iExists _; iFrame. iApply lockPoolInv_empty. }
iApply (bin_log_related_pack _ (lockInt γp)).
iApply (bin_log_related_pack _ lockInt).
repeat iApply bin_log_related_pair.
- by iApply newlock_refinement.
- by iApply acquire_refinement.
- by iApply acquire_refinement_direct.
- by iApply release_refinement.
Qed.
......
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