Section TotalMapSimulations.
Context {base_fst : BaseParams}.
Context {base_snd : BaseParams}.
Context {multi_fst : MultiParams base_fst}.
Context {multi_snd : MultiParams base_snd}.
Context {base_map : BaseParamsTotalMap base_fst base_snd}.
Context {name_map : MultiParamsNameTotalMap multi_fst multi_snd}.
Context {msg_map : MultiParamsMsgTotalMap multi_fst multi_snd}.
Context {name_map_bijective : MultiParamsNameTotalMapBijective name_map}.
Context {multi_map_congr : MultiParamsTotalMapCongruency base_map name_map msg_map}.
Definition tot_map_trace_occ (e : @name _ multi_fst * (@input base_fst + list (@output base_fst))) :=
match e with
| (n, inl io) => (tot_map_name n, inl (tot_map_input io))
| (n, inr lo) => (tot_map_name n, inr (map tot_map_output lo))
end.
Definition tot_map_packet (p : @packet base_fst multi_fst)  :=
match p with
| mkPacket src dst m =>
mkPacket (tot_map_name src) (tot_map_name dst) (tot_map_msg m)
end.
Definition tot_map_net (net : @network _ multi_fst) : @network _ multi_snd :=
{| nwPackets := map tot_map_packet net.(nwPackets) ;
nwState := fun n => tot_map_data (net.(nwState) (tot_map_name_inv n)) |}.
Proof using name_map_bijective.
move => net d h.
apply functional_extensionality => n.
rewrite /update /=.
repeat break_match => //.
- by find_reverse_rewrite; find_rewrite_lem tot_map_name_inverse_inv.
- by find_rewrite; find_rewrite_lem tot_map_name_inv_inverse.
Qed.
Proof using name_map_bijective.
move => f.
case => src dst m d.
exact: tot_map_update_eq.
Qed.
Proof using.
elim => //=.
case => /= n m' l IH h.
by rewrite IH.
Qed.
Proof using name_map_bijective multi_map_congr msg_map.
apply functional_extensionality => n.
by rewrite tot_init_handlers_eq tot_map_name_inverse_inv.
Qed.
Proof using.
case => //=.
case.
move => n ol tr n' lo H_eq.
case: tr H_eq => //=.
case: ol => //=.
move => out H_eq.
exists n; exists out.
split => //.
by inversion H_eq.
Qed.
Proof using name_map_bijective.
case => //=.
case.
move => h.
case => //.
move => inp.
case => //.
case.
move => h'.
case => //.
move => out.
case => //=.
move => h0.
move => inp' out' H_eq.
inversion H_eq.
find_apply_lem_hyp tot_map_name_injective.
repeat find_rewrite.
by exists h; exists inp; exists out.
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 /tot_map_trace_occ /=.
have ->: tot_map_name (pDst p) = pDst (tot_map_packet p) by case: p H_eq H_hnd H_eq' => src dst m H_eq H_hnd H_eq'.
apply (@StepAsync_deliver _ _ _ _ _ (map tot_map_packet ms) (map tot_map_packet ms') (map tot_map_output out) (tot_map_data d) (tot_map_name_msgs l)).
* by rewrite /tot_map_net /= H_eq /= map_app.
* rewrite /=.
case: p H_eq H_hnd H_eq' => /= src dst m H_eq H_hnd H_eq'.
have H_q := tot_net_handlers_eq dst src m (nwState net dst).
rewrite /tot_mapped_net_handlers in H_q.
rewrite H_hnd in H_q.
rewrite H_q.
by rewrite tot_map_name_inv_inverse.
* rewrite /= H_eq' /= /tot_map_net /=.
rewrite -tot_map_update_packet_eq.
rewrite 2!map_app.
destruct p.
by rewrite tot_map_packet_map_eq.
- move => h net net' out inp d l H_hnd H_eq.
apply (@StepAsync_input _ _ _ _ _ _ _ (tot_map_data d) (tot_map_name_msgs l)).
rewrite /=.
have H_q := tot_input_handlers_eq h inp (nwState net h).
rewrite /tot_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 /= /tot_map_net /=.
by rewrite -tot_map_update_eq map_app tot_map_packet_map_eq.
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 /step_async_init /= /tot_map_net /=.
rewrite tot_init_handlers_fun_eq.
exact: RT1nTBase.
concludes.
repeat find_rewrite.
find_apply_lem_hyp step_async_tot_mapped_simulation_1.
rewrite map_app.
match goal with
| H : step_async_star _ _ _ |- _ => apply: (refl_trans_1n_trace_trans H)
end.
rewrite (app_nil_end (map _ _)).
apply: (@RT1nTStep _ _ _ _ (tot_map_net x'')) => //.
exact: RT1nTBase.
Qed.
Hypothesis tot_map_output_injective :
forall o o', tot_map_output o = tot_map_output o' -> o = o'.

Theorem step_async_tot_mapped_simulation_2 :
forall net net' out mnet mout,
@step_async _ multi_snd net net' out ->
tot_map_net mnet = net ->
map tot_map_trace_occ mout = out ->
exists mnet', @step_async _ multi_fst mnet mnet' mout /\
tot_map_net mnet' = net'.