Section PartialMapSimulations.
Context {base_fst : BaseParams}.
Context {base_snd : BaseParams}.
Context {multi_fst : MultiParams base_fst}.
Context {multi_snd : MultiParams base_snd}.
Context {base_map : BaseParamsPartialMap base_fst base_snd}.
Context {name_map : MultiParamsNameTotalMap multi_fst multi_snd}.
Context {msg_map : MultiParamsMsgPartialMap multi_fst multi_snd}.
Context {name_map_bijective : MultiParamsNameTotalMapBijective name_map}.
Context {multi_map_congr : MultiParamsPartialMapCongruency base_map name_map msg_map}.
Definition pt_map_trace_occ (e : @name _ multi_fst * (@input base_fst + list (@output base_fst))) :
option (@name _ multi_snd * (@input base_snd + list (@output base_snd))) :=
match e with
| (n, inl io) =>
match pt_map_input io with
| Some io' => Some (tot_map_name n, inl io')
| None => None
end
| (n, inr out) => Some (tot_map_name n, inr (filterMap pt_map_output out))
end.
Definition pt_map_packet (p : @packet _ multi_fst)  :=
match p with
| mkPacket src dst m =>
match pt_map_msg m with
| Some m' => Some (mkPacket (tot_map_name src) (tot_map_name dst) m')
| None => None
end
end.
Definition pt_map_net (net : @network _ multi_fst) : @network _ multi_snd :=
{| nwPackets := filterMap pt_map_packet net.(nwPackets) ;
nwState := fun n => pt_map_data (net.(nwState) (tot_map_name_inv n)) |}.
Proof using name_map_bijective multi_map_congr msg_map.
apply functional_extensionality => n.
have H_eq := pt_init_handlers_eq.
rewrite H_eq {H_eq}.
by rewrite tot_map_name_inverse_inv.
Qed.
Proof using.
elim => //=.
case => /= n m l IH dst.
rewrite /pt_map_name_msg /=.
case pt_map_msg => [m'|] H_eq //=.
by rewrite IH.
Qed.
Proof using.
move => l h.
elim: l => //=.
case => n m l IH.
rewrite /pt_map_name_msg /=.
case pt_map_msg => [m'|] //.
by rewrite IH.
Qed.
Proof using.
move => l; case => /= src dst m p.
case H_m: (pt_map_msg m) => [m'|] // H_eq.
injection H_eq => H_eq_p.
rewrite -H_eq_p /=.
exact: filterMap_pt_map_packet_map_eq.
Qed.
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 tot_map_name_inverse_inv in H_dec'.
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_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'.
rewrite /=.
case H_m: (pt_map_packet p) => [p'|].
have ->: tot_map_name (pDst p) = pDst p'.
case: p H_eq H_hnd H_eq' H_m => /= src dst m H_eq H_hnd H_eq'.
case (pt_map_msg m) => //= m' H_m.
by inversion H_m.
left.
rewrite H_eq' /=.
apply (@StepAsync_deliver _ _ _ _ _ (filterMap pt_map_packet ms) (filterMap pt_map_packet ms') (filterMap pt_map_output out) (pt_map_data d) (filterMap pt_map_name_msg l)).
* rewrite /= H_eq filterMap_app /=.
case H_p: (pt_map_packet _) => [p0|].
rewrite H_p in H_m.
by injection H_m => H_eq_p; rewrite H_eq_p.
by rewrite H_p in H_m.
* rewrite /=.
case: p H_eq H_hnd H_eq' H_m => /= src dst m H_eq H_hnd H_eq'.
case H_m: (pt_map_msg m) => [m'|] //.
case: p' H_eq' => src' dst' m0 H_eq' H_eq_p.
inversion H_eq_p; subst.
rewrite /= {H_eq_p}.
have H_q := pt_net_handlers_some dst src m (nwState net dst) H_m.
rewrite /pt_mapped_net_handlers in H_q.
rewrite H_hnd in H_q.
rewrite H_q.
by rewrite tot_map_name_inv_inverse.
* rewrite /= /pt_map_net /= 2!filterMap_app.
by rewrite (filterMap_pt_map_packet_map_eq_some _ _ H_m) (pt_map_update_eq_some _ _ _ H_m).
right.
split.
* rewrite H_eq' {H_eq'}.
rewrite /pt_map_net /=.
case: p H_eq H_hnd H_m => /= src dst m H_eq H_hnd.
case H_m: (pt_map_msg _) => [m'|] // 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 H_o]] := pt_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_eq'}.
case: p H_eq H_hnd H_m => /= src dst m H_eq H_hnd.
case H_m: (pt_map_msg _) => [m'|] // H_eq'.
have [H_d [H_l H_o]] := pt_net_handlers_none _ _ _ _ H_m H_hnd.
by rewrite H_o.
- move => h net net' out inp d l H_hnd H_eq.
rewrite /=.
case H_i: (pt_map_input inp) => [inp'|].
left.
apply (@StepAsync_input _ _ _ _ _ _ _ (pt_map_data d) (filterMap pt_map_name_msg l)).
rewrite /=.
have H_q := pt_input_handlers_some h inp (nwState net h) H_i.
rewrite /pt_mapped_input_handlers /= in H_q.
rewrite H_hnd in H_q.
rewrite H_q.
by rewrite tot_map_name_inv_inverse.
rewrite /= H_eq /= /pt_map_net /=.
rewrite -filterMap_pt_map_packet_map_eq filterMap_app.
by rewrite -pt_map_update_eq.
right.
split.
* rewrite H_eq /pt_map_net /=.
have [H_d [H_l H_o]] := pt_input_handlers_none _ _ _ H_i 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.
* rewrite /=.
have [H_d [H_l H_o]] := pt_input_handlers_none _ _ _ H_i H_hnd.
by rewrite H_o.
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_map_net /=.
rewrite pt_init_handlers_fun_eq.
exists [].
split => //.
exact: RT1nTBase.
concludes.
rewrite H_init in H_step2 H_step1.
apply step_async_pt_mapped_simulation_1 in H.
case: H => H.
move: IHH_step1 => [tr' [H_star H_eq_tr]].
exists (tr' ++ filterMap pt_map_trace_occ tr2).
split.
* have H_trans := refl_trans_1n_trace_trans H_star.
apply: H_trans.
rewrite (app_nil_end (filterMap pt_map_trace_occ _)).
apply: (@RT1nTStep _ _ _ _ (pt_map_net x'')) => //.
exact: RT1nTBase.
* by rewrite 2!filterMap_app H_eq_tr filterMap_app.
move: H => [H_eq H_eq'].
rewrite H_eq.
move: IHH_step1 => [tr' [H_star H_tr]].
exists tr'.
split => //.
rewrite 2!filterMap_app.
by rewrite H_eq' -app_nil_end.
Qed.
Context {fail_fst : FailureParams multi_fst}.
Context {fail_snd : FailureParams multi_snd}.
Context {fail_map_congr : FailureParamsPartialMapCongruency fail_fst fail_snd base_map}.

Theorem step_failure_pt_mapped_simulation_1 :
forall net net' failed failed' tr,
@step_failure _ _ fail_fst (failed, net) (failed', net') tr ->
@step_failure _ _ fail_snd (map tot_map_name failed, pt_map_net net) (map tot_map_name failed', pt_map_net net') (filterMap pt_map_trace_occ tr) \/
(pt_map_net net' = pt_map_net net /\ failed = failed' /\ filterMap trace_non_empty_out (filterMap pt_map_trace_occ tr) = []).