Skip to content
Snippets Groups Projects
Commit 37857a80 authored by Jonas Kastberg Hinrichsen's avatar Jonas Kastberg Hinrichsen
Browse files

Updated is_chan to lock buffer resources. 

Introduced Authoritative Exclusive buffer CMRA.
parent 40da9e24
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
_CoqProject
+ 2
− 0
View file @ 37857a80
-Q theories osiris -Q theories osiris
-arg -w -arg -notation-overridden,-redundant-canonical-projection,-several-object-files -arg -w -arg -notation-overridden,-redundant-canonical-projection,-several-object-files
theories/list.v theories/list.v
theories/buffer.v
theories/channel.v theories/channel.v
theories/buffer.v 0 → 100644
+ 56
− 0
View file @ 37857a80
From iris.heap_lang Require Export lang.
From iris.proofmode Require Import tactics.
From iris.algebra Require Import excl auth.
From iris.base_logic.lib Require Import auth.
Set Default Proof Using "Type".
(* Buffer CMRA *)
Definition buff_type := list val.
Definition buffUR : ucmraT :=
optionUR (exclR (leibnizC (buff_type))).
Definition to_buff (b : buff_type) : buffUR :=
Excl' (b: leibnizC buff_type).
Class buffG (Σ :gFunctors) := BuffG {
buffG_authG :> authG Σ buffUR;
}.
Definition buffΣ : gFunctors :=
#[GFunctor (authR buffUR)].
Instance subG_buffG {Σ} :
subG buffΣ Σ → buffG Σ.
Proof. solve_inG. Qed.
Section buff.
Context `{!buffG Σ} (N : namespace).
Lemma excl_eq γ x y :
own γ (● to_buff y) -∗ own γ (◯ to_buff x) -∗ ⌜x = y⌝%I.
Proof.
iIntros "Hauth Hfrag".
iDestruct (own_valid_2 with "Hauth Hfrag") as %Hvalid.
apply auth_valid_discrete_2 in Hvalid.
destruct Hvalid as [Hincl _].
apply Excl_included in Hincl.
unfold to_buff.
rewrite Hincl.
iFrame.
eauto.
Qed.
Lemma excl_update γ x y z :
own γ (● to_buff y) -∗ own γ (◯ to_buff x) -∗ |==> own γ (● to_buff z) ∗ own γ (◯ to_buff z).
Proof.
iIntros "Hauth Hfrag".
iDestruct (own_update_2 with "Hauth Hfrag") as "H".
{ eapply (auth_update _ _ (to_buff z) (to_buff z)).
eapply option_local_update.
eapply exclusive_local_update. done. }
rewrite own_op.
done.
Qed.
End buff.
theories/channel.v
+ 178
− 104
View file @ 37857a80
...@@ -2,12 +2,15 @@ From iris.program_logic Require Export weakestpre. ...@@ -2,12 +2,15 @@ From iris.program_logic Require Export weakestpre.
From iris.heap_lang Require Export lang. From iris.heap_lang Require Export lang.
From iris.proofmode Require Import tactics. From iris.proofmode Require Import tactics.
From iris.heap_lang Require Import proofmode notation. From iris.heap_lang Require Import proofmode notation.
From iris.algebra Require Import excl. From iris.algebra Require Import excl auth.
From iris.base_logic.lib Require Import auth.
From iris.heap_lang.lib Require Import lock. From iris.heap_lang.lib Require Import lock.
From iris.heap_lang.lib Require Import spin_lock. From iris.heap_lang.lib Require Import spin_lock.
From osiris Require Import list. From osiris Require Import list.
From osiris Require Import buffer.
Set Default Proof Using "Type". Set Default Proof Using "Type".
Definition new_list : val := Definition new_list : val :=
λ: <>, lnil #(). λ: <>, lnil #().
...@@ -45,13 +48,10 @@ Definition try_recv : val := ...@@ -45,13 +48,10 @@ Definition try_recv : val :=
let lk := get_lock "c" in let lk := get_lock "c" in
acquire lk;; acquire lk;;
let l := (get_side "c" (dual_side "s")) in let l := (get_side "c" (dual_side "s")) in
let v := match: !l with
match: !l with SOME "p" => l <- Snd "p";; release lk;; SOME (Fst "p")
SOME "p" => l <- Snd "p";; SOME (Fst "p") | NONE => release lk;; NONE
| NONE => NONE end.
end in
release lk;;
v.
Definition recv : val := Definition recv : val :=
rec: "go" "c" "s" := rec: "go" "c" "s" :=
...@@ -61,56 +61,69 @@ Definition recv : val := ...@@ -61,56 +61,69 @@ Definition recv : val :=
end. end.
Section channel. Section channel.
Context `{!heapG Σ, !lockG Σ} (N : namespace). Context `{!heapG Σ, !lockG Σ, !buffG Σ} (N : namespace).
Definition is_list_ref (l : val) (xs : list val) : iProp Σ := Definition is_list_ref (l : val) (xs : list val) : iProp Σ :=
(∃ l':loc, ⌜l = #l'⌝ ∧ ∃ hd : val, 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 := Definition is_side (s : val) : Prop :=
s = left ∨ s = right. s = left ∨ s = right.
Definition is_chan (γ : gname) (c : val) (ls rs : list val) (R : iProp Σ) : iProp Σ := Definition is_chan (lkγ lsγ rsγ : gname) (c : val) (ls rs : list val) : iProp Σ :=
(∃ l r lk : val, ⌜c = ((l, r), lk)%V⌝ ∧ is_lock N γ lk R ∗ is_list_ref l ls ∗ is_list_ref r rs)%I. (∃ l r lk : val, ⌜c = ((l, r), lk)%V⌝ ∧
own lsγ (◯ to_buff ls) ∗ own rsγ (◯ to_buff rs) ∗
is_lock N lkγ lk
(∃ ls rs,
is_list_ref l ls ∗ own lsγ (● to_buff ls) ∗
is_list_ref r rs ∗ own rsγ (● to_buff rs)))%I.
Lemma new_chan_spec (R : iProp Σ) : Lemma new_chan_spec :
{{{ R }}} {{{ True }}}
new_chan #() new_chan #()
{{{ c γ, RET c; is_chan γ c [] [] R }}}. {{{ c lkγ lsγ rsγ, RET c; is_chan lkγ lsγ rsγ c [] [] }}}.
Proof. Proof.
iIntros (Φ) "HR HΦ". rewrite -wp_fupd /newlock /new_list /=. iIntros (Φ) "_ HΦ". rewrite -wp_fupd /newlock /new_list /=.
repeat wp_lam. wp_alloc lk as "Hlk". repeat wp_lam. wp_alloc lk as "Hlk".
repeat wp_lam. wp_alloc r as "Hr". repeat wp_lam. wp_alloc r as "Hr".
repeat wp_lam. wp_alloc l as "Hl". repeat wp_lam. wp_alloc l as "Hl".
wp_pures. wp_pures.
iMod (own_alloc (Excl ())) as (γ) "Hγ"; first done. iMod (own_alloc (Excl ())) as (lkγ) "Hγlk"; first done.
iMod (inv_alloc N _ (lock_inv γ lk R) with "[-Hl Hr HΦ]") as "#?". iMod (own_alloc (Auth (Excl' (to_buff [])) (to_buff []))) as (lsγ) "Hls"; first done.
{ iIntros "!>". iExists false. by iFrame. } iMod (own_alloc (Auth (Excl' (to_buff [])) (to_buff []))) as (rsγ) "Hrs"; first done.
rewrite auth_both_op.
rewrite own_op. rewrite own_op.
iDestruct "Hls" as "[Hlsa Hlsf]".
iDestruct "Hrs" as "[Hrsa Hrsf]".
iMod (inv_alloc N _ (lock_inv lkγ lk (∃ (ls rs : list val), is_list_ref #l ls ∗ own lsγ (● to_buff ls) ∗ is_list_ref #r rs ∗ own rsγ (● to_buff rs)))%I with "[Hlk Hγlk Hr Hl Hlsa Hrsa]") as "Hlk".
{
iNext. iExists _. iFrame. iFrame.
iExists [], []. iFrame.
iSplitL "Hl"=> //; iExists _, _; iSplit=> //; iFrame=> //.
}
iModIntro. iModIntro.
iApply "HΦ". iApply "HΦ".
iExists _, _, _. iExists _, _, _.
iFrame "Hlsf Hrsf".
iSplit=> //. iSplit=> //.
iSplitR. unfold is_lock. iExists _. iSplit=> //.
- unfold is_lock. iExists _. iSplit=> //.
- iSplitL "Hl"; iExists _; iSplit=> //; iExists (InjLV #()); iSplit => //.
Qed. Qed.
(* Insert a value 'v' in the buffer of a given channel 'c', based on the given side 's' *) Definition send_upd lkγ lsγ rsγ c ls rs s v : iProp Σ :=
Definition send_upd γ c ls rs R s v : iProp Σ :=
match s with match s with
| left => is_chan γ c (ls ++ [v]) rs R | left => is_chan lkγ lsγ rsγ c (ls ++ [v]) rs
| right => is_chan γ c ls (rs ++ [v]) R | right => is_chan lkγ lsγ rsγ c ls (rs ++ [v])
| _ => ⌜False⌝%I | _ => ⌜False⌝%I
end. end.
Lemma send_spec (γ : gname) (c v s : val) (ls rs : list val) (R : iProp Σ) : Lemma send_spec (lkγ lsγ rsγ : gname) (c v s : val) (ls rs : list val) :
{{{ is_chan γ c ls rs R ∗ ⌜is_side s⌝%I }}} {{{ is_chan lkγ lsγ rsγ c ls rs ∗ ⌜is_side s⌝%I }}}
send c s v send c s v
{{{ RET #(); send_upd γ c ls rs R s v }}}. {{{ RET #(); send_upd lkγ lsγ rsγ c ls rs s v }}}.
Proof. Proof.
iIntros (Φ) "[Hc #Hs] HΦ". iIntros (Φ) "[Hc #Hs] HΦ".
iRevert "Hs". iIntros (Hs). iRevert "Hs". iIntros (Hs).
rewrite -wp_fupd /send /=. rewrite -wp_fupd /send /=.
iDestruct "Hc" as (l r lk Hc) "[#Hlk [Hl Hr]]". iDestruct "Hc" as (l r lk Hc) "[Hlsf [Hrsf #Hlk]]".
wp_lam. wp_lam.
wp_pures. wp_pures.
subst. subst.
...@@ -119,86 +132,126 @@ Section channel. ...@@ -119,86 +132,126 @@ Section channel.
wp_bind (acquire lk). wp_bind (acquire lk).
iApply acquire_spec=> //. iApply acquire_spec=> //.
iNext. iNext.
iIntros "[Hlocked HR]". iIntros "[Hlocked Hl]".
iDestruct "Hl" as (ls' rs') "[Hls [Hlsa [Hrs Hrsa]]]".
iDestruct (excl_eq with "Hlsa Hlsf") as %Heqls. rewrite -(Heqls).
iDestruct (excl_eq with "Hrsa Hrsf") as %Heqrs. rewrite -(Heqrs).
wp_seq. wp_seq.
wp_pures. wp_pures.
inversion Hs; inversion Hs.
[iDestruct "Hl" as (lb Hb bhd) "[Hl #Hbhd]" | - iDestruct "Hls" as (lb Hb bhd) "[Hl #Hbhd]".
iDestruct "Hr" as (lb Hb bhd) "[Hr #Hbhd]"]; iDestruct (excl_update _ _ _ (ls ++ [v]) with "Hlsa Hlsf") as ">[Hlsa Hlsf]".
subst; subst.
wp_pures; wp_pures.
wp_bind (lsnoc (Load #lb) v); wp_bind (lsnoc (Load #lb) v).
wp_load; wp_load.
iApply lsnoc_spec=> //; iApply lsnoc_spec=> //.
iIntros (hd' Hhd'); iIntros (hd' Hhd').
iNext; iNext.
wp_store; wp_store.
wp_pures; wp_pures.
iApply (release_spec N γ lk R with "[Hlocked HR]") => //; eauto.
iFrame; eauto; iApply (release_spec N lkγ lk with "[Hlocked Hl Hlsa Hrsa Hrs]") => //.
iModIntro; {
iIntros (_); iFrame; eauto.
iModIntro; iSplitR. iApply "Hlk".
iApply "HΦ"; iFrame. iExists _, _. iFrame.
iExists _, _, _; iExists _, _. iSplit=> //. iFrame. iPureIntro => //.
iSplitR; }
eauto; iModIntro.
iSplitL "Hlk"=> //; iIntros (_).
iSplitL "Hl"=> //; iModIntro.
iExists _; iApply "HΦ".
iSplitR; iExists _, _, _.
iSplitR=> //.
iSplitL "Hlsf"=> //.
iSplitL "Hrsf"=> //.
- iDestruct "Hrs" as (lb Hb bhd) "[Hr #Hbhd]".
iDestruct (excl_update _ _ _ (rs ++ [v]) with "Hrsa Hrsf") as ">[Hrsa Hrsf]".
subst.
wp_pures.
wp_bind (lsnoc (Load #lb) v).
wp_load.
iApply lsnoc_spec=> //.
iIntros (hd' Hhd').
iNext.
wp_store.
wp_pures.
eauto. eauto.
iApply (release_spec N lkγ lk with "[Hlocked Hr Hlsa Hrsa Hls]") => //.
{
iFrame; eauto.
iSplitR. iApply "Hlk".
iFrame. iExists _, _. iFrame.
iExists _, _. iSplit=> //. iFrame. iPureIntro => //.
}
iModIntro.
iIntros (_).
iModIntro.
iApply "HΦ".
iExists _, _, _.
iSplitR=> //.
iSplitL "Hlsf"=> //.
iSplitL "Hrsf"=> //.
Qed. Qed.
Definition try_recv_upd γ c ls rs R s v : iProp Σ := Definition try_recv_upd lkγ lsγ rsγ c ls rs s v : iProp Σ :=
match s with match s with
| left => match v with | left => match v with
| NONEV => (is_chan γ c ls rs R ∧ ⌜rs = []⌝)%I | NONEV => (is_chan lkγ lsγ rsγ c ls rs ∧ ⌜rs = []⌝)%I
| SOMEV w => (∃ rs', is_chan γ c ls rs' R ∧ ⌜rs = w::rs'⌝)%I | SOMEV w => (∃ rs', is_chan lkγ lsγ rsγ c ls rs' ∧ ⌜rs = w::rs'⌝)%I
| _ => ⌜False⌝%I | _ => ⌜False⌝%I
end end
| right => match v with | right => match v with
| NONEV => (is_chan γ c ls rs R ∧ ⌜ls = []⌝)%I | NONEV => (is_chan lkγ lsγ rsγ c ls rs ∧ ⌜ls = []⌝)%I
| SOMEV w => (∃ ls', is_chan γ c ls' rs R ∧ ⌜ls = w::ls'⌝)%I | SOMEV w => (∃ ls', is_chan lkγ lsγ rsγ c ls' rs ∧ ⌜ls = w::ls'⌝)%I
| _ => ⌜False⌝%I | _ => ⌜False⌝%I
end end
| _ => ⌜False⌝%I | _ => ⌜False⌝%I
end. end.
Lemma try_recv_spec (γ : gname) (c v s : val) (ls rs : list val) (R : iProp Σ) : Lemma try_recv_spec ( lkγ lsγ rsγ : gname) (c v s : val) (ls rs : list val) :
{{{ is_chan γ c ls rs R ∗ ⌜is_side s⌝%I }}} {{{ is_chan lkγ lsγ rsγ c ls rs ∗ ⌜is_side s⌝%I }}}
try_recv c s try_recv c s
{{{ v, RET v; try_recv_upd γ c ls rs R s v }}}. {{{ v, RET v; try_recv_upd lkγ lsγ rsγ c ls rs s v }}}.
Proof. Proof.
iIntros (Φ) "[Hc #Hs] HΦ". iIntros (Φ) "[Hc #Hs] HΦ".
iRevert "Hs". iIntros (Hs). iRevert "Hs". iIntros (Hs).
rewrite -wp_fupd /send /=. rewrite -wp_fupd /send /=.
iDestruct "Hc" as (l r lk Hc) "[#Hlk [Hl Hr]]". iDestruct "Hc" as (l r lk Hc) "[Hlsf [Hrsf #Hlk]]".
subst. subst.
wp_lam. wp_lam.
wp_pures. wp_pures.
wp_bind (acquire _). wp_bind (acquire _).
iApply acquire_spec=> //. iApply acquire_spec=> //.
iNext. iNext.
iIntros "[Hlocked HR]". iIntros "[Hlocked Hl]".
iDestruct "Hl" as (ls' rs') "[Hls [Hlsa [Hrs Hrsa]]]".
iDestruct (excl_eq with "Hlsa Hlsf") as %Heqls. rewrite -(Heqls).
iDestruct (excl_eq with "Hrsa Hrsf") as %Heqrs. rewrite -(Heqrs).
wp_seq. wp_seq.
wp_bind (release _).
wp_bind (Snd _).
wp_pures.
iApply (release_spec N γ lk R with "[Hlocked HR]") => //.
iFrame. eauto.
iNext. iIntros (_).
wp_pures. wp_pures.
inversion Hs; subst. inversion Hs; subst.
- wp_pures. - wp_pures.
iDestruct "Hr" as (rl Hr rhd) "[Hr #Hrhd]". iDestruct "Hrs" as (rl Hr rhd) "[Hrs #Hrhd]".
wp_pures. wp_pures.
subst. subst.
wp_load. wp_load.
iRevert "Hrhd". iIntros (Hrhd). iRevert "Hrhd". iIntros (Hrhd).
unfold is_list in Hrhd. unfold is_list in Hrhd.
destruct rs. destruct rs'.
+ subst. + subst.
wp_pures.
wp_bind (release _).
wp_pures.
iApply (release_spec N lkγ lk with "[Hlocked Hls Hrs Hlsa Hrsa]") => //.
{
iFrame; eauto.
iSplitR. iApply "Hlk".
iFrame. iExists _, _. iFrame.
iExists _, _. iFrame=> //.
}
iNext. iIntros (_).
wp_pures. wp_pures.
iModIntro. iModIntro.
iApply "HΦ". iApply "HΦ".
...@@ -206,36 +259,52 @@ Section channel. ...@@ -206,36 +259,52 @@ Section channel.
iExists _, _, _. iExists _, _, _.
iSplit=> //. iSplit=> //.
iFrame. iFrame.
iSplitR. eauto. iApply "Hlk".
iExists _.
iSplit=> //.
iExists _.
iSplit=> //.
+ subst. + subst.
destruct Hrhd as [hd' [Hrhd Hrhd']]. destruct Hrhd as [hd' [Hrhd Hrhd']].
subst. subst.
wp_pures. wp_pures.
wp_store. wp_pures. iModIntro. wp_store. wp_pures.
iDestruct (excl_update _ _ _ (rs') with "Hrsa Hrsf") as ">[Hrsa Hrsf]".
wp_bind (release _).
wp_pures.
iApply (release_spec N lkγ lk with "[Hlocked Hls Hrs Hlsa Hrsa]") => //.
{
iFrame; eauto.
iSplitR. iApply "Hlk".
iFrame. iExists _, _. iFrame.
iExists _, _. iFrame=> //.
}
iNext. iIntros (_).
wp_pures.
iApply "HΦ". iApply "HΦ".
iExists _. iExists _.
iModIntro.
iSplit=> //. iSplit=> //.
iExists _, _, _. iExists _, _, _.
iSplit=> //. iSplit=> //.
iSplit=> //. iFrame.
iFrame. iApply "Hlk".
iExists _.
iSplit=>//.
iExists _.
iSplit=> //.
- wp_pures. - wp_pures.
iDestruct "Hl" as (ll Hl lhd) "[Hl #Hlhd]". iDestruct "Hls" as (ls Hl lhd) "[Hls #Hlhd]".
wp_pures. wp_pures.
subst. subst.
wp_load. wp_load.
iRevert "Hlhd". iIntros (Hlhd). iRevert "Hlhd". iIntros (Hlhd).
unfold is_list in Hlhd. unfold is_list in Hlhd.
destruct ls. destruct ls'.
+ subst. + subst.
wp_pures.
wp_bind (release _).
wp_pures.
iApply (release_spec N lkγ lk with "[Hlocked Hls Hrs Hlsa Hrsa]") => //.
{
iFrame; eauto.
iSplitR. iApply "Hlk".
iFrame. iExists _, _. iFrame.
iExists _, _. iFrame=> //.
}
iNext. iIntros (_).
wp_pures. wp_pures.
iModIntro. iModIntro.
iApply "HΦ". iApply "HΦ".
...@@ -243,27 +312,32 @@ Section channel. ...@@ -243,27 +312,32 @@ Section channel.
iExists _, _, _. iExists _, _, _.
iSplit=> //. iSplit=> //.
iFrame. iFrame.
iSplitR. eauto. iApply "Hlk".
iExists _.
iSplit=> //.
iExists _.
iSplit=> //.
+ subst. + subst.
destruct Hlhd as [hd' [Hlhd Hlhd']]. destruct Hlhd as [hd' [Hlhd Hlhd']].
subst. subst.
wp_pures. wp_pures.
wp_store. wp_pures. iModIntro. wp_store. wp_pures.
iDestruct (excl_update _ _ _ (ls') with "Hlsa Hlsf") as ">[Hlsa Hlsf]".
wp_bind (release _).
wp_pures.
iApply (release_spec N lkγ lk with "[Hlocked Hls Hrs Hlsa Hrsa]") => //.
{
iFrame; eauto.
iSplitR. iApply "Hlk".
iFrame. iExists _, _. iFrame.
iExists _, _. iFrame=> //.
}
iNext. iIntros (_).
wp_pures.
iApply "HΦ". iApply "HΦ".
iExists _. iExists _.
iModIntro.
iSplit=> //. iSplit=> //.
iExists _, _, _. iExists _, _, _.
iSplit=> //. iSplit=> //.
iSplit=> //. iFrame.
iFrame. iApply "Hlk".
iExists _. Qed.
iSplit=>//.
iExists _.
iSplit=> //.
Qed.
End channel. End channel.
\ No newline at end of file
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