Commit 79caa21f authored by Ralf Jung's avatar Ralf Jung
Browse files

Simplify sequential syncer; use Texan triples

requires a new Iris version
parent 6396d121
05a588df59ddfdc2e7a4aec5a98a50614c819693 6cb76aaaf15d46c74c2a779f1e4e1ca1a53c0838
...@@ -46,7 +46,7 @@ Section incr. ...@@ -46,7 +46,7 @@ Section incr.
iSpecialize ("Hvs'" $! #x'). iSpecialize ("Hvs'" $! #x').
wp_cas_suc. wp_cas_suc.
iMod ("Hvs'" with "[Hl]") as "HQ"; first by iFrame. iMod ("Hvs'" with "[Hl]") as "HQ"; first by iFrame.
iModIntro. wp_if. iModIntro. by iExists x'. iModIntro. wp_if. by iExists x'.
- iDestruct "Hvs'" as "[Hvs' _]". - iDestruct "Hvs'" as "[Hvs' _]".
wp_cas_fail. wp_cas_fail.
iMod ("Hvs'" with "[Hl]") as "HP"; first by iFrame. iMod ("Hvs'" with "[Hl]") as "HP"; first by iFrame.
......
...@@ -35,11 +35,11 @@ Section atomic_pair. ...@@ -35,11 +35,11 @@ Section atomic_pair.
Lemma pcas_seq_spec: seq_spec N pcas_seq ϕ α β . Lemma pcas_seq_spec: seq_spec N pcas_seq ϕ α β .
Proof. Proof.
iIntros (_ l) "!# _". wp_seq. iModIntro. iPureIntro. iIntros (_ l) "!# _". wp_seq. iPureIntro.
iIntros (x Φ g HN) "(#Hh & Hg & #Hα & HΦ)". iIntros (x Φ g HN) "(#Hh & Hg & #Hα & HΦ)".
iDestruct "Hg" as (l1 l2 x1 x2) "(% & % & Hl1 & Hl2)". iDestruct "Hg" as (l1 l2 x1 x2) "(% & % & Hl1 & Hl2)".
iDestruct "Hα" as (a b) "%". iDestruct "Hα" as (a b) "%".
subst. simpl. wp_let. wp_proj. wp_load. wp_proj. subst. simpl. iApply wp_fupd. wp_let. wp_proj. wp_load. wp_proj.
wp_op=>[?|Hx1na]. wp_op=>[?|Hx1na].
- subst. - subst.
wp_if. wp_proj. wp_load. wp_proj. wp_if. wp_proj. wp_load. wp_proj.
......
...@@ -57,10 +57,9 @@ Section atomic_sync. ...@@ -57,10 +57,9 @@ Section atomic_sync.
iMod (own_alloc (((1 / 2)%Qp, DecAgree g0) ((1 / 2)%Qp, DecAgree g0))) as (γ) "[Hg1 Hg2]". iMod (own_alloc (((1 / 2)%Qp, DecAgree g0) ((1 / 2)%Qp, DecAgree g0))) as (γ) "[Hg1 Hg2]".
{ by rewrite pair_op dec_agree_idemp. } { by rewrite pair_op dec_agree_idemp. }
repeat wp_let. wp_bind (mk_syncer _). repeat wp_let. wp_bind (mk_syncer _).
iApply (Hsync ( g: A, ϕ l g gHalf γ g)%I)=>//. iFrame "Hh". iApply (Hsync ( g: A, ϕ l g gHalf γ g)%I with "[$Hh Hg1 Hϕ]")=>//.
iSplitL "Hg1 Hϕ".
{ iExists g0. by iFrame. } { iExists g0. by iFrame. }
iIntros (s) "#Hsyncer". iNext. iIntros (s) "#Hsyncer".
wp_let. wp_bind (f_seq _). iApply wp_wand_r. wp_let. wp_bind (f_seq _). iApply wp_wand_r.
iSplitR; first iApply Hseq=>//; auto. iSplitR; first iApply Hseq=>//; auto.
iIntros (f) "%". iIntros (f) "%".
...@@ -70,7 +69,7 @@ Section atomic_sync. ...@@ -70,7 +69,7 @@ Section atomic_sync.
iExists γ. iFrame. iExists γ. iFrame.
iIntros (x). iAlways. iIntros (x). iAlways.
iIntros (P Q) "#Hvss". iIntros (P Q) "#Hvss".
iSpecialize ("Hsynced" $! P Q x). iSpecialize ("Hsynced" $! (P x) (Q x) x).
iIntros "!# HP". iApply wp_wand_r. iSplitL "HP". iIntros "!# HP". iApply wp_wand_r. iSplitL "HP".
- iApply ("Hsynced" with "[]")=>//. - iApply ("Hsynced" with "[]")=>//.
iAlways. iIntros "[HR HP]". iDestruct "HR" as (g) "[Hϕ Hg1]". iAlways. iIntros "[HR HP]". iDestruct "HR" as (g) "[Hϕ Hg1]".
......
...@@ -130,9 +130,9 @@ Section proof. ...@@ -130,9 +130,9 @@ Section proof.
by iApply "HΦ". by iApply "HΦ".
Qed. Qed.
Definition installed_recp (ts: toks) (x: val) (Q: val val iProp Σ) := Definition installed_recp (ts: toks) (x: val) (Q: val iProp Σ) :=
let '(γx, _, γ3, _, γq) := ts in let '(γx, _, γ3, _, γq) := ts in
(own γ3 (Excl ()) own γx ((1/2)%Qp, DecAgree x) saved_prop_own γq (Q x))%I. (own γ3 (Excl ()) own γx ((1/2)%Qp, DecAgree x) saved_prop_own γq Q)%I.
Lemma install_spec Lemma install_spec
R P Q R P Q
...@@ -140,7 +140,7 @@ Section proof. ...@@ -140,7 +140,7 @@ Section proof.
(Φ: val iProp Σ): (Φ: val iProp Σ):
heapN N heapN N
heap_ctx inv N (srv_stack_inv R γs γm γr s srv_tokm_inv γm) heap_ctx inv N (srv_stack_inv R γs γm γr s srv_tokm_inv γm)
P x ({{ R P x }} f x {{ v, R Q x v }}) P ({{ R P }} f x {{ v, R Q v }})
( (p: loc) (ts: toks), installed_recp ts x Q - evm γm p ts -( hd, evs γs hd #p) - Φ #p) ( (p: loc) (ts: toks), installed_recp ts x Q - evm γm p ts -( hd, evs γs hd #p) - Φ #p)
WP install f x #s {{ Φ }}. WP install f x #s {{ Φ }}.
Proof. Proof.
...@@ -151,7 +151,7 @@ Section proof. ...@@ -151,7 +151,7 @@ Section proof.
iMod (own_alloc (Excl ())) as (γ3) "Ho3"; first done. iMod (own_alloc (Excl ())) as (γ3) "Ho3"; first done.
iMod (own_alloc (Excl ())) as (γ4) "Ho4"; first done. iMod (own_alloc (Excl ())) as (γ4) "Ho4"; first done.
iMod (own_alloc (1%Qp, DecAgree x)) as (γx) "Hx"; first done. iMod (own_alloc (1%Qp, DecAgree x)) as (γx) "Hx"; first done.
iMod (saved_prop_alloc (F:=(cofe_funCF val idCF)) (Q x)%I) as (γq) "#?". iMod (saved_prop_alloc (F:=(cofe_funCF val idCF)) Q) as (γq) "#?".
iInv N as "[Hrs >Hm]" "Hclose". iInv N as "[Hrs >Hm]" "Hclose".
iDestruct "Hm" as (m) "[Hm HRm]". iDestruct "Hm" as (m) "[Hm HRm]".
destruct (m !! p) eqn:Heqn. destruct (m !! p) eqn:Heqn.
...@@ -170,8 +170,10 @@ Section proof. ...@@ -170,8 +170,10 @@ Section proof.
iApply install_push_spec=>//. iApply install_push_spec=>//.
iFrame "#". rewrite /evm /installed_s. iFrame. iFrame "#". rewrite /evm /installed_s. iFrame.
iSplitL "Hpx Hf". iSplitL "Hpx Hf".
{ iExists P, Q. by iFrame. } { (* TODO: Something somewhere can be simplified so that we don't have
iIntros "Hhd". wp_seq. iModIntro. to add these dummy arguments any more. *)
iExists (fun _ => P), (fun _ => Q). by iFrame. }
iIntros "Hhd". wp_seq.
iSpecialize ("HΦ" $! p (γx, γ1, γ3, γ4, γq) with "[-Hhd]")=>//. iSpecialize ("HΦ" $! p (γx, γ1, γ3, γ4, γq) with "[-Hhd]")=>//.
{ rewrite /installed_recp. iFrame. iFrame "#". } { rewrite /installed_recp. iFrame. iFrame "#". }
by iApply ("HΦ" with "[]"). by iApply ("HΦ" with "[]").
...@@ -206,7 +208,7 @@ Section proof. ...@@ -206,7 +208,7 @@ Section proof.
iFrame "Hom". iDestruct (big_sepM_delete _ m with "[-]") as "?"=>//. iFrame "Hom". iDestruct (big_sepM_delete _ m with "[-]") as "?"=>//.
iFrame. iExists #p''. iSplitR; first done. iExists ts, p''. iFrame. iExists #p''. iSplitR; first done. iExists ts, p''.
iSplitR; first done. iFrame "#". iLeft. iExists y. iFrame. } iSplitR; first done. iFrame "#". iLeft. iExists y. iFrame. }
iModIntro. wp_match. iModIntro. iApply ("HΦ'" with "[Hor HR]"). iFrame. iModIntro. wp_match. iApply ("HΦ'" with "[Hor HR]"). iFrame.
+ iDestruct "Hp" as (f' x') "(Hp & Hs)". + iDestruct "Hp" as (f' x') "(Hp & Hs)".
wp_load. destruct ts as [[[[γx γ1] γ3] γ4] γq]. wp_load. destruct ts as [[[[γx γ1] γ3] γ4] γq].
iDestruct "Hs" as (P Q) "(Hx & Hpx & Hf' & HoQ & Ho1 & Ho4)". iDestruct "Hs" as (P Q) "(Hx & Hpx & Hf' & HoQ & Ho1 & Ho4)".
...@@ -227,7 +229,7 @@ Section proof. ...@@ -227,7 +229,7 @@ Section proof.
wp_bind (f' _). iApply wp_wand_r. iSplitL "Hpx Hf' HR". wp_bind (f' _). iApply wp_wand_r. iSplitL "Hpx Hf' HR".
{ iApply "Hf'". iFrame. } { iApply "Hf'". iFrame. }
iIntros (v) "[HR HQ]". iIntros (v) "[HR HQ]".
wp_value. iModIntro. iInv N as "[Hs >Hm]" "Hclose". wp_value. iInv N as "[Hs >Hm]" "Hclose".
iDestruct "Hs" as (xs'' hd''') "[>Hhd [>Hxs HRs]]". iDestruct "Hs" as (xs'' hd''') "[>Hhd [>Hxs HRs]]".
iDestruct "HRs" as (m') "[>Hom HRs]". iDestruct "HRs" as (m') "[>Hom HRs]".
iDestruct (ev_map_witness _ _ _ m' with "[Hevm Hom]") as %?; first by iFrame. iDestruct (ev_map_witness _ _ _ m' with "[Hevm Hom]") as %?; first by iFrame.
...@@ -304,8 +306,8 @@ Section proof. ...@@ -304,8 +306,8 @@ Section proof.
Proof. Proof.
iIntros (?) "(#? & #? & #? & HΦ)". iIntros (?) "(#? & #? & #? & HΦ)".
wp_seq. wp_let. wp_seq. wp_let.
wp_bind (try_acquire _). iApply try_acquire_spec. wp_bind (try_acquire _). iApply (try_acquire_spec with "[]"); first done.
iFrame "#". iNext. iIntros ([]); last by (iIntros; wp_if). iNext. iIntros ([]); last by (iIntros; wp_if).
(* acquired the lock *) (* acquired the lock *)
iIntros "[Hlocked [Ho2 HR]]". iIntros "[Hlocked [Ho2 HR]]".
wp_if. wp_bind (! _)%E. wp_if. wp_bind (! _)%E.
...@@ -320,8 +322,8 @@ Section proof. ...@@ -320,8 +322,8 @@ Section proof.
{ iApply (loop_iter_doOp_spec R _ _ _ _ _ _ (fun v => own γr (Excl ()) R v = #()))%I=>//. { iApply (loop_iter_doOp_spec R _ _ _ _ _ _ (fun v => own γr (Excl ()) R v = #()))%I=>//.
iFrame "#". iFrame. iIntros "? ?". by iFrame. } iFrame "#". iFrame. iIntros "? ?". by iFrame. }
iIntros (f') "[Ho [HR %]]". subst. iIntros (f') "[Ho [HR %]]". subst.
wp_let. iApply release_spec. iFrame "#". wp_let. iApply (release_spec with "[Hlocked Ho HR]"); first iFrame "#".
iFrame. iNext. iIntros. done. iNext. iIntros. done.
Qed. Qed.
Lemma loop_spec R (p s: loc) (lk: val) Lemma loop_spec R (p s: loc) (lk: val)
...@@ -390,20 +392,20 @@ Section proof. ...@@ -390,20 +392,20 @@ Section proof.
Lemma mk_flat_spec: mk_syncer_spec N mk_flat. Lemma mk_flat_spec: mk_syncer_spec N mk_flat.
Proof. Proof.
iIntros (R Φ HN) "(#Hh & HR &)". iIntros (R HN Φ) "(#Hh & HR) HΦ".
iMod (own_alloc (Excl ())) as (γr) "Ho2"; first done. iMod (own_alloc (Excl ())) as (γr) "Ho2"; first done.
iMod (own_alloc ( (: tokmR) )) as (γm) "[Hm _]"; first by rewrite -auth_both_op. iMod (own_alloc ( (: tokmR) )) as (γm) "[Hm _]"; first by rewrite -auth_both_op.
iAssert (srv_tokm_inv γm) with "[Hm]" as "Hm"; first eauto. iAssert (srv_tokm_inv γm) with "[Hm]" as "Hm"; first eauto.
{ iExists . iFrame. by rewrite big_sepM_empty. } { iExists . iFrame. by rewrite big_sepM_empty. }
wp_seq. wp_bind (newlock _). wp_seq. wp_bind (newlock _).
iApply (newlock_spec _ (own γr (Excl ()) R))%I=>//. iApply (newlock_spec _ (own γr (Excl ()) R)%I with "[$Hh $Ho2 $HR]")=>//.
iFrame "Hh Ho2 HR". iNext. iIntros (lk γlk) "#Hlk". iNext. iIntros (lk γlk) "#Hlk".
wp_let. wp_bind (new_stack _). wp_let. wp_bind (new_stack _).
iApply (new_stack_spec' _ (p_inv _ γm γr))=>//. iApply (new_stack_spec' _ (p_inv _ γm γr))=>//.
iFrame "Hh Hm". iIntros (γ s) "#Hss". iFrame "Hh Hm". iIntros (γ s) "#Hss".
wp_let. iModIntro. iApply "HΦ". rewrite /synced. wp_let. iApply "HΦ". rewrite /synced.
iAlways. iAlways.
iIntros (f). wp_let. iModIntro. iAlways. iIntros (f). wp_let. iAlways.
iIntros (P Q x) "#Hf". iIntros (P Q x) "#Hf".
iIntros "!# Hp". wp_let. iIntros "!# Hp". wp_let.
wp_bind (install _ _ _). wp_bind (install _ _ _).
......
...@@ -92,7 +92,7 @@ Lemma new_stack_spec' Φ RI: ...@@ -92,7 +92,7 @@ Lemma new_stack_spec' Φ RI:
heap_ctx RI ( γ s : loc, inv N (( xs, is_stack' R γ xs s) RI) - Φ #s) heap_ctx RI ( γ s : loc, inv N (( xs, is_stack' R γ xs s) RI) - Φ #s)
WP new_stack #() {{ Φ }}. WP new_stack #() {{ Φ }}.
Proof. Proof.
iIntros (HN) "(#Hh & HR & HΦ)". iIntros (HN) "(#Hh & HR & HΦ)". iApply wp_fupd.
iMod (own_alloc ( (: evmapR loc val unitR) )) as (γ) "[Hm Hm']". iMod (own_alloc ( (: evmapR loc val unitR) )) as (γ) "[Hm Hm']".
{ apply auth_valid_discrete_2. done. } { apply auth_valid_discrete_2. done. }
wp_seq. wp_bind (ref NONE)%E. wp_alloc l as "Hl". wp_seq. wp_bind (ref NONE)%E. wp_alloc l as "Hl".
...@@ -115,10 +115,10 @@ Lemma new_stack_spec' Φ RI: ...@@ -115,10 +115,10 @@ Lemma new_stack_spec' Φ RI:
induction xs as [|x xs' IHxs']. induction xs as [|x xs' IHxs'].
- simpl. iIntros (hd f f' HN ? ?) "(#Hh & #? & Hxs1 & HRf & HΦ)". - simpl. iIntros (hd f f' HN ? ?) "(#Hh & #? & Hxs1 & HRf & HΦ)".
iDestruct "Hxs1" as (q) "Hhd". iDestruct "Hxs1" as (q) "Hhd".
wp_rec. wp_value. iModIntro. wp_let. wp_load. wp_match. by iApply "HΦ". wp_rec. wp_value. wp_let. wp_load. wp_match. by iApply "HΦ".
- simpl. iIntros (hd f f' HN Hf ?) "(#Hh & #? & Hxs1 & HRf & HΦ)". - simpl. iIntros (hd f f' HN Hf ?) "(#Hh & #? & Hxs1 & HRf & HΦ)".
iDestruct "Hxs1" as (hd2 q) "(Hhd & Hev & Hhd2)". iDestruct "Hxs1" as (hd2 q) "(Hhd & Hev & Hhd2)".
wp_rec. wp_value. iModIntro. wp_let. wp_load. wp_match. wp_proj. wp_rec. wp_value. wp_let. wp_load. wp_match. wp_proj.
wp_bind (f' _). iApply Hf=>//. iFrame "#". wp_bind (f' _). iApply Hf=>//. iFrame "#".
iSplitL "Hev"; first eauto. iFrame. iIntros "HRf". iSplitL "Hev"; first eauto. iFrame. iIntros "HRf".
wp_seq. wp_proj. iApply (IHxs' with "[-]")=>//. wp_seq. wp_proj. iApply (IHxs' with "[-]")=>//.
......
...@@ -23,20 +23,19 @@ Section syncer. ...@@ -23,20 +23,19 @@ Section syncer.
Lemma mk_sync_spec: mk_syncer_spec N mk_sync. Lemma mk_sync_spec: mk_syncer_spec N mk_sync.
Proof. Proof.
iIntros (R Φ HN) "(#Hh & HR &)". iIntros (R HN Φ) "(#Hh & HR) HΦ".
wp_seq. wp_bind (newlock _). wp_seq. wp_bind (newlock _).
iApply newlock_spec; first done. iApply (newlock_spec _ R with "[$Hh $HR]"); first done. iNext.
iSplitL "HR"; first by iFrame. iNext.
iIntros (lk γ) "#Hl". wp_let. iApply "HΦ". iIntros "!#". iIntros (lk γ) "#Hl". wp_let. iApply "HΦ". iIntros "!#".
iIntros (f). wp_let. iModIntro. iAlways. iIntros (f). wp_let. iAlways.
iIntros (P Q x) "#Hf !# HP". iIntros (P Q x) "#Hf !# HP".
wp_let. wp_bind (acquire _). wp_let. wp_bind (acquire _).
iApply acquire_spec. iSplit; first done. iNext. iApply (acquire_spec with "Hl"). iNext.
iIntros "[Hlocked R]". wp_seq. wp_bind (f _). iIntros "[Hlocked R]". wp_seq. wp_bind (f _).
iDestruct ("Hf" with "[R HP]") as "Hf'"; first by iFrame. iSpecialize ("Hf" with "[R HP]"); first by iFrame.
iApply wp_wand_r. iSplitL "Hf'"; first done. iApply wp_wand_r. iSplitL "Hf"; first done.
iIntros (v') "[HR HQv]". wp_let. wp_bind (release _). iIntros (v') "[HR HQv]". wp_let. wp_bind (release _).
iApply release_spec. iFrame "HR Hl Hlocked". iApply (release_spec with "[$HR $Hl $Hlocked]").
iNext. iIntros "_". by wp_seq. iNext. iIntros "_". by wp_seq.
Qed. Qed.
End syncer. End syncer.
...@@ -7,15 +7,22 @@ From iris.heap_lang Require Import proofmode notation. ...@@ -7,15 +7,22 @@ From iris.heap_lang Require Import proofmode notation.
Section sync. Section sync.
Context `{!heapG Σ} (N : namespace). Context `{!heapG Σ} (N : namespace).
Definition synced R (f' f: val) := (* TODO: We could get rid of the x, and hard-code a unit. That would
( P Q (x: val), ({{ R P x }} f x {{ v, R Q x v }}) be no loss in expressiveness, but probably more annoying to apply.
({{ P x }} f' x {{ v, Q x v }}))%I. How much more annoying? And how much to we gain in terms of things
becomign easier to prove? *)
Definition synced R (f f': val) :=
( P Q (x: val), {{ R P }} f x {{ v, R Q v }}
{{ P }} f' x {{ Q }})%I.
(* Notice that `s f` is *unconditionally safe* to execute, and only
when executing the returned f' we have to provide a spec for f.
This is crucial. *)
(* TODO: Use our usual style with a generic post-condition. *)
Definition is_syncer (R: iProp Σ) (s: val) := Definition is_syncer (R: iProp Σ) (s: val) :=
( (f : val), WP s f {{ f', synced R f' f }})%I. ( (f : val), WP s f {{ f', synced R f f' }})%I.
Definition mk_syncer_spec (mk_syncer: val) := Definition mk_syncer_spec (mk_syncer: val) :=
(R: iProp Σ) (Φ: val -> iProp Σ), (R: iProp Σ), heapN N
heapN N {{{ heap_ctx R }}} mk_syncer #() {{{ s, RET s; is_syncer R s }}}.
heap_ctx R ( s, is_syncer R s - Φ s) WP mk_syncer #() {{ Φ }}.
End sync. End sync.
...@@ -133,7 +133,7 @@ Section proof. ...@@ -133,7 +133,7 @@ Section proof.
* wp_cas_suc. iDestruct "Hvs'" as "[_ Hvs']". * wp_cas_suc. iDestruct "Hvs'" as "[_ Hvs']".
iMod ("Hvs'" $! #() with "[-]") as "HQ". iMod ("Hvs'" $! #() with "[-]") as "HQ".
{ iExists l. iSplitR; first done. by iFrame. } { iExists l. iSplitR; first done. by iFrame. }
iModIntro. wp_if. iModIntro. eauto. iModIntro. wp_if. eauto.
* wp_cas_fail. * wp_cas_fail.
iDestruct "Hvs'" as "[Hvs' _]". iDestruct "Hvs'" as "[Hvs' _]".
iMod ("Hvs'" with "[-]") as "HP"; first by iFrame. iMod ("Hvs'" with "[-]") as "HP"; first by iFrame.
...@@ -167,7 +167,7 @@ Section proof. ...@@ -167,7 +167,7 @@ Section proof.
iMod ("Hvs'" $! NONEV with "[-Hhd]") as "HQ". iMod ("Hvs'" $! NONEV with "[-Hhd]") as "HQ".
{ iLeft. iSplit=>//. iSplit=>//. iFrame. eauto. } { iLeft. iSplit=>//. iSplit=>//. iFrame. eauto. }
iModIntro. wp_let. wp_load. wp_match. iModIntro. wp_let. wp_load. wp_match.
iModIntro. eauto. eauto.
- simpl. iDestruct "Hhd" as (hd' q) "([[Hhd1 Hhd2] Hhd'] & Hxs')". - simpl. iDestruct "Hhd" as (hd' q) "([[Hhd1 Hhd2] Hhd'] & Hxs')".
iDestruct (dup_is_list with "[Hxs']") as "[Hxs1 Hxs2]"; first by iFrame. iDestruct (dup_is_list with "[Hxs']") as "[Hxs1 Hxs2]"; first by iFrame.
wp_load. iDestruct "Hvs'" as "[Hvs' _]". wp_load. iDestruct "Hvs'" as "[Hvs' _]".
......
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