Section PartialExtendedMapSimulations.
Context {base_fst : BaseParams}.
Context {base_snd : BaseParams}.
Context {multi_fst : MultiParams base_fst}.
Context {multi_snd : MultiParams base_snd}.
Context {name_map : MultiParamsNameTotalMap multi_fst multi_snd}.
Context {msg_map : MultiParamsMsgPartialMap multi_fst multi_snd}.
Context {multi_map : MultiParamsPartialExtendedMap multi_fst multi_snd}.
Context {name_map_bijective : MultiParamsNameTotalMapBijective name_map}.
Context {multi_map_congr : MultiParamsPartialExtendedMapCongruency name_map msg_map multi_map}.
Proof using name_map_bijective multi_map_congr msg_map.
apply functional_extensionality => n.
have H_eq := pt_ext_init_handlers_eq.
rewrite H_eq {H_eq}.
by rewrite tot_map_name_inverse_inv.
Qed.
Definition pt_ext_map_net (net : @network  _ multi_fst) : @network _ multi_snd :=
{| nwPackets := filterMap pt_map_packet net.(nwPackets) ;
nwState := fun n => pt_ext_map_data (net.(nwState) (tot_map_name_inv n)) (tot_map_name_inv n) |}.
Proof using name_map_bijective.
move => f h d.
apply functional_extensionality => n.
rewrite /update /=.
case (name_eq_dec _ _) => H_dec; case (name_eq_dec _ _) => H_dec' //.
- rewrite -H_dec in H_dec'.
by rewrite H_dec.
- case: H_dec'.
rewrite -H_dec.
by rewrite tot_map_name_inverse_inv.
- rewrite H_dec' in H_dec.
by rewrite tot_map_name_inv_inverse in H_dec.
Qed.
Proof using name_map_bijective.
move => net d p p'.
case: p => src dst m.
case: p' => src' dst' m' /=.
case H_eq: (pt_map_msg _) => [m0|] // H_eq'.
inversion H_eq'; subst.
move {H_eq H_eq'}.
exact: pt_ext_map_update_eq.
Qed.
Proof using name_map_bijective multi_map_congr.
move => net net' tr.
case => {net net' tr}.
- move => net net' p ms ms' out d l H_eq H_hnd H_eq'.
destruct (pt_map_packet p) eqn:?.
left.
rewrite H_eq' /= /pt_ext_map_net /=.
have H_eq_dst: tot_map_name (pDst p) = pDst p0.
case: p H_eq H_hnd H_eq' Heqo => /= src dst m H_eq H_hnd H_eq'.
case (pt_map_msg m) => //= m' H_m.
by inversion H_m.
destruct (net_handlers (pDst p0) (pSrc p0) (pBody p0) (pt_ext_map_data (nwState net (pDst p)) (pDst p))) eqn:?.
destruct p1 as [out' d'].
exists [(pDst p0, inr out')].
apply @StepAsync_deliver with (xs := filterMap pt_map_packet ms) (ys := filterMap pt_map_packet ms') (d := pt_ext_map_data d (pDst p)) (l := filterMap pt_map_name_msg l).
* rewrite /= H_eq filterMap_app /=.
case H_p: (pt_map_packet _) => [p1|]; last by rewrite H_p in Heqo.
by rewrite H_p in Heqo; injection Heqo => H_eq_p; rewrite H_eq_p.
* rewrite /=.
rewrite -{2}H_eq_dst tot_map_name_inv_inverse.
case: p H_eq H_hnd H_eq' Heqo H_eq_dst Heqp1 => /= src dst mg H_eq H_hnd H_eq'.
case H_m: (pt_map_msg mg) => [mg'|] //.
case: p0 H_eq' => src' dst' m0 H_eq' H_eq_p.
inversion H_eq_p; subst.
move => H_eq_dst H_eq_n {H_eq_p H_eq_dst}.
simpl in *.
have H_q := @pt_ext_net_handlers_some _ _ _ _ _ _ _ multi_map_congr dst src mg (nwState net dst) _ _ _ _ H_m H_eq_n.
rewrite /pt_ext_mapped_net_handlers in H_q.
rewrite H_hnd in H_q.
find_inversion.
by rewrite tot_map_name_inv_inverse.
* rewrite /= /pt_ext_map_net /= 2!filterMap_app.
rewrite (filterMap_pt_map_packet_map_eq_some _ _ Heqo).
by rewrite (pt_ext_map_update_eq_some _ _ _ Heqo).
right.
rewrite H_eq' /= {H_eq'}.
rewrite /pt_ext_map_net /=.
case: p H_eq H_hnd Heqo => /= src dst m H_eq H_hnd.
case H_m: (pt_map_msg _) => [m'|] // H_eq' {H_eq'}.
rewrite 2!filterMap_app H_eq filterMap_app /=.
case H_m': (pt_map_msg _) => [m'|]; first by rewrite H_m' in H_m.
have [H_d H_l] := pt_ext_net_handlers_none _ _ _ _ H_m H_hnd.
rewrite (filterMap_pt_map_name_msg_empty_eq _ dst H_l) /=.
set nwS1 := fun _ => _.
set nwS2 := fun _ => _.
have H_eq_s: nwS1 = nwS2.
rewrite /nwS1 /nwS2 /=.
apply functional_extensionality => n.
rewrite /update /=.
case name_eq_dec => H_dec //.
by rewrite H_dec H_d.
by rewrite H_eq_s.
- move => h net net' out inp d l H_hnd H_eq.
destruct (pt_ext_map_input inp h (nwState net h)) eqn:?.
left.
destruct (input_handlers (tot_map_name h) i (pt_ext_map_data (nwState net h) h)) eqn:?.
destruct p  as [out' d'].
exists [(tot_map_name h, inl i); (tot_map_name h, inr out')].
apply (@StepAsync_input _ _ _ _ _ _ _ (pt_ext_map_data d h) (filterMap pt_map_name_msg l)).
rewrite /=.
have H_q := @pt_ext_input_handlers_some _ _ _ _ _ _ _ multi_map_congr h inp (nwState net h) _ _ _ _ Heqo Heqp.
rewrite /pt_ext_mapped_input_handlers /= in H_q.
rewrite H_hnd in H_q.
find_inversion.
by rewrite tot_map_name_inv_inverse.
rewrite /= H_eq /= /pt_ext_map_net /= filterMap_app filterMap_pt_map_packet_map_eq.
by rewrite -pt_ext_map_update_eq.
right.
rewrite H_eq /pt_ext_map_net /=.
have [H_d H_l] := pt_ext_input_handlers_none _ _ _ Heqo H_hnd.
rewrite filterMap_app.
rewrite (filterMap_pt_map_name_msg_empty_eq _ h H_l) /=.
set nwS1 := fun _ => _.
set nwS2 := fun _ => _.
have H_eq_s: nwS1 = nwS2.
rewrite /nwS1 /nwS2 /=.
apply functional_extensionality => n.
rewrite /update /=.
case name_eq_dec => H_dec //.
by rewrite H_dec H_d.
by rewrite H_eq_s.
Qed.
Proof using name_map_bijective multi_map_congr.
move => net tr H_step.
remember step_async_init as y in *.
move: Heqy.
induction H_step using refl_trans_1n_trace_n1_ind => H_init /=.
rewrite H_init.
rewrite /step_async_init /= /pt_ext_map_net /=.
rewrite pt_ext_init_handlers_fun_eq.
exists [].
exact: RT1nTBase.
concludes.
rewrite H_init in H_step2 H_step1.
apply step_async_pt_ext_mapped_simulation_1 in H.
case: H => H.
move: IHH_step1 => [tr' H_star].
move: H => [tr'' H].
exists (tr' ++ tr'').
have H_trans := refl_trans_1n_trace_trans H_star.
apply: H_trans.
have ->: tr'' = tr'' ++ [] by rewrite -app_nil_end.
apply: (@RT1nTStep _ _ _ _ (pt_ext_map_net x'')) => //.
exact: RT1nTBase.
move: H => [H_eq H_eq'].
move: IHH_step1 => [tr' H_star].
exists tr'.
rewrite /pt_ext_map_net.
by rewrite H_eq H_eq'.
Qed.
Definition pt_ext_map_onet (onet : @ordered_network _ multi_fst) : @ordered_network _ multi_snd :=
mkONetwork (fun src dst => filterMap pt_map_msg (onet.(onwPackets) (tot_map_name_inv src) (tot_map_name_inv dst)))
(fun n => pt_ext_map_data (onet.(onwState) (tot_map_name_inv n)) (tot_map_name_inv n)).
Proof using name_map_bijective multi_map_congr.
move => net net' tr.
case => {net net' tr}.
- move => net net' tr m ms out d l from to H_eq H_hnd H_eq' H_eq_tr.
destruct (pt_map_msg m) eqn:?.
left.
destruct (net_handlers (tot_map_name to) (tot_map_name from) m0 (pt_ext_map_data (onwState net to) to)) eqn:?.
destruct p as [out' d'].
exists (map2fst (tot_map_name to) (map inr out')).
rewrite H_eq' /= /pt_ext_map_onet /=.
apply (@StepOrdered_deliver _ _ _ _ _ m0 (filterMap pt_map_msg ms) out' (pt_ext_map_data d to) (filterMap pt_map_name_msg l) (tot_map_name from) (tot_map_name to)) => //=.
* rewrite 2!tot_map_name_inv_inverse H_eq /=.
case H_m1: pt_map_msg => [m1|]; last by rewrite Heqo in H_m1.
rewrite H_m1 in Heqo.
by inversion Heqo.
* rewrite tot_map_name_inv_inverse.
have H_q := @pt_ext_net_handlers_some _ _ _ _ _ _ _ multi_map_congr _ _ _ _ _ _ _ _ Heqo Heqp.
rewrite /pt_ext_mapped_net_handlers /= in H_q.
by repeat break_let; repeat tuple_inversion.
* by rewrite /= pt_ext_map_update_eq collate_pt_map_update2_eq.
right.
have [H_eq_d H_ms] := pt_ext_net_handlers_none _ _ _ _ Heqo H_hnd.
rewrite H_eq' /pt_ext_map_onet /=.
rewrite pt_ext_map_update_eq /= H_eq_d.
rewrite collate_pt_map_eq H_ms /=.
set nwS1 := update _ _ _ _.
set nwS2 := fun n => pt_ext_map_data _ _.
set nwP1 := fun _ _ => _.
set nwP2 := fun _ _ => _.
have H_eq_s: nwS1 = nwS2.
rewrite /nwS1 /nwS2 {nwS1 nwS2}.
apply functional_extensionality => n.
rewrite /update /=.
case (name_eq_dec _ _) => H_dec //.
by rewrite H_dec tot_map_name_inv_inverse.
have H_eq_p: nwP1 = nwP2.
rewrite /nwP1 /nwP2 /=.
apply functional_extensionality => src.
apply functional_extensionality => dst.
rewrite /update2 /=.
case (sumbool_and _ _ _ _) => H_dec //.
move: H_dec => [H_eq_from H_eq_to].
rewrite -H_eq_from -H_eq_to H_eq /=.
case H_m': (pt_map_msg _) => [m'|] //.
by rewrite H_m' in Heqo.
by rewrite H_eq_s H_eq_p.
- move => h net net' tr out inp d l H_hnd H_eq H_eq_tr.
destruct (pt_ext_map_input inp h (onwState net h)) eqn:?.
left.
destruct (input_handlers (tot_map_name h) i (pt_ext_map_data (onwState net h) h)) eqn:?.
destruct p as [out' d'].
exists ((tot_map_name h, inl i) :: map2fst (tot_map_name h) (map inr out')).
apply (@StepOrdered_input _ _ (tot_map_name h) _ _ _ out' i (pt_ext_map_data d h) (filterMap pt_map_name_msg l)) => //=; last by rewrite H_eq /pt_ext_map_onet /= pt_ext_map_update_eq collate_pt_map_eq.
have H_q := @pt_ext_input_handlers_some _ _ _ _ _ _ _ multi_map_congr h inp (onwState net h) _ _ _ _ Heqo Heqp.
rewrite /pt_ext_mapped_input_handlers /= in H_q.
rewrite tot_map_name_inv_inverse.
by repeat break_let; repeat tuple_inversion.
right.
rewrite /=.
have [H_d H_l] := pt_ext_input_handlers_none h inp (onwState net h) Heqo H_hnd.
rewrite H_eq /= /pt_ext_map_onet /=.
rewrite pt_ext_map_update_eq /= H_d.
rewrite collate_pt_map_eq H_l /=.
set nwS1 := update _ _ _ _.
set nwS2 := fun n => pt_ext_map_data _ _.
have H_eq_n: nwS1 = nwS2.
rewrite /nwS1 /nwS2 /=.
apply functional_extensionality => n.
rewrite /update /=.
case (name_eq_dec _ _) => H_dec //.
by rewrite H_dec tot_map_name_inv_inverse.
by rewrite H_eq_n.
Qed.

Corollary step_ordered_pt_ext_mapped_simulation_star_1 :
forall net tr,
@step_ordered_star _ multi_fst step_ordered_init net tr ->
exists tr', @step_ordered_star _ multi_snd step_ordered_init (pt_ext_map_onet net) tr'.