Commit 7c2021bd authored by Jonas Kastberg Hinrichsen's avatar Jonas Kastberg Hinrichsen
Browse files

Clean up, and better handling of semantic sides

parent 67ddad0c
...@@ -17,8 +17,9 @@ Definition new_chan : val := ...@@ -17,8 +17,9 @@ Definition new_chan : val :=
let: "lk" := newlock #() in let: "lk" := newlock #() in
(("l","r"),"lk"). (("l","r"),"lk").
Notation left := (#true) (only parsing). Inductive side := Left | Right.
Notation right := (#false) (only parsing). Coercion side_to_bool (s : side) : bool :=
match s with Left => true | Right => false end.
Definition get_buffs c := Fst c. Definition get_buffs c := Fst c.
Definition get_left c := Fst (get_buffs c). Definition get_left c := Fst (get_buffs c).
...@@ -26,10 +27,10 @@ Definition get_right c := Snd (get_buffs c). ...@@ -26,10 +27,10 @@ Definition get_right c := Snd (get_buffs c).
Definition get_lock c := Snd c. Definition get_lock c := Snd c.
Definition dual_side s := Definition dual_side s :=
(if: s = left then right else left)%E. (if: s = #Left then #Right else #Left)%E.
Definition get_side c s := Definition get_side c s :=
(if: s = left then (get_left c) else (get_right c))%E. (if: s = #Left then get_left c else get_right c)%E.
Definition send : val := Definition send : val :=
λ: "c" "s" "v", λ: "c" "s" "v",
...@@ -62,9 +63,6 @@ Section channel. ...@@ -62,9 +63,6 @@ Section channel.
Definition is_list_ref (l : val) (xs : list val) : iProp Σ := Definition is_list_ref (l : val) (xs : list val) : iProp Σ :=
( l':loc, hd : val, l = #l' l' hd is_list hd xs)%I. ( l':loc, hd : val, l = #l' l' hd is_list hd xs)%I.
Definition is_side (s : val) : Prop :=
s = left s = right.
Record chan_name := Chan_name { Record chan_name := Chan_name {
chan_lock_name : gname; chan_lock_name : gname;
chan_l_name : gname; chan_l_name : gname;
...@@ -120,26 +118,26 @@ Section channel. ...@@ -120,26 +118,26 @@ Section channel.
eauto 20 with iFrame. eauto 20 with iFrame.
Qed. Qed.
Definition chan_frag_snoc γ c ls rs s v : iProp Σ := Definition chan_frag_snoc (γ : chan_name) (c : val)
(l r : list val) (s : side) (v : val)
: iProp Σ :=
match s with match s with
| left => chan_frag γ c (ls ++ [v]) rs | Left => chan_frag γ c (l ++ [v]) r
| right => chan_frag γ c ls (rs ++ [v]) | Right => chan_frag γ c l (r ++ [v])
| _ => False%I
end. end.
Lemma send_spec Φ E γ (c v s : val) : Lemma send_spec Φ E γ c v s :
is_side s
chan_ctx γ c - chan_ctx γ c -
(|={,E}=> ls rs, (|={,E}=> ls rs,
chan_frag γ c ls rs chan_frag γ c ls rs
(chan_frag_snoc γ c ls rs s v ={E,}= Φ #())) - (chan_frag_snoc γ c ls rs s v ={E,}= Φ #())) -
WP send c s v {{ Φ }}. WP send c #s v {{ Φ }}.
Proof. Proof.
iIntros (Hside) "Hc HΦ". wp_lam; wp_pures. iIntros "Hc HΦ". wp_lam; wp_pures.
iDestruct "Hc" as (l r lk ->) "#Hlock"; wp_pures. iDestruct "Hc" as (l r lk ->) "#Hlock"; wp_pures.
wp_apply (acquire_spec with "Hlock"); iIntros "[Hlocked Hinv]". wp_apply (acquire_spec with "Hlock"); iIntros "[Hlocked Hinv]".
iDestruct "Hinv" as (ls rs) "(Hl & Hls & Hr & Hrs)". iDestruct "Hinv" as (ls rs) "(Hl & Hls & Hr & Hrs)".
destruct Hside as [-> | ->]. destruct s.
- wp_pures. iDestruct "Hl" as (ll lhd ->) "(Hl & Hll)". - wp_pures. iDestruct "Hl" as (ll lhd ->) "(Hl & Hll)".
wp_load. wp_apply (lsnoc_spec with "Hll"). wp_load. wp_apply (lsnoc_spec with "Hll").
iIntros (hd' Hll). iIntros (hd' Hll).
...@@ -168,53 +166,46 @@ Section channel. ...@@ -168,53 +166,46 @@ Section channel.
{ rewrite /is_list_ref. eauto 10 with iFrame. } { rewrite /is_list_ref. eauto 10 with iFrame. }
Qed. Qed.
Definition try_recv_fail γ c ls rs s : iProp Σ := Definition try_recv_fail (γ : chan_name) (c : val)
(l r : list val) (s : side) : iProp Σ :=
match s with match s with
| left => (chan_frag γ c ls rs rs = [])%I | Left => (chan_frag γ c l r r = [])%I
| right => (chan_frag γ c ls rs ls = [])%I | Right => (chan_frag γ c l r l = [])%I
| _ => False%I
end. end.
Definition try_recv_succ γ c ls rs s v : iProp Σ := Definition try_recv_succ (γ : chan_name) (c : val)
(l r : list val) (s : side) (v : val) : iProp Σ :=
match s with match s with
| left => ( rs', chan_frag γ c ls rs' rs = v::rs')%I | Left => ( r', chan_frag γ c l r' r = v::r')%I
| right => ( ls', chan_frag γ c ls' rs ls = v::ls')%I | Right => ( l', chan_frag γ c l' r l = v::l')%I
| _ => False%I
end.
Definition try_recv_get γ c ls rs s v : iProp Σ :=
match v with
| NONEV => try_recv_fail γ c ls rs s
| SOMEV w => try_recv_succ γ c ls rs s w
| _ => False%I
end. end.
Lemma try_recv_spec Φ E γ (c s : val) : Lemma try_recv_spec Φ E γ c s :
is_side s
chan_ctx γ c - chan_ctx γ c -
(|={,E}=> ls rs, (|={,E}=> ls rs,
chan_frag γ c ls rs chan_frag γ c ls rs
( v, try_recv_get γ c ls rs s v ={E,}= Φ v)) - ((try_recv_fail γ c ls rs s ={E,}= Φ NONEV)
WP try_recv c s {{ Φ }}. ( v, try_recv_succ γ c ls rs s v ={E,}= Φ (SOMEV v)))) -
WP try_recv c #s {{ Φ }}.
Proof. Proof.
iIntros (Hside) "Hc HΦ". wp_lam; wp_pures. iIntros "Hc HΦ". wp_lam; wp_pures.
iDestruct "Hc" as (l r lk ->) "#Hlock"; wp_pures. iDestruct "Hc" as (l r lk ->) "#Hlock"; wp_pures.
wp_apply (acquire_spec with "Hlock"); iIntros "[Hlocked Hinv]". wp_apply (acquire_spec with "Hlock"); iIntros "[Hlocked Hinv]".
iDestruct "Hinv" as (ls rs) "(Hls & Hlsa & Hrs & Hrsa)". iDestruct "Hinv" as (ls rs) "(Hls & Hlsa & Hrs & Hrsa)".
destruct Hside as [-> | ->]. destruct s; simpl.
- iDestruct "Hrs" as (rl rhd ->) "[Hrs #Hrhd]". - iDestruct "Hrs" as (rl rhd ->) "[Hrs #Hrhd]".
wp_pures. wp_pures.
wp_bind (Load _). wp_bind (Load _).
iMod "HΦ" as (ls' rs') "[Hchan HΦ]". iMod "HΦ" as (ls' rs') "[Hchan HΦ]".
wp_load. wp_load.
destruct rs. destruct rs; simpl.
+ iRevert "Hrhd". rewrite /is_list. iIntros (->). + iDestruct "Hrhd" as %->.
iDestruct "Hchan" as (l' r' lk' [= <- <- <-]) "[Hlsf Hrsf]". iDestruct "Hchan" as (l' r' lk' [= <- <- <-]) "[Hlsf Hrsf]".
iDestruct (excl_eq with "Hlsa Hlsf") as %->. iDestruct (excl_eq with "Hlsa Hlsf") as %->.
iDestruct (excl_eq with "Hrsa Hrsf") as %->. iDestruct (excl_eq with "Hrsa Hrsf") as %->.
iSpecialize ("HΦ" $!(InjLV #())). iDestruct "HΦ" as "[HΦ _]".
iMod ("HΦ" with "[Hlsf Hrsf]") as "HΦ". iMod ("HΦ" with "[Hlsf Hrsf]") as "HΦ".
{ rewrite /try_recv_get /try_recv_fail /chan_frag. { rewrite /try_recv_fail /chan_frag.
eauto 10 with iFrame. } eauto 10 with iFrame. }
iModIntro. iModIntro.
wp_apply (release_spec with "[-HΦ $Hlocked $Hlock]"). wp_apply (release_spec with "[-HΦ $Hlocked $Hlock]").
...@@ -222,14 +213,14 @@ Section channel. ...@@ -222,14 +213,14 @@ Section channel.
iIntros (_). iIntros (_).
wp_pures. wp_pures.
by iApply "HΦ". by iApply "HΦ".
+ iRevert "Hrhd". rewrite /is_list. iIntros ([hd' [-> Hrhd']]). + iDestruct "Hrhd" as %[hd' [-> Hrhd']].
iDestruct "Hchan" as (l' r' lk' [= <- <- <-]) "[Hlsf Hrsf]". iDestruct "Hchan" as (l' r' lk' [= <- <- <-]) "[Hlsf Hrsf]".
iDestruct (excl_eq with "Hlsa Hlsf") as %->. iDestruct (excl_eq with "Hlsa Hlsf") as %->.
iDestruct (excl_eq with "Hrsa Hrsf") as %->. iDestruct (excl_eq with "Hrsa Hrsf") as %->.
iDestruct (excl_update _ _ _ (rs) with "Hrsa Hrsf") as ">[Hrsa Hrsf]". iDestruct (excl_update _ _ _ (rs) with "Hrsa Hrsf") as ">[Hrsa Hrsf]".
iSpecialize ("HΦ" $!(InjRV (v))). iDestruct "HΦ" as "[_ HΦ]".
iMod ("HΦ" with "[Hlsf Hrsf]") as "HΦ". iMod ("HΦ" with "[Hlsf Hrsf]") as "HΦ".
{ rewrite /try_recv_get /try_recv_succ /chan_frag. { rewrite /try_recv_succ /chan_frag.
eauto 10 with iFrame. } eauto 10 with iFrame. }
iModIntro. iModIntro.
wp_store. wp_store.
...@@ -243,14 +234,14 @@ Section channel. ...@@ -243,14 +234,14 @@ Section channel.
wp_bind (Load _). wp_bind (Load _).
iMod "HΦ" as (ls' rs') "[Hchan HΦ]". iMod "HΦ" as (ls' rs') "[Hchan HΦ]".
wp_load. wp_load.
destruct ls. destruct ls; simpl.
+ iRevert "Hlhd". rewrite /is_list. iIntros (->). + iDestruct "Hlhd" as %->.
iDestruct "Hchan" as (l' r' lk' [= <- <- <-]) "[Hlsf Hrsf]". iDestruct "Hchan" as (l' r' lk' [= <- <- <-]) "[Hlsf Hrsf]".
iDestruct (excl_eq with "Hlsa Hlsf") as %->. iDestruct (excl_eq with "Hlsa Hlsf") as %->.
iDestruct (excl_eq with "Hrsa Hrsf") as %->. iDestruct (excl_eq with "Hrsa Hrsf") as %->.
iSpecialize ("HΦ" $!(InjLV #())). iDestruct "HΦ" as "[HΦ _]".
iMod ("HΦ" with "[Hlsf Hrsf]") as "HΦ". iMod ("HΦ" with "[Hlsf Hrsf]") as "HΦ".
{ rewrite /try_recv_get /try_recv_fail /chan_frag. { rewrite /try_recv_fail /chan_frag.
eauto 10 with iFrame. } eauto 10 with iFrame. }
iModIntro. iModIntro.
wp_apply (release_spec with "[-HΦ $Hlocked $Hlock]"). wp_apply (release_spec with "[-HΦ $Hlocked $Hlock]").
...@@ -258,15 +249,14 @@ Section channel. ...@@ -258,15 +249,14 @@ Section channel.
iIntros (_). iIntros (_).
wp_pures. wp_pures.
by iApply "HΦ". by iApply "HΦ".
+ iRevert "Hlhd". rewrite /is_list. iIntros ([hd' [-> Hlhd']]). + iDestruct "Hlhd" as %[hd' [-> Hlhd']].
iDestruct "Hchan" as (l' r' lk' [= <- <- <-]) "[Hlsf Hrsf]". iDestruct "Hchan" as (l' r' lk' [= <- <- <-]) "[Hlsf Hrsf]".
iDestruct (excl_eq with "Hlsa Hlsf") as %->. iDestruct (excl_eq with "Hlsa Hlsf") as %->.
iDestruct (excl_eq with "Hrsa Hrsf") as %->. iDestruct (excl_eq with "Hrsa Hrsf") as %->.
iDestruct (excl_update _ _ _ (ls) with "Hlsa Hlsf") as ">[Hlsa Hlsf]". iDestruct (excl_update _ _ _ (ls) with "Hlsa Hlsf") as ">[Hlsa Hlsf]".
iSpecialize ("HΦ" $!(InjRV (v))). iDestruct "HΦ" as "[_ HΦ]".
iMod ("HΦ" with "[Hlsf Hrsf]") as "HΦ". iMod ("HΦ" with "[Hlsf Hrsf]") as "HΦ".
{ rewrite /try_recv_get /try_recv_succ /chan_frag. { rewrite /try_recv_succ /chan_frag. eauto 10 with iFrame. }
eauto 10 with iFrame. }
iModIntro. iModIntro.
wp_store. wp_store.
wp_apply (release_spec with "[-HΦ $Hlocked $Hlock]"). wp_apply (release_spec with "[-HΦ $Hlocked $Hlock]").
...@@ -277,15 +267,14 @@ Section channel. ...@@ -277,15 +267,14 @@ Section channel.
Qed. Qed.
Lemma recv_spec Φ E γ c s : Lemma recv_spec Φ E γ c s :
is_side s
chan_ctx γ c - chan_ctx γ c -
( (|={,E}=> ls rs, ( (|={,E}=> ls rs,
chan_frag γ c ls rs chan_frag γ c ls rs
((try_recv_fail γ c ls rs s ={E,}= True) ((try_recv_fail γ c ls rs s ={E,}= True)
( v, try_recv_succ γ c ls rs s v ={E,}= Φ v)))) - ( v, try_recv_succ γ c ls rs s v ={E,}= Φ v)))) -
WP recv c s {{ Φ }}. WP recv c #s {{ Φ }}.
Proof. Proof.
iIntros (Hside) "#Hc #HΦ". iIntros "#Hc #HΦ".
rewrite /recv. rewrite /recv.
iLöb as "IH". iLöb as "IH".
wp_apply (try_recv_spec with "Hc")=> //. wp_apply (try_recv_spec with "Hc")=> //.
...@@ -294,20 +283,18 @@ Section channel. ...@@ -294,20 +283,18 @@ Section channel.
iExists _, _. iExists _, _.
iFrame. iFrame.
iNext. iNext.
iIntros (v) "Hupd". iSplitL "HΦfail".
destruct v; try (by iRevert "Hupd"; iIntros (Hupd); inversion Hupd). - iIntros "Hupd".
- destruct v; try (by iRevert "Hupd"; iIntros (Hupd); inversion Hupd). iDestruct ("HΦfail") as "HΦ".
destruct l; try (by iRevert "Hupd"; iIntros (Hupd); inversion Hupd).
iClear "HΦsucc". iDestruct ("HΦfail") as "HΦ".
iMod ("HΦ" with "Hupd") as "HΦ". iMod ("HΦ" with "Hupd") as "HΦ".
iModIntro. iModIntro.
wp_match. wp_match.
by iApply ("IH"). by iApply ("IH").
- iClear "HΦfail". iDestruct ("HΦsucc") as "HΦ". - iDestruct ("HΦsucc") as "HΦ".
iIntros (v) "Hupd".
iSpecialize("HΦ" $!v). iSpecialize("HΦ" $!v).
iMod ("HΦ" with "Hupd") as "HΦ". iMod ("HΦ" with "Hupd") as "HΦ".
iModIntro. iModIntro.
by wp_pures. by wp_pures.
Qed. Qed.
End channel. End channel.
\ No newline at end of file
...@@ -131,18 +131,21 @@ Section logrel. ...@@ -131,18 +131,21 @@ Section logrel.
iFrame. iFrame.
Qed. Qed.
Definition to_side s := (* Definition to_side (s : side) : chan:= *)
match s with (* match s with *)
| Left => #true (* | Left => true *)
| Right => #false (* | Right => false *)
end. (* end. *)
Coercion side_to_side (s : side) : channel.side :=
match s with Left => channel.Left | Right => channel.Right end.
Lemma send_vs c γ s (P : val Prop) st E : Lemma send_vs c γ s (P : val Prop) st E :
N E N E
c @ s : TSend P st {γ} ={E,E∖↑N}= c @ s : TSend P st {γ} ={E,E∖↑N}=
l r, chan_frag (st_c_name γ) c l r l r, chan_frag (st_c_name γ) c l r
( v, P v - ( v, P v -
chan_frag_snoc (st_c_name γ) c l r (to_side s) v chan_frag_snoc (st_c_name γ) c l r s v
={E N,E}= c @ s : st v {γ}). ={E N,E}= c @ s : st v {γ}).
Proof. Proof.
iIntros (Hin) "[Hstf #[Hcctx Hinv]]". iIntros (Hin) "[Hstf #[Hcctx Hinv]]".
...@@ -200,12 +203,11 @@ Section logrel. ...@@ -200,12 +203,11 @@ Section logrel.
Lemma send_st_spec st γ c s (P : val Prop) v : Lemma send_st_spec st γ c s (P : val Prop) v :
P v P v
{{{ c @ s : TSend P st {γ} }}} {{{ c @ s : TSend P st {γ} }}}
send c (to_side s) v send c #s v
{{{ RET #(); c @ s : st v {γ} }}}. {{{ RET #(); c @ s : st v {γ} }}}.
Proof. Proof.
iIntros (HP Φ) "Hsend HΦ". iIntros (HP Φ) "Hsend HΦ".
iApply (send_spec with "[#]"). iApply (send_spec with "[#]").
{ destruct s. by left. by right. }
{ iDestruct "Hsend" as "[? [$ ?]]". } { iDestruct "Hsend" as "[? [$ ?]]". }
iMod (send_vs with "Hsend") as (ls lr) "[Hch H]"; first done. iMod (send_vs with "Hsend") as (ls lr) "[Hch H]"; first done.
iModIntro. iExists ls, lr. iFrame "Hch". iModIntro. iExists ls, lr. iFrame "Hch".
...@@ -218,9 +220,9 @@ Section logrel. ...@@ -218,9 +220,9 @@ Section logrel.
c @ s : TRecv P st {γ} c @ s : TRecv P st {γ}
={E,E∖↑N}= ={E,E∖↑N}=
l r, chan_frag (st_c_name γ) c l r l r, chan_frag (st_c_name γ) c l r
( ((try_recv_fail (st_c_name γ) c l r (to_side s) ={E∖↑N,E}= ( ((try_recv_fail (st_c_name γ) c l r s ={E∖↑N,E}=
c @ s : TRecv P st {γ}) c @ s : TRecv P st {γ})
( v, try_recv_succ (st_c_name γ) c l r (to_side s) v ={E∖↑N,E}= ( v, try_recv_succ (st_c_name γ) c l r s v ={E∖↑N,E}=
c @ s : (st v) {γ} P v))). c @ s : (st v) {γ} P v))).
Proof. Proof.
iIntros (Hin) "[Hstf #[Hcctx Hinv]]". iIntros (Hin) "[Hstf #[Hcctx Hinv]]".
...@@ -274,35 +276,34 @@ Section logrel. ...@@ -274,35 +276,34 @@ Section logrel.
Lemma try_recv_st_spec st γ c s (P : val Prop) : Lemma try_recv_st_spec st γ c s (P : val Prop) :
{{{ c @ s : TRecv P st {γ} }}} {{{ c @ s : TRecv P st {γ} }}}
try_recv c (to_side s) try_recv c #s
{{{ v, RET v; (v = NONEV c @ s : TRecv P st {γ}) {{{ v, RET v; (v = NONEV c @ s : TRecv P st {γ})
( w, v = SOMEV w c @ s : st w {γ} P w)}}}. ( w, v = SOMEV w c @ s : st w {γ} P w)}}}.
Proof. Proof.
iIntros (Φ) "Hrecv HΦ". iIntros (Φ) "Hrecv HΦ".
iApply (try_recv_spec with "[#]"). iApply (try_recv_spec with "[#]").
{ destruct s. by left. by right. }
{ iDestruct "Hrecv" as "[? [$ ?]]". } { iDestruct "Hrecv" as "[? [$ ?]]". }
iMod (try_recv_vs with "Hrecv") as (ls lr) "[Hch H]"; first done. iMod (try_recv_vs with "Hrecv") as (ls lr) "[Hch H]"; first done.
iModIntro. iExists ls, lr. iFrame "Hch". iModIntro. iExists ls, lr. iFrame "Hch".
iIntros "!>". iIntros (v) "Hupd". iApply "HΦ". iIntros "!>".
destruct v; try by iDestruct "Hupd" as %Hupd; inversion Hupd. iSplit.
- destruct v; try by iDestruct "Hupd" as %Hupd; inversion Hupd. - iIntros "Hupd".
destruct l; try by iDestruct "Hupd" as %Hupd; inversion Hupd.
simpl.
iLeft.
iDestruct "H" as "[H _]". iDestruct "H" as "[H _]".
iMod ("H" with "Hupd") as "H". iMod ("H" with "Hupd") as "H".
iModIntro. iSplit=> //. iModIntro.
- simpl. iApply "HΦ"=> //.
iRight. eauto with iFrame.
- iIntros (v) "Hupd".
iDestruct "H" as "[_ H]". iDestruct "H" as "[_ H]".
iMod ("H" with "Hupd") as "H". iMod ("H" with "Hupd") as "H".
iModIntro. iExists _. iSplit=> //. iModIntro.
iApply "HΦ"=> //.
eauto with iFrame.
Qed. Qed.
Lemma recv_st_spec st γ c s (P : val Prop) : Lemma recv_st_spec st γ c s (P : val Prop) :
{{{ c @ s : TRecv P st {γ} }}} {{{ c @ s : TRecv P st {γ} }}}
recv c (to_side s) recv c #s
{{{ v, RET v; c @ s : st v {γ} P v}}}. {{{ v, RET v; c @ s : st v {γ} P v}}}.
Proof. Proof.
iIntros (Φ) "Hrecv HΦ". iIntros (Φ) "Hrecv HΦ".
......
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