Commit 1fa2c070 authored by Robbert Krebbers's avatar Robbert Krebbers

Some renaming.

parent 8bf5d63b
...@@ -10,8 +10,8 @@ theories/channel/channel.v ...@@ -10,8 +10,8 @@ theories/channel/channel.v
theories/channel/proto_model.v theories/channel/proto_model.v
theories/channel/proto_channel.v theories/channel/proto_channel.v
theories/channel/proofmode.v theories/channel/proofmode.v
theories/examples/list_sort.v theories/examples/sort.v
theories/examples/list_sort_instances.v theories/examples/sort_client.v
theories/examples/list_sort_elem.v theories/examples/sort_elem.v
theories/examples/loop_sort.v theories/examples/loop_sort.v
theories/examples/list_sort_elem_client.v theories/examples/sort_elem_client.v
...@@ -2,11 +2,11 @@ From stdpp Require Import sorting. ...@@ -2,11 +2,11 @@ From stdpp Require Import sorting.
From osiris.channel Require Import proto_channel. From osiris.channel Require Import proto_channel.
From iris.heap_lang Require Import proofmode notation. From iris.heap_lang Require Import proofmode notation.
From osiris.utils Require Import list. From osiris.utils Require Import list.
From osiris.examples Require Import list_sort. From osiris.examples Require Import sort.
Definition loop_sort_service : val := Definition loop_sort_service : val :=
rec: "go" "c" := rec: "go" "c" :=
if: recv "c" then list_sort_service "c";; "go" "c" if: recv "c" then sort_service "c";; "go" "c"
else if: recv "c" then else if: recv "c" then
let: "d" := start_chan "go" in let: "d" := start_chan "go" in
send "c" "d";; send "c" "d";;
...@@ -33,7 +33,7 @@ Section loop_sort. ...@@ -33,7 +33,7 @@ Section loop_sort.
Proof. Proof.
iIntros (Ψ) "Hc HΨ". iLöb as "IH" forall (c Ψ). iIntros (Ψ) "Hc HΨ". iLöb as "IH" forall (c Ψ).
wp_rec. wp_apply (branch_spec with "Hc"); iIntros ([]) "/= [Hc _]"; wp_if. wp_rec. wp_apply (branch_spec with "Hc"); iIntros ([]) "/= [Hc _]"; wp_if.
{ wp_apply (list_sort_service_spec with "Hc"); iIntros "Hc". { wp_apply (sort_service_spec with "Hc"); iIntros "Hc".
by wp_apply ("IH" with "Hc"). } by wp_apply ("IH" with "Hc"). }
wp_apply (branch_spec with "Hc"); iIntros ([]) "/= [Hc _]"; wp_if. wp_apply (branch_spec with "Hc"); iIntros ([]) "/= [Hc _]"; wp_if.
- wp_apply (start_chan_proto_spec N loop_sort_protocol); iIntros (d) "Hd". - wp_apply (start_chan_proto_spec N loop_sort_protocol); iIntros (d) "Hd".
......
...@@ -3,7 +3,7 @@ From osiris.channel Require Import proto_channel proofmode. ...@@ -3,7 +3,7 @@ From osiris.channel Require Import proto_channel proofmode.
From iris.heap_lang Require Import proofmode notation. From iris.heap_lang Require Import proofmode notation.
From iris.heap_lang Require Import assert. From iris.heap_lang Require Import assert.
From osiris.utils Require Import list compare spin_lock contribution. From osiris.utils Require Import list compare spin_lock contribution.
From osiris.examples Require Import list_sort_elem. From osiris.examples Require Import sort_elem.
From iris.algebra Require Import gmultiset. From iris.algebra Require Import gmultiset.
Definition mapper : val := Definition mapper : val :=
......
...@@ -2,9 +2,7 @@ From stdpp Require Import sorting. ...@@ -2,9 +2,7 @@ From stdpp Require Import sorting.
From osiris.channel Require Import proto_channel proofmode. From osiris.channel Require Import proto_channel proofmode.
From iris.heap_lang Require Import proofmode notation. From iris.heap_lang Require Import proofmode notation.
From iris.heap_lang Require Import assert. From iris.heap_lang Require Import assert.
From iris.heap_lang.lib Require Import spin_lock. From osiris.utils Require Import list compare spin_lock.
From osiris.utils Require Import list compare.
Definition qnew : val := λ: <>, #(). Definition qnew : val := λ: <>, #().
Definition qenqueue : val := λ: "q" "v", #(). Definition qenqueue : val := λ: "q" "v", #().
...@@ -20,55 +18,55 @@ Definition stop := false. ...@@ -20,55 +18,55 @@ Definition stop := false.
Definition some := true. Definition some := true.
Definition none := false. Definition none := false.
Definition dist_queue : val := Definition pd_loop : val :=
rec: "go" "q" "pc" "cc" "c" := rec: "go" "q" "pc" "cc" "c" :=
if: "cc" #0 then #() else if: "cc" #0 then #() else
if: recv "c" (* enq/deq *) if: recv "c" then (* enq/deq *)
then if: recv "c" (* cont/stop *) if: recv "c" then (* cont/stop *)
then "go" (qenqueue "q" (recv "c")) "pc" "cc" "c" "go" (qenqueue "q" (recv "c")) "pc" "cc" "c"
else "go" "q" ("pc"-#1) "cc" "c" else "go" "q" ("pc"-#1) "cc" "c"
else if: (qis_empty "q") else
then if: "pc" #0 if: (qis_empty "q") then
then send "c" #stop;; "go" "q" "pc" ("cc"-#1) "c" if: "pc" #0 then
else send "c" #cont;; send "c" #none;; "go" "q" "pc" "cc" "c" send "c" #stop;;
else send "c" #cont;; send "c" #some;; "go" "q" "pc" ("cc"-#1) "c"
let: "qv" := qdequeue "q" in else
send "c" (Snd "qv");; "go" (Fst "qv") "pc" "cc" "c". send "c" #cont;; send "c" #none;;
"go" "q" "pc" "cc" "c"
Definition producer : val := else
rec: "go" "c" "l" "produce" := send "c" #cont;; send "c" #some;;
(* acquire "l";; *) let: "qv" := qdequeue "q" in
match: "produce" #() with send "c" (Snd "qv");;
SOME "v" => "go" (Fst "qv") "pc" "cc" "c".
acquire "l";;
send "c" #enq;; send "c" #cont;; send "c" "v";; Definition new_pd : val := λ: "pc" "cc",
release "l";; let: "q" := qnew #() in
"go" "c" "l" "produce" let: "c" := start_chan (λ: "c", pd_loop "q" "pc" "cc" "c") in
| NONE => let: "l" := new_lock #() in
acquire "l";; ("c", "l").
send "c" #enq;; send "c" #stop
release "l" Definition pd_send : val := λ: "cl" "x",
end. acquire (Snd "cl");;
send (Fst "cl") #enq;; send (Fst "cl") #cont;; send (Fst "cl") "x";;
Definition consumer : val := release (Snd "cl").
rec: "go" "c" "l" "consume" :=
acquire "l";; Definition pd_stop : val := λ: "cl",
send "c" #deq;; acquire (Fst "cl");;
if: recv "c" (* cont/stop *) send (Snd "cl") #enq;; send (Snd "cl") #stop;;
then if: recv "c" (* some/none *) release (Fst "cl").
then let: "v" := SOME (recv "c") in
release "l";; "consume" "v";; "go" "c" "l" "consume" Definition pd_recv : val :=
(* "consume" "v";; release "l";; "go" "c" "l" "consume" *) rec: "go" "cl" :=
else release "l";; "go" "c" "l" "consume" acquire (Fst "cl");;
else "consume" NONE;; release "l";; #(). send (Snd "cl") #deq;;
(* else release "l";; "consume" NONE;; #(). *) if: recv (Snd "cl") then (* cont/stop *)
if: recv (Snd "cl") then (* some/none *)
(* Makes n producers and m consumers *) let: "v" := recv (Snd "cl") in
Definition produce_consume : val := release (Fst "cl");; SOME "v"
λ: "produce" "consume" "pc" "cc", else release (Fst "cl");; "go" "c" "l"
#(). else release (Fst "cl");; NONE.
Section list_sort_elem. Section sort_elem.
Context `{!heapG Σ, !proto_chanG Σ} (N : namespace). Context `{!heapG Σ, !proto_chanG Σ} (N : namespace).
Definition queue_prot : iProto Σ := (END)%proto. Definition queue_prot : iProto Σ := (END)%proto.
......
...@@ -13,7 +13,7 @@ Definition lmerge : val := ...@@ -13,7 +13,7 @@ Definition lmerge : val :=
then lcons "y" ("go" "cmp" (ltail "ys") "zs") then lcons "y" ("go" "cmp" (ltail "ys") "zs")
else lcons "z" ("go" "cmp" "ys" (ltail "zs")). else lcons "z" ("go" "cmp" "ys" (ltail "zs")).
Definition list_sort_service : val := Definition sort_service : val :=
rec: "go" "c" := rec: "go" "c" :=
let: "cmp" := recv "c" in let: "cmp" := recv "c" in
let: "xs" := recv "c" in let: "xs" := recv "c" in
...@@ -30,12 +30,12 @@ Definition list_sort_service : val := ...@@ -30,12 +30,12 @@ Definition list_sort_service : val :=
"xs" <- lmerge "cmp" !"ys" !"zs";; "xs" <- lmerge "cmp" !"ys" !"zs";;
send "c" #(). send "c" #().
Definition list_sort_client : val := λ: "cmp" "xs", Definition sort_client : val := λ: "cmp" "xs",
let: "c" := start_chan list_sort_service in let: "c" := start_chan sort_service in
send "c" "cmp";; send "c" "xs";; send "c" "cmp";; send "c" "xs";;
recv "c". recv "c".
Section list_sort. Section sort.
Context `{!heapG Σ, !proto_chanG Σ} (N : namespace). Context `{!heapG Σ, !proto_chanG Σ} (N : namespace).
Definition sort_protocol : iProto Σ := Definition sort_protocol : iProto Σ :=
...@@ -82,9 +82,9 @@ Section list_sort. ...@@ -82,9 +82,9 @@ Section list_sort.
iApply "HΨ". iFrame. iApply "HΨ". iFrame.
Qed. Qed.
Lemma list_sort_service_spec p c : Lemma sort_service_spec p c :
{{{ c iProto_dual sort_protocol <++> p @ N }}} {{{ c iProto_dual sort_protocol <++> p @ N }}}
list_sort_service c sort_service c
{{{ RET #(); c p @ N }}}. {{{ RET #(); c p @ N }}}.
Proof. Proof.
iIntros (Ψ) "Hc HΨ". iLöb as "IH" forall (p c Ψ). iIntros (Ψ) "Hc HΨ". iLöb as "IH" forall (p c Ψ).
...@@ -122,21 +122,21 @@ Section list_sort. ...@@ -122,21 +122,21 @@ Section list_sort.
- by iApply "HΨ". - by iApply "HΨ".
Qed. Qed.
Lemma list_sort_client_spec {A} (I : A val iProp Σ) R Lemma sort_client_spec {A} (I : A val iProp Σ) R
`{!RelDecision R, !Total R} cmp l (vs : list val) (xs : list A) : `{!RelDecision R, !Total R} cmp l (vs : list val) (xs : list A) :
cmp_spec I R cmp - cmp_spec I R cmp -
{{{ l val_encode vs [ list] x;v xs;vs, I x v }}} {{{ l val_encode vs [ list] x;v xs;vs, I x v }}}
list_sort_client cmp #l sort_client cmp #l
{{{ ys ws, RET #(); Sorted R ys ys xs {{{ ys ws, RET #(); Sorted R ys ys xs
l val_encode ws [ list] y;w ys;ws, I y w }}}. l val_encode ws [ list] y;w ys;ws, I y w }}}.
Proof. Proof.
iIntros "#Hcmp !>" (Φ) "Hl HΦ". wp_lam. iIntros "#Hcmp !>" (Φ) "Hl HΦ". wp_lam.
wp_apply (start_chan_proto_spec N sort_protocol); iIntros (c) "Hc". wp_apply (start_chan_proto_spec N sort_protocol); iIntros (c) "Hc".
{ rewrite -(right_id END%proto _ (iProto_dual _)). { rewrite -(right_id END%proto _ (iProto_dual _)).
wp_apply (list_sort_service_spec with "Hc"); auto. } wp_apply (sort_service_spec with "Hc"); auto. }
wp_send with "[$Hcmp]". wp_send with "[$Hcmp]".
wp_send with "[$Hl]". wp_send with "[$Hl]".
wp_recv (ys ws) as "(Hsorted & Hperm & Hl & HI)". wp_recv (ys ws) as "(Hsorted & Hperm & Hl & HI)".
wp_pures. iApply "HΦ"; iFrame. wp_pures. iApply "HΦ"; iFrame.
Qed. Qed.
End list_sort. End sort.
...@@ -2,22 +2,22 @@ From stdpp Require Import sorting. ...@@ -2,22 +2,22 @@ From stdpp Require Import sorting.
From osiris.channel Require Import proto_channel. From osiris.channel Require Import proto_channel.
From iris.heap_lang Require Import proofmode notation. From iris.heap_lang Require Import proofmode notation.
From osiris.utils Require Import list compare. From osiris.utils Require Import list compare.
From osiris.examples Require Import list_sort. From osiris.examples Require Import sort.
Section list_sort_instances. Section sort_client.
Context `{!heapG Σ, !proto_chanG Σ} (N : namespace). Context `{!heapG Σ, !proto_chanG Σ} (N : namespace).
Local Arguments val_encode _ _ !_ /. Local Arguments val_encode _ _ !_ /.
Lemma list_sort_client_le_spec l (xs : list Z) : Lemma sort_client_le_spec l (xs : list Z) :
{{{ l val_encode xs }}} {{{ l val_encode xs }}}
list_sort_client cmpZ #l sort_client cmpZ #l
{{{ ys, RET #(); Sorted () ys ys xs l val_encode ys }}}. {{{ ys, RET #(); Sorted () ys ys xs l val_encode ys }}}.
Proof. Proof.
assert ( zs : list Z, val_encode zs = val_encode (LitV LitInt <$> zs)) as Henc. assert ( zs : list Z, val_encode zs = val_encode (LitV LitInt <$> zs)) as Henc.
{ intros zs. induction zs; f_equal/=; auto with f_equal. } { intros zs. induction zs; f_equal/=; auto with f_equal. }
iIntros (Φ) "Hl HΦ". iIntros (Φ) "Hl HΦ".
iApply (list_sort_client_spec N IZ () _ _ (LitV LitInt <$> xs) xs with "[] [Hl] [HΦ]"). iApply (sort_client_spec N IZ () _ _ (LitV LitInt <$> xs) xs with "[] [Hl] [HΦ]").
{ iApply cmpZ_spec. } { iApply cmpZ_spec. }
{ rewrite -Henc. iFrame "Hl". { rewrite -Henc. iFrame "Hl".
iInduction xs as [|x xs] "IH"; csimpl; first by iFrame. iInduction xs as [|x xs] "IH"; csimpl; first by iFrame.
...@@ -30,4 +30,4 @@ Section list_sort_instances. ...@@ -30,4 +30,4 @@ Section list_sort_instances.
by iDestruct ("IH" with "HI2") as %->. } by iDestruct ("IH" with "HI2") as %->. }
rewrite -Henc. iApply ("HΦ" $! ys with "[$]"). rewrite -Henc. iApply ("HΦ" $! ys with "[$]").
Qed. Qed.
End list_sort_instances. End sort_client.
...@@ -3,7 +3,7 @@ From osiris.channel Require Import proto_channel proofmode. ...@@ -3,7 +3,7 @@ From osiris.channel Require Import proto_channel proofmode.
From iris.heap_lang Require Import proofmode notation. From iris.heap_lang Require Import proofmode notation.
From iris.heap_lang Require Import assert. From iris.heap_lang Require Import assert.
From osiris.utils Require Import list compare. From osiris.utils Require Import list compare.
From osiris.examples Require Import list_sort_elem. From osiris.examples Require Import sort_elem.
Definition send_all : val := Definition send_all : val :=
rec: "go" "c" "xs" := rec: "go" "c" "xs" :=
...@@ -18,21 +18,21 @@ Definition recv_all : val := ...@@ -18,21 +18,21 @@ Definition recv_all : val :=
then let: "x" := recv "c" in lcons "x" ("go" "c") then let: "x" := recv "c" in lcons "x" ("go" "c")
else lnil #(). else lnil #().
Definition list_sort_elem_client : val := Definition sort_elem_client : val :=
λ: "cmp" "xs", λ: "cmp" "xs",
let: "c" := start_chan list_sort_elem_service_top in let: "c" := start_chan sort_elem_service_top in
send "c" "cmp";; send "c" "cmp";;
send_all "c" "xs";; send_all "c" "xs";;
recv_all "c". recv_all "c".
Section list_sort_elem_client. Section sort_elem_client.
Context `{!heapG Σ, !proto_chanG Σ} (N : namespace). Context `{!heapG Σ, !proto_chanG Σ} (N : namespace).
Context {A} (I : A val iProp Σ) (R : relation A) `{!RelDecision R, !Total R}. Context {A} (I : A val iProp Σ) (R : relation A) `{!RelDecision R, !Total R}.
Lemma send_all_spec c p xs' xs vs : Lemma send_all_spec c p xs' xs vs :
{{{ c head_protocol I R xs' <++> p @ N [ list] x;v xs;vs, I x v }}} {{{ c sort_elem_head_protocol I R xs' <++> p @ N [ list] x;v xs;vs, I x v }}}
send_all c (val_encode vs) send_all c (val_encode vs)
{{{ RET #(); c tail_protocol I R (xs' ++ xs) [] <++> p @ N }}}. {{{ RET #(); c sort_elem_tail_protocol I R (xs' ++ xs) [] <++> p @ N }}}.
Proof. Proof.
iIntros (Φ) "[Hc HI] HΦ". iIntros (Φ) "[Hc HI] HΦ".
iInduction xs as [|x xs] "IH" forall (xs' vs); destruct vs as [|v vs]=>//. iInduction xs as [|x xs] "IH" forall (xs' vs); destruct vs as [|v vs]=>//.
...@@ -44,7 +44,7 @@ Section list_sort_elem_client. ...@@ -44,7 +44,7 @@ Section list_sort_elem_client.
Lemma recv_all_spec c p xs ys' : Lemma recv_all_spec c p xs ys' :
Sorted R ys' Sorted R ys'
{{{ c tail_protocol I R xs ys' <++> p @ N }}} {{{ c sort_elem_tail_protocol I R xs ys' <++> p @ N }}}
recv_all c recv_all c
{{{ ys ws, RET (val_encode ws); {{{ ys ws, RET (val_encode ws);
Sorted R (ys' ++ ys) ys' ++ ys xs Sorted R (ys' ++ ys) ys' ++ ys xs
...@@ -63,22 +63,22 @@ Section list_sort_elem_client. ...@@ -63,22 +63,22 @@ Section list_sort_elem_client.
iApply ("HΦ" $! [] []); rewrite /= right_id_L; by iFrame. iApply ("HΦ" $! [] []); rewrite /= right_id_L; by iFrame.
Qed. Qed.
Lemma list_sort_client_spec cmp vs xs : Lemma sort_client_spec cmp vs xs :
cmp_spec I R cmp - cmp_spec I R cmp -
{{{ [ list] x;v xs;vs, I x v }}} {{{ [ list] x;v xs;vs, I x v }}}
list_sort_elem_client cmp (val_encode vs) sort_elem_client cmp (val_encode vs)
{{{ ys ws, RET (val_encode ws); Sorted R ys ys xs {{{ ys ws, RET (val_encode ws); Sorted R ys ys xs
[ list] y;w ys;ws, I y w }}}. [ list] y;w ys;ws, I y w }}}.
Proof. Proof.
iIntros "#Hcmp !>" (Φ) "HI HΦ". wp_lam. iIntros "#Hcmp !>" (Φ) "HI HΦ". wp_lam.
wp_apply (start_chan_proto_spec N (list_sort_elem_top_protocol <++> END)%proto); wp_apply (start_chan_proto_spec N (sort_elem_top_protocol <++> END)%proto);
iIntros (c) "Hc". iIntros (c) "Hc".
{ wp_apply (list_sort_elem_service_top_spec N with "Hc"); auto. } { wp_apply (sort_elem_service_top_spec N with "Hc"); auto. }
rewrite /list_sort_elem_top_protocol. rewrite /sort_elem_top_protocol.
wp_send (A I R) with "[$Hcmp]". wp_send (A I R) with "[$Hcmp]".
wp_apply (send_all_spec with "[$HI $Hc]"); iIntros "Hc". wp_apply (send_all_spec with "[$HI $Hc]"); iIntros "Hc".
wp_apply (recv_all_spec _ _ _ [] with "[$Hc]"); auto. wp_apply (recv_all_spec _ _ _ [] with "[$Hc]"); auto.
iIntros (ys ws) "/=". iDestruct 1 as (??) "[_ HI]". iIntros (ys ws) "/=". iDestruct 1 as (??) "[_ HI]".
iApply "HΦ"; auto. iApply "HΦ"; auto.
Qed. Qed.
End list_sort_elem_client. End sort_elem_client.
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