Skip to content

GitLab

Commit 5c18c7eb authored by Zhen Zhang's avatar Zhen Zhang
Browse files
Options

redesign protocols

parent d344c353
Hide whitespace changes
Inline Side-by-side
Showing with 60 additions and 66 deletions
misc.v
View file @ 5c18c7eb
...@@ -21,12 +21,12 @@ Section lemmas. ...@@ -21,12 +21,12 @@ Section lemmas.
done. done.
Qed. Qed.
Lemma pair_l_frac_op (g g': val): Lemma pair_l_frac_op (p q: Qp) (g g': val):
((((1 / 2)%Qp, DecAgree g') ⋅ ((1 / 2)%Qp, DecAgree g'))) ~~> (1%Qp, DecAgree g'). (((p, DecAgree g') ⋅ (q, DecAgree g'))) ~~> ((p + q)%Qp, DecAgree g').
Proof. by rewrite pair_op dec_agree_idemp frac_op' Qp_div_2. Qed. Proof. by rewrite pair_op dec_agree_idemp frac_op'. Qed.
Lemma pair_l_frac_op' (g g': val): Lemma pair_l_frac_op' (p q: Qp) (g g': val):
(1%Qp, DecAgree g') ~~> ((((1 / 2)%Qp, DecAgree g') ⋅ ((1 / 2)%Qp, DecAgree g'))). ((p + q)%Qp, DecAgree g') ~~> (((p, DecAgree g') ⋅ (q, DecAgree g'))).
Proof. by rewrite pair_op dec_agree_idemp frac_op' Qp_div_2. Qed. Proof. by rewrite pair_op dec_agree_idemp frac_op'. Qed.
End lemmas. End lemmas.
srv.v
View file @ 5c18c7eb
...@@ -60,52 +60,42 @@ Section proof. ...@@ -60,52 +60,42 @@ Section proof.
Context `{!heapG Σ, !lockG Σ, !srvG Σ} (N : namespace). Context `{!heapG Σ, !lockG Σ, !srvG Σ} (N : namespace).
Definition srv_inv Definition srv_inv
(γx γ1 γ2 γ3 γ4 γ5: gname) (p: loc) (γx γ1 γ2 γ3 γ4: gname) (p: loc)
(Q: val → val → Prop): iProp Σ := (Q: val → val → Prop): iProp Σ :=
((∃ (x: val), p ↦ InjRV x ★ own γ1 (Excl ()) ★ own γ3 (Excl ())) ∨ ((∃ (y: val), p ↦ InjRV y ★ own γ1 (Excl ()) ★ own γ3 (Excl ())) ∨
(∃ (x y: val), p ↦ InjRV y ★ own γx ((1/2)%Qp, DecAgree x) ★ ■ Q x y ★ own γ2 (Excl ()) ★ own γ3 (Excl ())) ∨ (∃ (x: val), p ↦ InjLV x ★ own γx ((1/2)%Qp, DecAgree x) ★ own γ1 (Excl ()) ★ own γ4 (Excl ())) ∨
(∃ (x: val), p ↦ InjLV x ★ own γx ((1/2)%Qp, DecAgree x) ★ own γ5 (Excl ()) ★ own γ3 (Excl ())) ∨ (∃ (x: val), p ↦ InjLV x ★ own γx ((1/4)%Qp, DecAgree x) ★ own γ2 (Excl ()) ★ own γ4 (Excl ())) ∨
(∃ (x: val), p ↦ InjLV x ★ own γx ((1/2)%Qp, DecAgree x) ★ own γ5 (Excl ()) ★ own γ4 (Excl ())))%I. (∃ (x y: val), p ↦ InjRV y ★ own γx ((1/2)%Qp, DecAgree x) ★ ■ Q x y ★ own γ1 (Excl ()) ★ own γ4 (Excl ())))%I.
Lemma srv_inv_timeless γx γ1 γ2 γ3 γ4 γ5 p Q: TimelessP (srv_inv γx γ1 γ2 γ3 γ4 γ5 p Q). Lemma srv_inv_timeless γx γ1 γ2 γ3 γ4 p Q: TimelessP (srv_inv γx γ1 γ2 γ3 γ4 p Q).
Proof. apply _. Qed. Proof. apply _. Qed.
Lemma wait_spec (Φ: val → iProp Σ) (Q: val → val → Prop) x γx γ1 γ2 γ3 γ4 γ5 p: Lemma wait_spec (Φ: val → iProp Σ) (Q: val → val → Prop) x γx γ1 γ2 γ3 γ4 p:
heapN ⊥ N → heapN ⊥ N →
heap_ctx ★ inv N (srv_inv γx γ1 γ2 γ3 γ4 γ5 p Q) ★ heap_ctx ★ inv N (srv_inv γx γ1 γ2 γ3 γ4 p Q) ★
own γx ((1/2)%Qp, DecAgree x) ★ own γ1 (Excl ()) ★ own γ5 (Excl ()) ★ own γx ((1/2)%Qp, DecAgree x) ★ own γ3 (Excl ()) ★
(∀ y, own γ2 (Excl ()) -★ own γx (1%Qp, DecAgree x) -★ ■ Q x y-★ Φ y) (∀ y, own γ4 (Excl ()) -★ own γx (1%Qp, DecAgree x) -★ ■ Q x y-★ Φ y)
⊢ WP wait #p {{ Φ }}. ⊢ WP wait #p {{ Φ }}.
Proof. Proof.
iIntros (HN) "(#Hh & #Hsrv & Hx & Hempty & Hfinished & HΦ)". iIntros (HN) "(#Hh & #Hsrv & Hx & Ho3 & HΦ)".
iLöb as "IH". iLöb as "IH".
wp_rec. wp_bind (! #p)%E. wp_rec. wp_bind (! #p)%E.
iInv N as ">[Hinv|[Hinv|[Hinv|Hinv]]]" "Hclose". iInv N as ">[Hinv|[Hinv|[Hinv|Hinv]]]" "Hclose".
- iExFalso. iDestruct "Hinv" as (?) "[_ [Ho1 _]]". - iExFalso. iDestruct "Hinv" as (?) "[_ [_ Ho3']]".
iCombine "Hempty" "Ho1" as "Hempty". iCombine "Ho3" "Ho3'" as "Ho3".
by iDestruct (own_valid with "Hempty") as "%". by iDestruct (own_valid with "Ho3") as "%".
- iDestruct "Hinv" as (x' y') "(Hp & Hx' & % & Ho2 & Ho3)". - admit.
- admit.
- iDestruct "Hinv" as (x' y') "(Hp & Hx' & % & Ho1 & Ho4)".
destruct (decide (x = x')) as [->|Hneq]. destruct (decide (x = x')) as [->|Hneq].
+ wp_load. iVs ("Hclose" with "[Hp Hx' Ho2 Ho3]"). + wp_load. iVs ("Hclose" with "[Hp Ho1 Ho3]").
{ iNext. rewrite /srv_inv. iRight. iLeft. iExists x', y'. { iNext. rewrite /srv_inv. iLeft. iExists y'. by iFrame. }
by iFrame. }
iVsIntro. wp_match. iVsIntro. wp_match.
iInv N as ">[Hinv|[Hinv|[Hinv|Hinv]]]" "Hclose". iCombine "Hx" "Hx'" as "Hx".
* admit. iDestruct (own_update with "Hx") as "==>Hx"; first by apply pair_l_frac_op.
* iDestruct "Hinv" as (x'' y'') "(Hp & Hx'' & % & Ho2 & Ho3)". rewrite Qp_div_2.
iVs ("Hclose" with "[Hp Hempty Ho3]"). iApply ("HΦ" with "Ho4 Hx"). done.
{ iNext. rewrite /srv_inv. iLeft.
iExists y''. by iFrame. }
destruct (decide (x' = x'')) as [->|Hneq].
{ iCombine "Hx" "Hx''" as "Hx".
iDestruct (own_update with "Hx") as "==>Hx"; first by apply pair_l_frac_op.
by iApply ("HΦ" with "Ho2 Hx"). }
{ admit. }
* admit.
* admit.
+ admit. + admit.
- admit.
- admit.
Admitted. Admitted.
Lemma mk_srv_spec (f: val) Q: Lemma mk_srv_spec (f: val) Q:
...@@ -115,23 +105,20 @@ Section proof. ...@@ -115,23 +105,20 @@ Section proof.
Proof. Proof.
iIntros (HN) "[#Hh #Hf]". iIntros (HN) "[#Hh #Hf]".
wp_let. wp_alloc p as "Hp". wp_let. wp_alloc p as "Hp".
iVs (own_alloc (Excl ())) as (γ1) "Hempty"; first done. iVs (own_alloc (Excl ())) as (γ1) "Ho1"; first done.
iVs (own_alloc (Excl ())) as (γ2) "Hissued"; first done. iVs (own_alloc (Excl ())) as (γ2) "Ho2"; first done.
iVs (own_alloc (Excl ())) as (γ3) "Hblack"; first done. iVs (own_alloc (Excl ())) as (γ3) "Ho3"; first done.
iVs (own_alloc (Excl ())) as (γ4) "Hwhite"; first done. iVs (own_alloc (Excl ())) as (γ4) "Ho4"; first done.
iVs (own_alloc (Excl ())) as (γ5) "Hfinished"; first done.
iVs (own_alloc (1%Qp, DecAgree #0)) as (γx) "Hx"; first done. iVs (own_alloc (1%Qp, DecAgree #0)) as (γx) "Hx"; first done.
iVs (inv_alloc N _ (srv_inv γx γ1 γ2 γ3 γ4 γ5 p Q) with "[Hp Hempty Hblack]") as "#?". iVs (inv_alloc N _ (srv_inv γx γ1 γ2 γ3 γ4 p Q) with "[Hp Ho1 Ho3]") as "#?".
{ iNext. rewrite /srv_inv. iLeft. iExists #0. by iFrame. } { iNext. rewrite /srv_inv. iLeft. iExists #0. by iFrame. }
(* iVs (inv_alloc N _ (own γ3 (Excl ()) ∨ own γ4 (Excl ()))%I with "[Hwhite]") as "#Hsinv". *)
(* { iNext. by iRight. } *)
wp_let. wp_bind (newlock _). wp_let. wp_bind (newlock _).
iApply newlock_spec=>//. iFrame "Hh". iApply newlock_spec=>//. iFrame "Hh".
iAssert (∃ x, own γx (1%Qp, DecAgree x) ★ own γ2 (Excl ()) ★ own γ5 (Excl ()))%I with "[Hissued Hfinished Hx]" as "Hinv". iAssert (∃ x, own γx (1%Qp, DecAgree x) ★ own γ4 (Excl ()))%I with "[Ho4 Hx]" as "Hinv".
{ iExists #0. by iFrame. } { iExists #0. by iFrame. }
iFrame "Hinv". iIntros (lk γlk) "#Hlk". iFrame "Hinv". iIntros (lk γlk) "#Hlk".
wp_let. wp_apply wp_fork. wp_let. wp_apply wp_fork.
iSplitR "Hwhite". iSplitR "Ho2".
- (* (* client closure *) *) - (* (* client closure *) *)
(* iVsIntro. wp_seq. iVsIntro. *) (* iVsIntro. wp_seq. iVsIntro. *)
(* iAlways. iIntros (x). *) (* iAlways. iIntros (x). *)
...@@ -176,26 +163,33 @@ Section proof. ...@@ -176,26 +163,33 @@ Section proof.
iLöb as "IH". iLöb as "IH".
wp_rec. wp_let. wp_bind (! _)%E. wp_rec. wp_let. wp_bind (! _)%E.
iInv N as ">[Hinv|[Hinv|[Hinv|Hinv]]]" "Hclose". iInv N as ">[Hinv|[Hinv|[Hinv|Hinv]]]" "Hclose".
+ iDestruct "Hinv" as (x) "[Hp Hrest]". + admit.
wp_load. iVs ("Hclose" with "[Hp Hrest]"). + iDestruct "Hinv" as (x) "(Hp & Hx & Ho1 & Ho4)".
{ iNext. rewrite /srv_inv. iLeft. iExists x. by iFrame. } iAssert (|=r=> own γx (((1 / 4)%Qp, DecAgree x) ⋅ ((1 / 4)%Qp, DecAgree x)))%I with "[Hx]" as "==>[Hx1 Hx2]".
iVsIntro. wp_match. by iApply "IH". { iDestruct (own_update with "Hx") as "Hx"; last by iAssumption.
+ iDestruct "Hinv" as (x y) "[Hp Hrest]". replace ((1 / 2)%Qp) with (1/4 + 1/4)%Qp; last by apply Qp_div_S.
wp_load. iVs ("Hclose" with "[Hp Hrest]"). by apply pair_l_frac_op'. }
{ iNext. rewrite /srv_inv. iRight. iLeft. iExists x, y. by iFrame. } wp_load.
iVsIntro. wp_match. by iApply "IH". iVs ("Hclose" with "[Hp Hx1 Ho2 Ho4]").
+ iDestruct "Hinv" as (x) "(Hp & Hx & Hfinished & Hblack)". { iNext. iRight. iRight. iLeft. iExists x. by iFrame. }
wp_load. iVs ("Hclose" with "[Hp Hx Hfinished Hwhite]").
{ iNext. rewrite /srv_inv. iRight. iRight. iRight. iExists x. by iFrame. }
iVsIntro. wp_match. iVsIntro. wp_match.
wp_bind (_ <- _)%E. wp_bind (f x).
iApply pvs_wp. iApply wp_wand_r. iSplitR; first by iApply "Hf".
iIntros (y) "%".
wp_value. iVsIntro. wp_bind (_ <- _)%E.
iInv N as ">[Hinv|[Hinv|[Hinv|Hinv]]]" "Hclose". iInv N as ">[Hinv|[Hinv|[Hinv|Hinv]]]" "Hclose".
* admit. * admit.
* admit. * admit.
* iDestruct "Hinv" as (x') "(Hp & Hx' & Ho2 & Ho4)".
destruct (decide (x = x')) as [->|Hneq]; last by admit.
wp_store. iCombine "Hx2" "Hx'" as "Hx".
iDestruct (own_update with "Hx") as "==>Hx"; first by apply pair_l_frac_op.
rewrite Qp_div_S.
iVs ("Hclose" with "[Hp Hx Ho1 Ho4]").
{ iNext. rewrite /srv_inv. iRight. iRight. iRight.
iExists x', y. by iFrame. }
iVsIntro. wp_seq. iApply ("IH" with "Ho2").
* admit. * admit.
* iDestruct "Hinv" as (x') "(Hp & Hx & Hfinished & Hwhite)". + admit.
iVs ("Hclose" with "[Hp Hx Hfinished Hblack]"). + admit.
Admitted. Admitted.
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