Commit 70e0bae2 authored by Robbert Krebbers's avatar Robbert Krebbers

Kill bigops.

parent 4ae19de7
...@@ -67,8 +67,8 @@ Section channel. ...@@ -67,8 +67,8 @@ Section channel.
Definition chan_inv (γ : chan_name) (l r : loc) : iProp Σ := Definition chan_inv (γ : chan_name) (l r : loc) : iProp Σ :=
( ls rs, ( ls rs,
llist l ls own (chan_l_name γ) ( to_auth_excl ls) llist sbi_internal_eq l ls own (chan_l_name γ) ( to_auth_excl ls)
llist r rs own (chan_r_name γ) ( to_auth_excl rs))%I. llist sbi_internal_eq r rs own (chan_r_name γ) ( to_auth_excl rs))%I.
Typeclasses Opaque chan_inv. Typeclasses Opaque chan_inv.
Definition is_chan (γ : chan_name) (c1 c2 : val) : iProp Σ := Definition is_chan (γ : chan_name) (c1 c2 : val) : iProp Σ :=
...@@ -99,8 +99,8 @@ Section channel. ...@@ -99,8 +99,8 @@ Section channel.
iMod (own_alloc ( (to_auth_excl []) (to_auth_excl []))) as (rsγ) "[Hrs Hrs']". iMod (own_alloc ( (to_auth_excl []) (to_auth_excl []))) as (rsγ) "[Hrs Hrs']".
{ by apply auth_both_valid. } { by apply auth_both_valid. }
wp_apply (newlock_spec N ( ls rs, wp_apply (newlock_spec N ( ls rs,
llist l ls own lsγ ( to_auth_excl ls) llist sbi_internal_eq l ls own lsγ ( to_auth_excl ls)
llist r rs own rsγ ( to_auth_excl rs))%I with "[Hl Hr Hls Hrs]"). llist sbi_internal_eq r rs own rsγ ( to_auth_excl rs))%I with "[Hl Hr Hls Hrs]").
{ eauto 10 with iFrame. } { eauto 10 with iFrame. }
iIntros (lk γlk) "#Hlk". wp_pures. iIntros (lk γlk) "#Hlk". wp_pures.
iApply ("HΦ" $! _ _ (Chan_name γlk lsγ rsγ)); simpl. iApply ("HΦ" $! _ _ (Chan_name γlk lsγ rsγ)); simpl.
...@@ -109,9 +109,9 @@ Section channel. ...@@ -109,9 +109,9 @@ Section channel.
Lemma chan_inv_alt s γ l r : Lemma chan_inv_alt s γ l r :
chan_inv γ l r ls rs, chan_inv γ l r ls rs,
llist (side_elim s l r) ls llist sbi_internal_eq (side_elim s l r) ls
own (side_elim s chan_l_name chan_r_name γ) ( to_auth_excl ls) own (side_elim s chan_l_name chan_r_name γ) ( to_auth_excl ls)
llist (side_elim s r l) rs llist sbi_internal_eq (side_elim s r l) rs
own (side_elim s chan_r_name chan_l_name γ) ( to_auth_excl rs). own (side_elim s chan_r_name chan_l_name γ) ( to_auth_excl rs).
Proof. Proof.
destruct s; rewrite /chan_inv //=. destruct s; rewrite /chan_inv //=.
...@@ -137,7 +137,7 @@ Section channel. ...@@ -137,7 +137,7 @@ Section channel.
iDestruct (excl_eq with "Hvs Hchan") as %<-%leibniz_equiv. iDestruct (excl_eq with "Hvs Hchan") as %<-%leibniz_equiv.
iMod (excl_update _ _ _ (vs ++ [v]) with "Hvs Hchan") as "[Hvs Hchan]". iMod (excl_update _ _ _ (vs ++ [v]) with "Hvs Hchan") as "[Hvs Hchan]".
wp_pures. 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 (lsnoc_spec with "[$Hll //]"); iIntros "Hll".
wp_apply (release_spec with "[-HΦ $Hlock $Hlocked]"); last eauto. wp_apply (release_spec with "[-HΦ $Hlock $Hlocked]"); last eauto.
iApply (chan_inv_alt s). iApply (chan_inv_alt s).
rewrite /llist. eauto 20 with iFrame. rewrite /llist. eauto 20 with iFrame.
...@@ -171,7 +171,7 @@ Section channel. ...@@ -171,7 +171,7 @@ Section channel.
iMod (excl_update _ _ _ vs with "Hvs Hvs'") as "[Hvs Hvs']". iMod (excl_update _ _ _ vs with "Hvs Hvs'") as "[Hvs Hvs']".
wp_pures. iMod ("HΦ" with "[//] Hvs'") as "HΦ"; iModIntro. wp_pures. iMod ("HΦ" with "[//] Hvs'") as "HΦ"; iModIntro.
wp_apply (lisnil_spec with "Hll"); iIntros "Hll". wp_apply (lisnil_spec with "Hll"); iIntros "Hll".
wp_apply (lpop_spec with "Hll"); iIntros "Hll". wp_apply (lpop_spec with "Hll"); iIntros (v') "[% Hll]"; simplify_eq/=.
wp_apply (release_spec with "[-HΦ $Hlocked $Hlock]"). wp_apply (release_spec with "[-HΦ $Hlocked $Hlock]").
{ iApply (chan_inv_alt s). { iApply (chan_inv_alt s).
rewrite /llist. eauto 10 with iFrame. } rewrite /llist. eauto 10 with iFrame. }
......
...@@ -63,9 +63,7 @@ Section map. ...@@ -63,9 +63,7 @@ Section map.
Implicit Types n : nat. Implicit Types n : nat.
Definition map_spec (vmap : val) : iProp Σ := ( x v, Definition map_spec (vmap : val) : iProp Σ := ( x v,
{{{ IA x v }}} {{{ IA x v }}} vmap v {{{ l, RET #l; llist IB l (map x) }}})%I.
vmap v
{{{ 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 Σ) : Definition map_worker_protocol_aux (rec : nat -d> gmultiset A -d> iProto Σ) :
nat -d> gmultiset A -d> iProto Σ := λ i X, nat -d> gmultiset A -d> iProto Σ := λ i X,
...@@ -75,7 +73,7 @@ Section map. ...@@ -75,7 +73,7 @@ Section map.
<+> <+>
rec (pred i) X rec (pred i) X
) <{ i 1 X = }&> ) <{ i 1 X = }&>
<?> x (l : loc) ws, MSG #l {{ x X llist l ws [ list] y;w map x;ws, IB y w }}; <?> x (l : loc), MSG #l {{ x X llist IB l (map x) }};
rec i (X {[ x ]}))%proto. rec i (X {[ x ]}))%proto.
Instance map_worker_protocol_aux_contractive : Contractive map_worker_protocol_aux. Instance map_worker_protocol_aux_contractive : Contractive map_worker_protocol_aux.
Proof. solve_proper_prepare. f_equiv. solve_proto_contractive. Qed. Proof. solve_proper_prepare. f_equiv. solve_proto_contractive. Qed.
...@@ -112,7 +110,7 @@ Section map. ...@@ -112,7 +110,7 @@ Section map.
rewrite left_id_L. rewrite left_id_L.
wp_apply (release_spec with "[$Hlk $Hl Hc Hs]"). wp_apply (release_spec with "[$Hlk $Hl Hc Hs]").
{ iExists (S i), _. iFrame. } { iExists (S i), _. iFrame. }
clear dependent i X. iIntros "Hu". wp_apply ("Hmap" with "HI"); iIntros (l ws) "HI". clear dependent i X. iIntros "Hu". wp_apply ("Hmap" with "HI"); iIntros (l) "HI".
wp_apply (acquire_spec with "[$Hlk $Hu]"); iIntros "[Hl H]". wp_apply (acquire_spec with "[$Hlk $Hu]"); iIntros "[Hl H]".
iDestruct "H" as (i X) "[Hs Hc]". iDestruct "H" as (i X) "[Hs Hc]".
iDestruct (@server_agree with "Hs Hγ") iDestruct (@server_agree with "Hs Hγ")
...@@ -159,41 +157,31 @@ Section map. ...@@ -159,41 +157,31 @@ Section map.
wp_apply (start_map_workers_spec with "Hf [$Hlk $Hγs]"); auto. wp_apply (start_map_workers_spec with "Hf [$Hlk $Hγs]"); auto.
Qed. Qed.
Lemma par_map_server_spec n c l k vs xs ws X ys : Lemma par_map_server_spec n c l k xs X ys :
(n = 0 X = xs = []) (n = 0 X = xs = [])
{{{ {{{ llist IA l xs llist IB k ys c map_worker_protocol n X @ N }}}
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 #l #k par_map_server #n c #l #k
{{{ ys' ws', RET #(); {{{ ys', RET #(); ys' (xs ++ elements X) = map llist IB k (ys' ++ ys) }}}.
ys' (xs ++ elements X) = map
llist k ws' [ list] y;w ys' ++ ys;ws', IB y w
}}}.
Proof. Proof.
iIntros (Hn Φ) "(Hl & Hk & Hc & HIA & HIB) HΦ". iIntros (Hn Φ) "(Hl & Hk & Hc) HΦ".
iLöb as "IH" forall (n l vs xs ws X ys Hn Φ); wp_rec; wp_pures; simpl. iLöb as "IH" forall (n l xs X ys Hn Φ); wp_rec; wp_pures; simpl.
case_bool_decide; wp_pures; simplify_eq/=. case_bool_decide; wp_pures; simplify_eq/=.
{ destruct Hn as [-> ->]; first lia. { destruct Hn as [-> ->]; first lia.
iApply ("HΦ" $! []); simpl; auto with iFrame. } iApply ("HΦ" $! []); simpl; auto with iFrame. }
destruct n as [|n]=> //=. wp_branch as %?|%_; wp_pures. destruct n as [|n]=> //=. wp_branch as %?|%_; wp_pures.
- wp_apply (lisnil_spec with "Hl"); iIntros "Hl". - wp_apply (lisnil_spec with "Hl"); iIntros "Hl".
destruct vs as [|v vs], xs as [|x xs]; csimpl; try done; wp_pures. destruct xs as [|x xs]; csimpl; wp_pures.
+ wp_select. wp_pures. rewrite Nat2Z.inj_succ Z.sub_1_r Z.pred_succ. + wp_select. wp_pures. rewrite Nat2Z.inj_succ Z.sub_1_r Z.pred_succ.
iApply ("IH" with "[%] Hl Hk Hc [//] [$] HΦ"); naive_solver. iApply ("IH" with "[%] Hl Hk Hc [$]"); naive_solver.
+ iDestruct "HIA" as "[HIAx HIA]". wp_select. + wp_select. wp_apply (lpop_spec with "Hl"); iIntros (v) "[HIx Hl]".
wp_apply (lpop_spec with "Hl"); iIntros "Hl". wp_send with "[$HIx]".
wp_send with "[$HIAx]". wp_apply ("IH" with "[] Hl Hk Hc"); first done. iIntros (ys').
wp_apply ("IH" with "[] Hl Hk Hc HIA HIB"); first done.
iIntros (ys' ws').
rewrite gmultiset_elements_disj_union gmultiset_elements_singleton. rewrite gmultiset_elements_disj_union gmultiset_elements_singleton.
rewrite assoc_L -(comm _ [x]). iApply "HΦ". rewrite assoc_L -(comm _ [x]). iApply "HΦ".
- wp_recv (x l' w) as (Hx) "[Hl' HIBx]". - wp_recv (x l') as (Hx) "Hl'".
wp_apply (lprep_spec with "[$Hk $Hl']"); iIntros "[Hk _]". wp_apply (lprep_spec with "[$Hk $Hl']"); iIntros "[Hk _]".
wp_apply ("IH" $! _ _ _ _ _ _ (_ ++ _) with "[] Hl Hk Hc HIA [HIBx HIB]"); first done. wp_apply ("IH" with "[] Hl Hk Hc"); first done.
{ simpl; iFrame. } iIntros (ys'); iDestruct 1 as (Hys) "Hk"; simplify_eq/=.
iIntros (ys' ws'); iDestruct 1 as (Hys) "HIB"; simplify_eq/=.
iApply ("HΦ" $! (ys' ++ map x)). iSplit. iApply ("HΦ" $! (ys' ++ map x)). iSplit.
+ iPureIntro. rewrite (gmultiset_disj_union_difference {[ x ]} X) + iPureIntro. rewrite (gmultiset_disj_union_difference {[ x ]} X)
-?gmultiset_elem_of_singleton_subseteq //. -?gmultiset_elem_of_singleton_subseteq //.
...@@ -202,18 +190,18 @@ Section map. ...@@ -202,18 +190,18 @@ Section map.
+ by rewrite -assoc_L. + by rewrite -assoc_L.
Qed. Qed.
Lemma par_map_spec n vmap l vs xs : Lemma par_map_spec n vmap l xs :
0 < n 0 < n
map_spec vmap - map_spec vmap -
{{{ llist l vs [ list] x;v xs;vs, IA x v }}} {{{ llist IA l xs }}}
par_map #n vmap #l par_map #n vmap #l
{{{ k ys ws, RET #k; ys xs = map llist k ws [ list] y;w ys;ws, IB y w }}}. {{{ k ys, RET #k; ys xs = map llist IB k ys }}}.
Proof. Proof.
iIntros (?) "#Hmap !>"; iIntros (Φ) "[Hl HI] HΦ". wp_lam; wp_pures. iIntros (?) "#Hmap !>"; iIntros (Φ) "Hl HΦ". wp_lam; wp_pures.
wp_apply (start_map_service_spec with "Hmap [//]"); iIntros (c) "Hc". wp_apply (start_map_service_spec with "Hmap [//]"); iIntros (c) "Hc".
wp_pures. wp_apply (lnil_spec with "[//]"); iIntros (k) "Hk". wp_pures. wp_apply (lnil_spec with "[//]"); iIntros (k) "Hk".
wp_apply (par_map_server_spec _ _ _ _ _ _ [] [] with "[$Hl $Hk $Hc $HI //]"); first lia. wp_apply (par_map_server_spec with "[$Hl $Hk $Hc //]"); first lia.
iIntros (ys ws) "H". rewrite /= gmultiset_elements_empty !right_id_L . iIntros (ys) "[??]". rewrite /= gmultiset_elements_empty !right_id_L .
wp_pures. by iApply "HΦ". wp_pures. iApply "HΦ"; auto.
Qed. Qed.
End map. End map.
...@@ -222,8 +222,7 @@ Section mapper. ...@@ -222,8 +222,7 @@ Section mapper.
Definition IZB (iy : Z * B) (w : val) : iProp Σ := Definition IZB (iy : Z * B) (w : val) : iProp Σ :=
( w', w = (#iy.1, w')%V IB iy.1 iy.2 w')%I. ( w', w = (#iy.1, w')%V IB iy.1 iy.2 w')%I.
Definition IZBs (iys : Z * list B) (w : val) : iProp Σ := Definition IZBs (iys : Z * list B) (w : val) : iProp Σ :=
( (l : loc) ws, ( (l : loc), w = (#iys.1, #l)%V llist (IB iys.1) l (iys.2))%I.
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). Definition RZB : relation (Z * B) := prod_relation ()%Z (λ _ _ : B, True).
Instance RZB_dec : RelDecision RZB. Instance RZB_dec : RelDecision RZB.
...@@ -241,13 +240,12 @@ Section mapper. ...@@ -241,13 +240,12 @@ Section mapper.
repeat case_bool_decide=> //; unfold RZB, prod_relation in *; naive_solver. repeat case_bool_decide=> //; unfold RZB, prod_relation in *; naive_solver.
Qed. Qed.
Lemma par_map_reduce_map_server_spec n cmap csort l vs xs X ys : Lemma par_map_reduce_map_server_spec n cmap csort l xs X ys :
(n = 0 X = xs = []) (n = 0 X = xs = [])
{{{ {{{
llist l vs llist IA l xs
cmap map_worker_protocol IA IZB map n (X : gmultiset A) @ N cmap map_worker_protocol IA IZB map n (X : gmultiset A) @ N
csort sort_elem_head_protocol IZB RZB ys @ 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 #l par_map_reduce_map_server #n cmap csort #l
{{{ ys', RET #(); {{{ ys', RET #();
...@@ -255,28 +253,26 @@ Section mapper. ...@@ -255,28 +253,26 @@ Section mapper.
csort sort_elem_head_protocol IZB RZB (ys ++ ys') @ N csort sort_elem_head_protocol IZB RZB (ys ++ ys') @ N
}}}. }}}.
Proof. Proof.
iIntros (Hn Φ) "(Hl & Hcmap & Hcsort & HIA) HΦ". iIntros (Hn Φ) "(Hl & Hcmap & Hcsort) HΦ".
iLöb as "IH" forall (n vs xs X ys Hn Φ); wp_rec; wp_pures; simpl. iLöb as "IH" forall (n xs X ys Hn Φ); wp_rec; wp_pures; simpl.
case_bool_decide; wp_pures; simplify_eq/=. case_bool_decide; wp_pures; simplify_eq/=.
{ destruct Hn as [-> ->]; first lia. { destruct Hn as [-> ->]; first lia.
iApply ("HΦ" $! []). rewrite right_id_L. auto. } iApply ("HΦ" $! []). rewrite right_id_L. auto. }
destruct n as [|n]=> //=. wp_branch as %?|%_; wp_pures. destruct n as [|n]=> //=. wp_branch as %?|%_; wp_pures.
- wp_apply (lisnil_spec with "Hl"); iIntros "Hl". - wp_apply (lisnil_spec with "Hl"); iIntros "Hl".
destruct vs as [|v vs], xs as [|x xs]; csimpl; try done; wp_pures. destruct xs as [|x xs]; csimpl; wp_pures.
+ wp_select. wp_pures. rewrite Nat2Z.inj_succ Z.sub_1_r Z.pred_succ. + wp_select. wp_pures. rewrite Nat2Z.inj_succ Z.sub_1_r Z.pred_succ.
iApply ("IH" $! _ _ [] with "[%] Hl Hcmap Hcsort [//] HΦ"); naive_solver. iApply ("IH" $! _ [] with "[%] Hl Hcmap Hcsort HΦ"); naive_solver.
+ iDestruct "HIA" as "[HIAx HIA]". wp_select. + wp_select. wp_apply (lpop_spec with "Hl"); iIntros (v) "[HIx Hl]".
wp_apply (lpop_spec with "Hl"); iIntros "Hl". wp_send with "[$HIx]".
wp_send with "[$HIAx]". wp_apply ("IH" with "[%] Hl Hcmap Hcsort"); first done. iIntros (ys').
wp_apply ("IH" with "[%] Hl Hcmap Hcsort HIA"); first done.
iIntros (ys').
rewrite gmultiset_elements_disj_union gmultiset_elements_singleton. rewrite gmultiset_elements_disj_union gmultiset_elements_singleton.
rewrite assoc_L -(comm _ [x]). iApply "HΦ". rewrite assoc_L -(comm _ [x]). iApply "HΦ".
- wp_recv (x k ws) as (Hx) "[Hk HIBfx]". - wp_recv (x k) as (Hx) "Hk".
rewrite -(right_id END%proto _ (sort_elem_head_protocol _ _ _)). rewrite -(right_id END%proto _ (sort_elem_head_protocol _ _ _)).
wp_apply (send_all_spec with "[$Hk $Hcsort $HIBfx]"); iIntros "Hcsort". wp_apply (send_all_spec with "[$Hk $Hcsort]"); iIntros "Hcsort".
rewrite right_id. rewrite right_id.
wp_apply ("IH" with "[] Hl Hcmap Hcsort HIA"); first done. wp_apply ("IH" with "[] Hl Hcmap Hcsort"); first done.
iIntros (ys'). iDestruct 1 as (Hys) "Hcsort"; simplify_eq/=. iIntros (ys'). iDestruct 1 as (Hys) "Hcsort"; simplify_eq/=.
rewrite -assoc_L. iApply ("HΦ" $! (map x ++ ys') with "[$Hcsort]"). rewrite -assoc_L. iApply ("HΦ" $! (map x ++ ys') with "[$Hcsort]").
iPureIntro. rewrite (gmultiset_disj_union_difference {[ x ]} X) iPureIntro. rewrite (gmultiset_disj_union_difference {[ x ]} X)
...@@ -285,46 +281,42 @@ Section mapper. ...@@ -285,46 +281,42 @@ Section mapper.
by rewrite gmultiset_elements_singleton assoc_L bind_app -Hys /= right_id_L comm. by rewrite gmultiset_elements_singleton assoc_L bind_app -Hys /= right_id_L comm.
Qed. Qed.
Lemma par_map_reduce_collect_spec csort iys iys_sorted i l ys ws : Lemma par_map_reduce_collect_spec csort iys iys_sorted i l ys :
let acc := from_option (λ '(i,y,w), [(i,y)]) [] in let acc := from_option (λ '(i,y,w), [(i,y)]) [] in
let accv := from_option (λ '(i,y,w), SOMEV (#(i:Z),w)) NONEV in let accv := from_option (λ '(i,y,w), SOMEV (#(i:Z),w)) NONEV in
ys [] ys []
Sorted RZB (iys_sorted ++ ((i,) <$> ys)) Sorted RZB (iys_sorted ++ ((i,) <$> ys))
i iys_sorted.*1 i iys_sorted.*1
{{{ {{{
llist l (reverse ws) llist (IB i) l (reverse ys)
csort sort_elem_tail_protocol IZB RZB iys (iys_sorted ++ ((i,) <$> ys)) @ N 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 #l par_map_reduce_collect csort #i #l
{{{ ys' ws' miy, RET accv miy; {{{ ys' miy, RET accv miy;
Sorted RZB ((iys_sorted ++ ((i,) <$> ys ++ ys')) ++ acc miy) Sorted RZB ((iys_sorted ++ ((i,) <$> ys ++ ys')) ++ acc miy)
from_option (λ '(j,_,_), i j j iys_sorted.*1) from_option (λ '(j,_,_), i j j iys_sorted.*1)
(iys_sorted ++ ((i,) <$> ys ++ ys') iys) miy (iys_sorted ++ ((i,) <$> ys ++ ys') iys) miy
llist l (reverse ws') llist (IB i) l (reverse (ys ++ ys'))
csort from_option (λ _, sort_elem_tail_protocol IZB RZB iys csort from_option (λ _, sort_elem_tail_protocol IZB RZB iys
((iys_sorted ++ ((i,) <$> ys ++ ys')) ++ acc miy)) END%proto miy @ N ((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 from_option (λ '(i,y,w), IB i y w) True miy
}}}. }}}.
Proof. Proof.
iIntros (acc accv Hys Hsort Hi Φ) "(Hl & Hcsort & HIB) HΦ". iIntros (acc accv Hys Hsort Hi Φ) "[Hl Hcsort] HΦ".
iLöb as "IH" forall (ys ws Hys Hsort Hi Φ); wp_rec; wp_pures; simpl. iLöb as "IH" forall (ys Hys Hsort Hi Φ); wp_rec; wp_pures; simpl.
wp_branch as %_|%Hperm; last first; wp_pures. wp_branch as %_|%Hperm; last first; wp_pures.
{ iApply ("HΦ" $! [] _ None with "[$Hl $Hcsort HIB]"); simpl. { iApply ("HΦ" $! [] None with "[Hl $Hcsort]"); simpl.
iEval (rewrite !right_id_L); auto with iFrame. } iEval (rewrite !right_id_L); auto with iFrame. }
wp_recv ([j y] ?) as (Htl w ->) "HIBy /=". wp_pures. rewrite -assoc_L. wp_recv ([j y] ?) as (Htl w ->) "HIy /=". wp_pures. rewrite -assoc_L.
case_bool_decide as Hij; simplify_eq/=; wp_pures. case_bool_decide as Hij; simplify_eq/=; wp_pures.
- wp_apply (lcons_spec with "Hl"); iIntros "Hl". - wp_apply (lcons_spec with "[$Hl $HIy]"); iIntros "Hl".
rewrite -reverse_snoc. wp_apply ("IH" $! (ys ++ [y]) rewrite -reverse_snoc. wp_apply ("IH" $! (ys ++ [y])
with "[%] [%] [//] Hl [Hcsort] [HIB HIBy] [HΦ]"); try iClear "IH". with "[%] [%] [//] Hl [Hcsort] [HΦ]"); try iClear "IH".
+ intros ?; discriminate_list. + intros ?; discriminate_list.
+ rewrite fmap_app /= assoc_L. by apply Sorted_snoc. + rewrite fmap_app /= assoc_L. by apply Sorted_snoc.
+ by rewrite fmap_app /= assoc_L. + by rewrite fmap_app /= assoc_L.
+ iApply (big_sepL2_app with "HIB"). by iFrame. + iIntros "!>" (ys' miy). rewrite -!(assoc_L _ ys) /=. iApply "HΦ".
+ iIntros "!>" (ys' ws' miy). rewrite -!(assoc_L _ ys) /=. - iApply ("HΦ" $! [] (Some (j,y,w))).
iApply ("HΦ" $! (y :: ys')).
- iApply ("HΦ" $! [] _ (Some (j,y,w))).
rewrite /= !right_id_L assoc_L. iFrame. iPureIntro; split. rewrite /= !right_id_L assoc_L. iFrame. iPureIntro; split.
{ by apply Sorted_snoc. } { by apply Sorted_snoc. }
split; first congruence. split; first congruence.
...@@ -338,61 +330,56 @@ Section mapper. ...@@ -338,61 +330,56 @@ Section mapper.
eapply elem_of_StronglySorted_app; set_solver. eapply elem_of_StronglySorted_app; set_solver.
Qed. Qed.
Lemma par_map_reduce_reduce_server_spec n iys iys_sorted miy zs l ws Y csort cred : Lemma par_map_reduce_reduce_server_spec n iys iys_sorted miy zs l Y csort cred :
let acc := from_option (λ '(i,y,w), [(i,y)]) [] in let acc := from_option (λ '(i,y,w), [(i,y)]) [] in
let accv := from_option (λ '(i,y,w), SOMEV (#(i:Z),w)) NONEV in let accv := from_option (λ '(i,y,w), SOMEV (#(i:Z),w)) NONEV in
(n = 0 miy = None Y = ) (n = 0 miy = None Y = )
from_option (λ '(i,_,_), i iys_sorted.*1) (iys_sorted iys) miy from_option (λ '(i,_,_), i iys_sorted.*1) (iys_sorted iys) miy
Sorted RZB (iys_sorted ++ acc miy) Sorted RZB (iys_sorted ++ acc miy)
{{{ {{{
llist l ws llist IC l zs
csort from_option (λ _, sort_elem_tail_protocol IZB RZB iys csort from_option (λ _, sort_elem_tail_protocol IZB RZB iys
(iys_sorted ++ acc miy)) END%proto miy @ N (iys_sorted ++ acc miy)) END%proto miy @ N
cred map_worker_protocol IZBs IC (curry red) n (Y : gmultiset (Z * list B)) @ N cred map_worker_protocol IZBs IC (curry red) n (Y : gmultiset (Z * list B)) @ N
from_option (λ '(i,y,w), IB i y w) True miy from_option (λ '(i,y,w), IB i y w) True miy
([ list] z;w zs;ws, IC z w)
}}} }}}
par_map_reduce_reduce_server #n csort cred (accv miy) #l par_map_reduce_reduce_server #n csort cred (accv miy) #l
{{{ zs' ws', RET #(); {{{ zs', RET #();
(group iys_sorted = curry red) ++ zs' (group iys ++ elements Y) = curry red (group iys_sorted = curry red) ++ zs' (group iys ++ elements Y) = curry red
llist l ws' [ list] z;w zs' ++ zs;ws', IC z w llist IC l (zs' ++ zs)
}}}. }}}.
Proof. Proof.
iIntros (acc accv Hn Hmiy Hsort Φ) "(Hl & Hcsort & Hcred & HIB & HIC) HΦ". iIntros (acc accv Hn Hmiy Hsort Φ) "(Hl & Hcsort & Hcred & HImiy) HΦ".
iLöb as "IH" forall (n iys_sorted miy zs ws Y Hn Hmiy Hsort Φ); wp_rec; wp_pures; simpl. iLöb as "IH" forall (n iys_sorted miy zs Y Hn Hmiy Hsort Φ); wp_rec; wp_pures; simpl.
case_bool_decide; wp_pures; simplify_eq/=. case_bool_decide; wp_pures; simplify_eq/=.
{ destruct Hn as [-> ->]; first lia. { destruct Hn as [-> ->]; first lia.
iApply ("HΦ" $! [] with "[$Hl $HIC]"); iPureIntro; simpl. iApply ("HΦ" $! [] with "[$Hl]"); iPureIntro; simpl.
by rewrite gmultiset_elements_empty !right_id_L Hmiy. } by rewrite gmultiset_elements_empty !right_id_L Hmiy. }
destruct n as [|n]=> //=. wp_branch as %?|%_; wp_pures. destruct n as [|n]=> //=. wp_branch as %?|%_; wp_pures.
- destruct miy as [[[i y] w]|]; simplify_eq/=; wp_pures; last first. - destruct miy as [[[i y] w]|]; simplify_eq/=; wp_pures; last first.
+ wp_select. wp_pures. rewrite Nat2Z.inj_succ Z.sub_1_r Z.pred_succ. + wp_select. wp_pures. rewrite Nat2Z.inj_succ Z.sub_1_r Z.pred_succ.
iApply ("IH" $! _ _ None iApply ("IH" $! _ _ None
with "[%] [%] [%] Hl Hcsort Hcred [] HIC HΦ"); naive_solver. with "[%] [%] [%] Hl Hcsort Hcred [] HΦ"); naive_solver.
+ wp_apply (lnil_spec with "[//]"); iIntros (k) "Hk". + wp_apply (lnil_spec (IB i) with "[//]"); iIntros (k) "Hk".
wp_apply (lcons_spec with "Hk"); iIntros "Hk". wp_apply (lcons_spec with "[$Hk $HImiy]"); iIntros "Hk".
wp_apply (par_map_reduce_collect_spec _ _ _ _ _ [_] [_] wp_apply (par_map_reduce_collect_spec _ _ _ _ _ [_]
with "[$Hk $Hcsort HIB]"); try done. with "[$Hk $Hcsort]"); try done.
{ simpl; iFrame. } iIntros (ys' miy). iDestruct 1 as (? Hmiy') "(Hk & Hcsort & HImiy)"; csimpl.
iIntros (ys' ws'' miy). wp_select; wp_pures. wp_send ((i, reverse (y :: ys'))) with "[Hk]".
iDestruct 1 as (? Hmiy') "(Hk & Hcsort & HIB & HIC')"; csimpl. { iExists k; simpl; auto. }
wp_select; wp_pures. wp_send ((i, reverse (y :: ys'))) with "[HIB Hk]".
{ iExists k, (reverse ws''); rewrite /= big_sepL2_reverse; auto with iFrame. }
wp_pures. iApply ("IH" $! _ (_ ++ _) miy wp_pures. iApply ("IH" $! _ (_ ++ _) miy
with "[%] [%] [//] Hl Hcsort Hcred HIC' HIC"); first done. with "[%] [%] [//] Hl Hcsort Hcred HImiy"); first done.
{ destruct miy as [[[i' y'] w']|]; set_solver +Hmiy'. } { destruct miy as [[[i' y'] w']|]; set_solver +Hmiy'. }
iIntros "!>" (zs' ws'''). iDestruct 1 as (Hperm) "HIC". iIntros "!>" (zs'). iDestruct 1 as (Hperm) "HIC".
iApply ("HΦ" with "[$HIC]"); iPureIntro; move: Hperm. iApply ("HΦ" with "[$HIC]"); iPureIntro; move: Hperm.
rewrite gmultiset_elements_disj_union gmultiset_elements_singleton. rewrite gmultiset_elements_disj_union gmultiset_elements_singleton.
rewrite group_snoc // reverse_Permutation. rewrite group_snoc // reverse_Permutation.
rewrite !bind_app /= right_id_L -!assoc_L -(comm _ zs') !assoc_L. rewrite !bind_app /= right_id_L -!assoc_L -(comm _ zs') !assoc_L.
apply (inj (++ _)). apply (inj (++ _)).
- wp_recv ([i ys] k ws') as (Hy) "[Hk HICi]". - wp_recv ([i ys] k) as (Hy) "Hk".
wp_apply (lprep_spec with "[$Hl $Hk]"); iIntros "[Hl _]". wp_apply (lprep_spec with "[$Hl $Hk]"); iIntros "[Hl _]".
wp_apply ("IH" $! _ _ _ (_ ++ _) wp_apply ("IH" with "[ ] [//] [//] Hl Hcsort Hcred HImiy"); first done.
with "[ ] [//] [//] Hl Hcsort Hcred HIB [HIC HICi]"); first done. iIntros (zs'); iDestruct 1 as (Hzs) "HIC"; simplify_eq/=.
{ simpl; iFrame. }
iIntros (zs' ws''); iDestruct 1 as (Hzs) "HIC"; simplify_eq/=.
iApply ("HΦ" $! (zs' ++ red i ys)). iSplit; last by rewrite -assoc_L. iApply ("HΦ" $! (zs' ++ red i ys)). iSplit; last by rewrite -assoc_L.
iPureIntro. rewrite (gmultiset_disj_union_difference {[ i,ys ]} Y) iPureIntro. rewrite (gmultiset_disj_union_difference {[ i,ys ]} Y)
-?gmultiset_elem_of_singleton_subseteq //. -?gmultiset_elem_of_singleton_subseteq //.
...@@ -401,37 +388,35 @@ Section mapper. ...@@ -401,37 +388,35 @@ Section mapper.
by rewrite right_id_L !assoc_L. by rewrite right_id_L !assoc_L.
Qed. Qed.
Lemma par_map_reduce_spec n vmap vred l vs xs : Lemma par_map_reduce_spec n vmap vred l xs :