Commit 26dc79c4 authored by Robbert Krebbers's avatar Robbert Krebbers

Use proper linked lists instead of functional lists.

TODO: fix in-place merge function.
parent 16045d70
-Q theories actris
-arg -w -arg -notation-overridden,-redundant-canonical-projection,-several-object-files
theories/utils/auth_excl.v
theories/utils/list.v
theories/utils/flist.v
theories/utils/llist.v
theories/utils/compare.v
theories/utils/contribution.v
theories/channel/channel.v
......
From iris.heap_lang Require Import proofmode notation.
From iris.heap_lang.lib Require Import spin_lock.
From iris.algebra Require Import excl auth list.
From actris.utils Require Import auth_excl list.
From actris.utils Require Import auth_excl llist.
Set Default Proof Using "Type".
Inductive side := Left | Right.
......@@ -11,8 +11,8 @@ Definition side_elim {A} (s : side) (l r : A) : A :=
Definition new_chan : val :=
λ: <>,
let: "l" := ref (lnil #()) in
let: "r" := ref (lnil #()) in
let: "l" := lnil #() in
let: "r" := lnil #() in
let: "lk" := newlock #() in
((("l","r"),"lk"), (("r","l"),"lk")).
......@@ -21,7 +21,7 @@ Definition send : val :=
let: "lk" := Snd "c" in
acquire "lk";;
let: "l" := Fst (Fst "c") in
"l" <- lsnoc !"l" "v";;
lsnoc "l" "v";;
release "lk".
Definition try_recv : val :=
......@@ -29,11 +29,7 @@ Definition try_recv : val :=
let: "lk" := Snd "c" in
acquire "lk";;
let: "l" := Snd (Fst "c") in
let: "ret" :=
match: !"l" with
SOME "p" => "l" <- Snd "p";; SOME (Fst "p")
| NONE => NONE
end in
let: "ret" := if: lisnil "l" then NONE else SOME (lpop "l") in
release "lk";; "ret".
Definition recv : val :=
......@@ -52,27 +48,32 @@ Definition chanΣ : gFunctors :=
Instance subG_chanΣ {Σ} : subG chanΣ Σ chanG Σ.
Proof. solve_inG. Qed.
(** MOVE TO IRIS *)
Global Instance fst_atomic a v1 v2 : Atomic a (Fst (v1,v2)%V).
Proof.
apply strongly_atomic_atomic, ectx_language_atomic;
[inversion 1; naive_solver
|apply ectxi_language_sub_redexes_are_values; intros [] **; naive_solver].
Qed.
Section channel.
Context `{!heapG Σ, !chanG Σ} (N : namespace).
Definition is_list_ref (l : val) (xs : list val) : iProp Σ :=
( l' : loc, l = #l' l' llist xs)%I.
Record chan_name := Chan_name {
chan_lock_name : gname;
chan_l_name : gname;
chan_r_name : gname
}.
Definition chan_inv (γ : chan_name) (l r : val) : iProp Σ :=
Definition chan_inv (γ : chan_name) (l r : loc) : iProp Σ :=
( ls rs,
is_list_ref l ls own (chan_l_name γ) ( to_auth_excl ls)
is_list_ref r rs own (chan_r_name γ) ( to_auth_excl rs))%I.
llist l ls own (chan_l_name γ) ( to_auth_excl ls)
llist r rs own (chan_r_name γ) ( to_auth_excl rs))%I.
Typeclasses Opaque chan_inv.
Definition is_chan (γ : chan_name) (c1 c2 : val) : iProp Σ :=
( l r lk : val,
c1 = ((l, r), lk)%V c2 = ((r, l), lk)%V
( (l r : loc) (lk : val),
c1 = ((#l, #r), lk)%V c2 = ((#r, #l), lk)%V
is_lock N (chan_lock_name γ) lk (chan_inv γ l r))%I.
Global Instance is_chan_persistent : Persistent (is_chan γ c1 c2).
......@@ -91,20 +92,15 @@ Section channel.
Proof.
iIntros (Φ) "_ HΦ". rewrite /is_chan /chan_own.
wp_lam.
wp_apply (lnil_spec with "[//]"); iIntros (ls). wp_alloc l as "Hl".
wp_apply (lnil_spec with "[//]"); iIntros (rs). wp_alloc r as "Hr".
wp_apply (lnil_spec with "[//]"); iIntros (l) "Hl".
wp_apply (lnil_spec with "[//]"); iIntros (r) "Hr".
iMod (own_alloc ( (to_auth_excl []) (to_auth_excl []))) as (lsγ) "[Hls Hls']".
{ by apply auth_both_valid. }
iMod (own_alloc ( (to_auth_excl []) (to_auth_excl []))) as (rsγ) "[Hrs Hrs']".
{ by apply auth_both_valid. }
iAssert (is_list_ref #l []) with "[Hl]" as "Hl".
{ rewrite /is_list_ref; eauto. }
iAssert (is_list_ref #r []) with "[Hr]" as "Hr".
{ rewrite /is_list_ref; eauto. }
wp_apply (newlock_spec N ( ls rs,
is_list_ref #l ls own lsγ ( to_auth_excl ls)
is_list_ref #r rs own rsγ ( to_auth_excl rs))%I
with "[Hl Hr Hls Hrs]").
llist l ls own lsγ ( to_auth_excl ls)
llist r rs own rsγ ( to_auth_excl rs))%I with "[Hl Hr Hls Hrs]").
{ eauto 10 with iFrame. }
iIntros (lk γlk) "#Hlk". wp_pures.
iApply ("HΦ" $! _ _ (Chan_name γlk lsγ rsγ)); simpl.
......@@ -113,9 +109,9 @@ Section channel.
Lemma chan_inv_alt s γ l r :
chan_inv γ l r ls rs,
is_list_ref (side_elim s l r) ls
llist (side_elim s l r) ls
own (side_elim s chan_l_name chan_r_name γ) ( to_auth_excl ls)
is_list_ref (side_elim s r l) rs
llist (side_elim s r l) rs
own (side_elim s chan_r_name chan_l_name γ) ( to_auth_excl rs).
Proof.
destruct s; rewrite /chan_inv //=.
......@@ -131,24 +127,20 @@ Section channel.
Proof.
iIntros "Hc HΦ". wp_lam; wp_pures.
iDestruct "Hc" as (l r lk [-> ->]) "#Hlock"; wp_pures.
assert (side_elim s (l, r, lk)%V (r, l, lk)%V =
((side_elim s l r, side_elim s r l), lk)%V) as -> by (by destruct s).
assert (side_elim s (#l, #r, lk)%V (#r, #l, lk)%V =
((#(side_elim s l r), #(side_elim s r l)), lk)%V) as -> by (by destruct s).
wp_apply (acquire_spec with "Hlock"); iIntros "[Hlocked Hinv]".
wp_pures.
iDestruct (chan_inv_alt s with "Hinv") as
(vs ws) "(Href & Hvs & Href' & Hws)".
iDestruct "Href" as (ll Hslr) "Hll". rewrite Hslr.
wp_load.
wp_apply (lsnoc_spec with "[//]"); iIntros (_).
wp_bind (_ <- _)%E.
(vs ws) "(Hll & Hvs & Href' & Hws)".
wp_seq. wp_bind (Fst (_,_)%V)%E.
iMod "HΦ" as (vs') "[Hchan HΦ]".
iDestruct (excl_eq with "Hvs Hchan") as %<-%leibniz_equiv.
iMod (excl_update _ _ _ (vs ++ [v]) with "Hvs Hchan") as "[Hvs Hchan]".
wp_store. iMod ("HΦ" with "Hchan") as "HΦ".
iModIntro.
wp_pures. iMod ("HΦ" with "Hchan") as "HΦ"; iModIntro.
wp_apply (lsnoc_spec with "Hll"); iIntros "Hll".
wp_apply (release_spec with "[-HΦ $Hlock $Hlocked]"); last eauto.
iApply (chan_inv_alt s).
rewrite /is_list_ref. eauto 20 with iFrame.
rewrite /llist. eauto 20 with iFrame.
Qed.
Lemma try_recv_spec Φ E γ c1 c2 s :
......@@ -162,28 +154,27 @@ Section channel.
Proof.
iIntros "Hc HΦ". wp_lam; wp_pures.
iDestruct "Hc" as (l r lk [-> ->]) "#Hlock"; wp_pures.
assert (side_elim s (r, l, lk)%V (l, r, lk)%V =
((side_elim s r l, side_elim s l r), lk)%V) as -> by (by destruct s).
assert (side_elim s (#r, #l, lk)%V (#l, #r, lk)%V =
((#(side_elim s r l), #(side_elim s l r)), lk)%V) as -> by (by destruct s).
wp_apply (acquire_spec with "Hlock"); iIntros "[Hlocked Hinv]".
wp_pures.
iDestruct (chan_inv_alt s with "Hinv")
as (vs ws) "(Href & Hvs & Href' & Hws)".
iDestruct "Href" as (ll Hslr) "Hll". rewrite Hslr.
wp_bind (! _)%E. destruct vs as [|v vs]; simpl.
- iDestruct "HΦ" as "[>HΦ _]". wp_load. iMod "HΦ"; iModIntro.
as (vs ws) "(Hll & Hvs & Href' & Hws)".
wp_seq. wp_bind (Fst (_,_)%V)%E. destruct vs as [|v vs]; simpl.
- iDestruct "HΦ" as "[>HΦ _]". wp_pures. iMod "HΦ"; iModIntro.
wp_apply (lisnil_spec with "Hll"); iIntros "Hll". wp_pures.
wp_apply (release_spec with "[-HΦ $Hlocked $Hlock]").
{ iApply (chan_inv_alt s).
rewrite /is_list_ref. eauto 10 with iFrame. }
rewrite /llist. eauto 10 with iFrame. }
iIntros (_). by wp_pures.
- iDestruct "HΦ" as "[_ >HΦ]". iDestruct "HΦ" as (vs') "[Hvs' HΦ]".
iDestruct (excl_eq with "Hvs Hvs'") as %<-%leibniz_equiv.
iMod (excl_update _ _ _ vs with "Hvs Hvs'") as "[Hvs Hvs']".
wp_load.
iMod ("HΦ" with "[//] Hvs'") as "HΦ"; iModIntro.
wp_store; wp_pures.
wp_pures. iMod ("HΦ" with "[//] Hvs'") as "HΦ"; iModIntro.
wp_apply (lisnil_spec with "Hll"); iIntros "Hll".
wp_apply (lpop_spec with "Hll"); iIntros "Hll".
wp_apply (release_spec with "[-HΦ $Hlocked $Hlock]").
{ iApply (chan_inv_alt s).
rewrite /is_list_ref. eauto 10 with iFrame. }
rewrite /llist. eauto 10 with iFrame. }
iIntros (_). by wp_pures.
Qed.
......
From stdpp Require Import sorting.
From actris.channel Require Import proto_channel.
From iris.heap_lang Require Import proofmode notation.
From actris.utils Require Import list.
From actris.examples Require Import sort.
Definition loop_sort_service : val :=
......
From actris.channel Require Import proto_channel proofmode.
From iris.heap_lang Require Import proofmode notation lib.spin_lock.
From actris.utils Require Import list contribution.
From actris.utils Require Import llist contribution.
From iris.algebra Require Import gmultiset.
Definition map_worker : val :=
......@@ -30,22 +30,25 @@ Definition start_map_service : val := λ: "n" "map",
Definition par_map_server : val :=
rec: "go" "n" "c" "xs" "ys" :=
if: "n" = #0 then "ys" else
if: "n" = #0 then #() else
if: recv "c" then (* send item to map_worker *)
if: lisnil "xs" then
send "c" #false;;
"go" ("n" - #1) "c" "xs" "ys"
else
send "c" #true;;
send "c" (lhead "xs");;
"go" "n" "c" (ltail "xs") "ys"
send "c" (lpop "xs");;
"go" "n" "c" "xs" "ys"
else (* receive item from map_worker *)
let: "zs" := recv "c" in
"go" "n" "c" "xs" (lapp "zs" "ys").
lprep "ys" "zs";;
"go" "n" "c" "xs" "ys".
Definition par_map : val := λ: "n" "map" "xs",
let: "c" := start_map_service "n" "map" in
par_map_server "n" "c" "xs" (lnil #()).
let: "ys" := lnil #() in
par_map_server "n" "c" "xs" "ys";;
"ys".
Class mapG Σ A `{Countable A} := {
map_contributionG :> contributionG Σ (gmultisetUR A);
......@@ -62,7 +65,7 @@ Section map.
Definition map_spec (vmap : val) : iProp Σ := ( x v,
{{{ IA x v }}}
vmap v
{{{ ws, RET (llist ws); [ list] y;w map x;ws, IB y w }}})%I.
{{{ l ws, RET #l; llist l ws [ list] y;w map x;ws, IB y w }}})%I.
Definition map_worker_protocol_aux (rec : nat -d> gmultiset A -d> iProto Σ) :
nat -d> gmultiset A -d> iProto Σ := λ i X,
......@@ -72,7 +75,7 @@ Section map.
<+>
rec (pred i) X
) <{ i 1 X = }&>
<?> x ws, MSG llist ws {{ x X [ list] y;w map x;ws, IB y w }};
<?> x (l : loc) ws, MSG #l {{ x X llist l ws [ list] y;w map x;ws, IB y w }};
rec i (X {[ x ]}))%proto.
Instance map_worker_protocol_aux_contractive : Contractive map_worker_protocol_aux.
Proof. solve_proper_prepare. f_equiv. solve_proto_contractive. Qed.
......@@ -109,7 +112,7 @@ Section map.
rewrite left_id_L.
wp_apply (release_spec with "[$Hlk $Hl Hc Hs]").
{ iExists (S i), _. iFrame. }
clear dependent i X. iIntros "Hu". wp_apply ("Hmap" with "HI"); iIntros (w) "HI".
clear dependent i X. iIntros "Hu". wp_apply ("Hmap" with "HI"); iIntros (l ws) "HI".
wp_apply (acquire_spec with "[$Hlk $Hu]"); iIntros "[Hl H]".
iDestruct "H" as (i X) "[Hs Hc]".
iDestruct (@server_agree with "Hs Hγ")
......@@ -156,38 +159,39 @@ Section map.
wp_apply (start_map_workers_spec with "Hf [$Hlk $Hγs]"); auto.
Qed.
Lemma par_map_server_spec n c vs xs ws X ys :
Lemma par_map_server_spec n c l k vs xs ws X ys :
(n = 0 X = xs = [])
{{{
llist l vs llist k ws
c map_worker_protocol n X @ N
([ list] x;v xs;vs, IA x v) ([ list] y;w ys;ws, IB y w)
}}}
par_map_server #n c (llist vs) (llist ws)
{{{ ys' ws', RET (llist ws');
ys' (xs ++ elements X) = map [ list] y;w ys' ++ ys;ws', IB y w
par_map_server #n c #l #k
{{{ ys' ws', RET #();
ys' (xs ++ elements X) = map
llist k ws' [ list] y;w ys' ++ ys;ws', IB y w
}}}.
Proof.
iIntros (Hn Φ) "(Hc & HIA & HIB) HΦ".
iLöb as "IH" forall (n vs xs ws X ys Hn Φ); wp_rec; wp_pures; simpl.
iIntros (Hn Φ) "(Hl & Hk & Hc & HIA & HIB) HΦ".
iLöb as "IH" forall (n l vs xs ws X ys Hn Φ); wp_rec; wp_pures; simpl.
case_bool_decide; wp_pures; simplify_eq/=.
{ destruct Hn as [-> ->]; first lia.
iApply ("HΦ" $! []); simpl; auto. }
iApply ("HΦ" $! []); simpl; auto with iFrame. }
destruct n as [|n]=> //=. wp_branch as %?|%_; wp_pures.
- wp_apply (lisnil_spec with "[//]"); iIntros (_).
- wp_apply (lisnil_spec with "Hl"); iIntros "Hl".
destruct vs as [|v vs], xs as [|x xs]; csimpl; try done; wp_pures.
+ wp_select. wp_pures. rewrite Nat2Z.inj_succ Z.sub_1_r Z.pred_succ.
iApply ("IH" with "[%] Hc [//] [$] HΦ"); naive_solver.
iApply ("IH" with "[%] Hl Hk Hc [//] [$] HΦ"); naive_solver.
+ iDestruct "HIA" as "[HIAx HIA]". wp_select.
wp_apply (lhead_spec with "[//]"); iIntros (_).
wp_apply (lpop_spec with "Hl"); iIntros "Hl".
wp_send with "[$HIAx]".
wp_apply (ltail_spec with "[//]"); iIntros (_).
wp_apply ("IH" with "[] Hc HIA HIB"); first done.
wp_apply ("IH" with "[] Hl Hk Hc HIA HIB"); first done.
iIntros (ys' ws').
rewrite gmultiset_elements_disj_union gmultiset_elements_singleton.
rewrite assoc_L -(comm _ [x]). iApply "HΦ".
- wp_recv (x w) as (Hx) "HIBx".
wp_apply (lapp_spec with "[//]"); iIntros (_).
wp_apply ("IH" $! _ _ _ _ _ (_ ++ _) with "[] Hc HIA [HIBx HIB]"); first done.
- wp_recv (x l' w) as (Hx) "[Hl' HIBx]".
wp_apply (lprep_spec with "[$Hk $Hl']"); iIntros "[Hk _]".
wp_apply ("IH" $! _ _ _ _ _ _ (_ ++ _) with "[] Hl Hk Hc HIA [HIBx HIB]"); first done.
{ simpl; iFrame. }
iIntros (ys' ws'); iDestruct 1 as (Hys) "HIB"; simplify_eq/=.
iApply ("HΦ" $! (ys' ++ map x)). iSplit.
......@@ -198,17 +202,18 @@ Section map.
+ by rewrite -assoc_L.
Qed.
Lemma par_map_spec n vmap vs xs :
Lemma par_map_spec n vmap l vs xs :
0 < n
map_spec vmap -
{{{ [ list] x;v xs;vs, IA x v }}}
par_map #n vmap (llist vs)
{{{ ys ws, RET (llist ws); ys xs = map [ list] y;w ys;ws, IB y w }}}.
{{{ llist l vs [ list] x;v xs;vs, IA x v }}}
par_map #n vmap #l
{{{ k ys ws, RET #k; ys xs = map llist k ws [ list] y;w ys;ws, IB y w }}}.
Proof.
iIntros (?) "#Hmap !>"; iIntros (Φ) "HI HΦ". wp_lam; wp_pures.
iIntros (?) "#Hmap !>"; iIntros (Φ) "[Hl HI] HΦ". wp_lam; wp_pures.
wp_apply (start_map_service_spec with "Hmap [//]"); iIntros (c) "Hc".
wp_pures. wp_apply (lnil_spec with "[//]"); iIntros (_).
wp_apply (par_map_server_spec _ _ _ _ [] [] with "[$Hc $HI //]"); first lia.
iIntros (ys ws). rewrite /= gmultiset_elements_empty !right_id_L . iApply "HΦ".
wp_pures. wp_apply (lnil_spec with "[//]"); iIntros (k) "Hk".
wp_apply (par_map_server_spec _ _ _ _ _ _ [] [] with "[$Hl $Hk $Hc $HI //]"); first lia.
iIntros (ys ws) "H". rewrite /= gmultiset_elements_empty !right_id_L .
wp_pures. by iApply "HΦ".
Qed.
End map.
From stdpp Require Import sorting.
From actris.channel Require Import proto_channel proofmode.
From iris.heap_lang Require Import proofmode notation.
From actris.utils Require Import list compare contribution.
From actris.utils Require Import llist compare contribution.
From actris.examples Require Import map sort_elem sort_elem_client.
From iris.algebra Require Import gmultiset.
From Coq Require Import SetoidPermutation.
......@@ -40,8 +40,8 @@ Definition par_map_reduce_map_server : val :=
"go" ("n" - #1) "cmap" "csort" "xs"
else
send "cmap" #true;;
send "cmap" (lhead "xs");;
"go" "n" "cmap" "csort" (ltail "xs")
send "cmap" (lpop "xs");;
"go" "n" "cmap" "csort" "xs"
else (* receive item from mapper *)
let: "zs" := recv "cmap" in
send_all "csort" "zs";;
......@@ -49,15 +49,15 @@ Definition par_map_reduce_map_server : val :=
Definition par_map_reduce_collect : val :=
rec: "go" "csort" "i" "ys" :=
if: ~recv "csort" then (("i", "ys"), NONE) else
if: ~recv "csort" then NONE else
let: "jy" := recv "csort" in
let: "j" := Fst "jy" in let: "y" := Snd "jy" in
if: "i" = "j" then "go" "csort" "j" (lcons "y" "ys") else
(("i", "ys"), SOME ("j", "y")).
if: "i" = "j" then lcons "y" "ys";; "go" "csort" "j" "ys" else
SOME ("j", "y").
Definition par_map_reduce_reduce_server : val :=
rec: "go" "n" "csort" "cred" "acc" "zs" :=
if: "n" = #0 then "zs" else
if: "n" = #0 then #() else
if: recv "cred" then (* Send item to mapper *)
match: "acc" with
NONE =>
......@@ -65,15 +65,16 @@ Definition par_map_reduce_reduce_server : val :=
send "cred" #false;; "go" ("n" - #1) "csort" "cred" NONE "zs"
| SOME "acc" =>
(* Read subsequent items with the same key *)
let: "grp" := par_map_reduce_collect "csort"
(Fst "acc") (lcons (Snd "acc") (lnil #())) in
let: "ys" := lcons (Snd "acc") (lnil #()) in
let: "new_acc" := par_map_reduce_collect "csort" (Fst "acc") "ys" in
send "cred" #true;;
send "cred" (Fst "grp");;
"go" "n" "csort" "cred" (Snd "grp") "zs"
send "cred" (Fst "acc", "ys");;
"go" "n" "csort" "cred" "new_acc" "zs"
end
else (* receive item from mapper *)
let: "zs'" := recv "cred" in
"go" "n" "csort" "cred" "acc" (lapp "zs'" "zs").
lprep "zs" "zs'";;
"go" "n" "csort" "cred" "acc" "zs".
Definition cmpZfst : val := λ: "x" "y", Fst "x" Fst "y".
......@@ -86,7 +87,8 @@ Definition par_map_reduce : val := λ: "n" "map" "red" "xs",
(* We need the first sorted element in the loop to compare subsequent elements *)
if: ~recv "csort" then lnil #() else (* Handle the empty case *)
let: "jy" := recv "csort" in
par_map_reduce_reduce_server "n" "csort" "cred" (SOME "jy") (lnil #()).
let: "zs" := lnil #() in
par_map_reduce_reduce_server "n" "csort" "cred" (SOME "jy") "zs";; "zs".
(** Properties about the functional version *)
......@@ -220,7 +222,8 @@ Section mapper.
Definition IZB (iy : Z * B) (w : val) : iProp Σ :=
( w', w = (#iy.1, w')%V IB iy.1 iy.2 w')%I.
Definition IZBs (iys : Z * list B) (w : val) : iProp Σ :=
( ws, w = (#iys.1, llist ws)%V [ list] y;w'iys.2;ws, IB iys.1 y w')%I.
( (l : loc) ws,
w = (#iys.1, #l)%V llist l ws [ list] y;w'iys.2;ws, IB iys.1 y w')%I.
Definition RZB : relation (Z * B) := prod_relation ()%Z (λ _ _ : B, True).
Instance RZB_dec : RelDecision RZB.
......@@ -238,42 +241,42 @@ Section mapper.
repeat case_bool_decide=> //; unfold RZB, prod_relation in *; naive_solver.
Qed.
Lemma par_map_reduce_map_server_spec n cmap csort vs xs X ys :
Lemma par_map_reduce_map_server_spec n cmap csort l vs xs X ys :
(n = 0 X = xs = [])
{{{
llist l vs
cmap map_worker_protocol IA IZB map n (X : gmultiset A) @ N
csort sort_elem_head_protocol IZB RZB ys @ N
([ list] x;v xs;vs, IA x v)
}}}
par_map_reduce_map_server #n cmap csort (llist vs)
par_map_reduce_map_server #n cmap csort #l
{{{ ys', RET #();
ys' (xs ++ elements X) = map
csort sort_elem_head_protocol IZB RZB (ys ++ ys') @ N
}}}.
Proof.
iIntros (Hn Φ) "(Hcmap & Hcsort & HIA) HΦ".
iIntros (Hn Φ) "(Hl & Hcmap & Hcsort & HIA) HΦ".
iLöb as "IH" forall (n vs xs X ys Hn Φ); wp_rec; wp_pures; simpl.
case_bool_decide; wp_pures; simplify_eq/=.
{ destruct Hn as [-> ->]; first lia.
iApply ("HΦ" $! []). rewrite right_id_L. auto. }
destruct n as [|n]=> //=. wp_branch as %?|%_; wp_pures.
- wp_apply (lisnil_spec with "[//]"); iIntros (_).
- wp_apply (lisnil_spec with "Hl"); iIntros "Hl".
destruct vs as [|v vs], xs as [|x xs]; csimpl; try done; wp_pures.
+ wp_select. wp_pures. rewrite Nat2Z.inj_succ Z.sub_1_r Z.pred_succ.
iApply ("IH" $! _ _ [] with "[%] Hcmap Hcsort [//] HΦ"); naive_solver.
iApply ("IH" $! _ _ [] with "[%] Hl Hcmap Hcsort [//] HΦ"); naive_solver.
+ iDestruct "HIA" as "[HIAx HIA]". wp_select.
wp_apply (lhead_spec with "[//]"); iIntros (_).
wp_apply (lpop_spec with "Hl"); iIntros "Hl".
wp_send with "[$HIAx]".
wp_apply (ltail_spec with "[//]"); iIntros (_).
wp_apply ("IH" with "[%] Hcmap Hcsort HIA"); first done.
wp_apply ("IH" with "[%] Hl Hcmap Hcsort HIA"); first done.
iIntros (ys').
rewrite gmultiset_elements_disj_union gmultiset_elements_singleton.
rewrite assoc_L -(comm _ [x]). iApply "HΦ".
- wp_recv (x w) as (Hx) "HIBfx".
- wp_recv (x k ws) as (Hx) "[Hk HIBfx]".
rewrite -(right_id END%proto _ (sort_elem_head_protocol _ _ _)).
wp_apply (send_all_spec with "[$Hcsort $HIBfx]"); iIntros "Hcsort".
wp_apply (send_all_spec with "[$Hk $Hcsort $HIBfx]"); iIntros "Hcsort".
rewrite right_id.
wp_apply ("IH" with "[] Hcmap Hcsort HIA"); first done.
wp_apply ("IH" with "[] Hl Hcmap Hcsort HIA"); first done.
iIntros (ys'). iDestruct 1 as (Hys) "Hcsort"; simplify_eq/=.
rewrite -assoc_L. iApply ("HΦ" $! (map x ++ ys') with "[$Hcsort]").
iPureIntro. rewrite (gmultiset_disj_union_difference {[ x ]} X)
......@@ -282,37 +285,39 @@ Section mapper.
by rewrite gmultiset_elements_singleton assoc_L bind_app -Hys /= right_id_L comm.
Qed.
Lemma par_map_reduce_collect_spec csort iys iys_sorted i ys ws :
Lemma par_map_reduce_collect_spec csort iys iys_sorted i l ys ws :
let acc := from_option (λ '(i,y,w), [(i,y)]) [] in
let accv := from_option (λ '(i,y,w), SOMEV (#(i:Z),w)) NONEV in
ys []
Sorted RZB (iys_sorted ++ ((i,) <$> ys))
i iys_sorted.*1
{{{
llist l (reverse ws)
csort sort_elem_tail_protocol IZB RZB iys (iys_sorted ++ ((i,) <$> ys)) @ N
[ list] y;w ys;ws, IB i y w
}}}
par_map_reduce_collect csort #i (llist (reverse ws))
{{{ ys' ws' miy, RET ((#i,llist (reverse ws')),accv miy);
par_map_reduce_collect csort #i #l
{{{ ys' ws' miy, RET accv miy;
Sorted RZB ((iys_sorted ++ ((i,) <$> ys ++ ys')) ++ acc miy)
from_option (λ '(j,_,_), i j j iys_sorted.*1)
(iys_sorted ++ ((i,) <$> ys ++ ys') iys) miy
llist l (reverse ws')
csort from_option (λ _, sort_elem_tail_protocol IZB RZB iys
((iys_sorted ++ ((i,) <$> ys ++ ys')) ++ acc miy)) END%proto miy @ N
([ list] y;w ys ++ ys';ws', IB i y w)
from_option (λ '(i,y,w), IB i y w) True miy
}}}.
Proof.
iIntros (acc accv Hys Hsort Hi Φ) "[Hcsort HIB] HΦ".
iIntros (acc accv Hys Hsort Hi Φ) "(Hl & Hcsort & HIB) HΦ".
iLöb as "IH" forall (ys ws Hys Hsort Hi Φ); wp_rec; wp_pures; simpl.
wp_branch as %_|%Hperm; last first; wp_pures.
{ iApply ("HΦ" $! [] _ None with "[$Hcsort HIB]"); simpl.
iEval (rewrite !right_id_L); auto. }
{ iApply ("HΦ" $! [] _ None with "[$Hl $Hcsort HIB]"); simpl.
iEval (rewrite !right_id_L); auto with iFrame. }
wp_recv ([j y] ?) as (Htl w ->) "HIBy /=". wp_pures. rewrite -assoc_L.