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'.
Proof using tot_map_output_injective name_map_bijective multi_map_congr.
move => net net' out mnet mout H_step H_eq H_eq'.
invcs H_step.
- destruct p.
rewrite /tot_map_net /=.
destruct mnet.
rewrite /=.
match goal with
| H : map tot_map_packet _ = _ |- _ =>
have [pks1 [pks2 [H_eq_pks [H_eq_pks1 H_eq_pks2]]]] := map_eq_inv _ _ _ _ H
end.
case: pks2 H_eq_pks H_eq_pks2 => //= p pks2 H_eq_pks H_eq_pks2.
rewrite H_eq_pks.
inversion H_eq_pks2.
case H_hnd': (net_handlers (Net.pDst p) (Net.pSrc p) (Net.pBody p) (nwState (Net.pDst p))) => [dout l'].
case: dout H_hnd' => out' d' H_hnd'.
rewrite -H_eq_pks1.
exists {| nwPackets := send_packets (Net.pDst p) l' ++ pks1 ++ pks2 ; nwState := update name_eq_dec nwState (Net.pDst p) d' |}.
split.
* match goal with
| H : _ = map tot_map_trace_occ _ |- _ =>
have [n' [lo [H_eq_mout [H_eq_n H_eq_lo]]]] := tot_map_trace_occ_inv _ (eq_sym H)
end.
rewrite H_eq_mout.
have H_eq_dst: n' = Net.pDst p.
rewrite -(tot_map_name_inv_inverse n') H_eq_n.
destruct p.
find_inversion.
by rewrite tot_map_name_inv_inverse.
rewrite H_eq_dst.
apply (@StepAsync_deliver _ _ _ _ _ pks1 pks2 _ d' l') => //=.
suff H_suff: lo = out' by rewrite H_suff.
have H_eq_hnd := @tot_net_handlers_eq _ _ _ _ _ _ _ multi_map_congr (Net.pDst p) (Net.pSrc p) (Net.pBody p) (nwState (Net.pDst p)).
rewrite /tot_mapped_net_handlers /= in H_eq_hnd.
repeat break_let.
inversion H_hnd'.
simpl in *.
have H_eq_src: tot_map_name (Net.pSrc p) = pSrc by destruct p; simpl in *; find_inversion.
rewrite H_eq_src /= {H_eq_src} in H_eq_hnd.
have H_eq_body: tot_map_msg (Net.pBody p) = pBody by destruct p; simpl in *; find_inversion.
rewrite H_eq_body in H_eq_hnd.
match goal with
| H: net_handlers _ _ _ (tot_map_data (_ (tot_map_name_inv pDst))) = _ |- _ =>
rewrite -H_eq_n tot_map_name_inv_inverse H_eq_dst in H ;
rewrite H in H_eq_hnd
end.
find_inversion.
find_apply_lem_hyp map_eq_inv_eq; last exact: tot_map_output_injective.
by symmetry.
* rewrite /= /update /=.
have H_eq_dst: tot_map_name (Net.pDst p) = pDst by destruct p; find_inversion.
have H_eq_src: tot_map_name (Net.pSrc p) = pSrc by destruct p; find_inversion.
have H_eq_body: tot_map_msg (Net.pBody p) = pBody by destruct p; find_inversion.
rewrite 2!map_app.
have H_eq_hnd := @tot_net_handlers_eq _ _ _ _ _ _ _ multi_map_congr (Net.pDst p) (Net.pSrc p) (Net.pBody p) (nwState (Net.pDst p)).
rewrite /tot_mapped_net_handlers /= in H_eq_hnd.
repeat break_let.
inversion H_hnd'.
rewrite H_eq_dst H_eq_src H_eq_body in H_eq_hnd.
simpl in *.
match goal with
| H: net_handlers _ _ _ (tot_map_data (_ (tot_map_name_inv pDst))) = _ |- _ =>
rewrite -{2}H_eq_dst tot_map_name_inv_inverse in H;
rewrite H in H_eq_hnd
end.
find_inversion; clean.
set nwP1 := map tot_map_packet _.
set nwP2 := map (fun _ => _) (tot_map_name_msgs _).
set nwS1 := fun _ => _.
set nwS2 := fun _ => _.
have H_eq_nw: nwP1 = nwP2.
rewrite /nwP1 /nwP2.
elim l' => //=.
case => /= n' m' l0 IH.
rewrite IH.
by find_rewrite.
rewrite -H_eq_nw /nwP1 {H_eq_nw nwP1 nwP2}.
have H_eq_sw: nwS1 = nwS2.
rewrite /nwS1 /nwS2.
apply functional_extensionality => n'.
repeat break_if => //.
+ find_reverse_rewrite.
by find_rewrite_lem tot_map_name_inverse_inv.
+ find_rewrite.
by find_rewrite_lem tot_map_name_inv_inverse.
by rewrite H_eq_sw.
- rewrite /tot_map_net /=.
destruct mnet.
simpl in *.
match goal with
| H: _ = map tot_map_trace_occ _ |- _ =>
have [h' [inp' [out' [H_eq_mout [H_eq_n [H_eq_out H_eq_inp]]]]]] := tot_map_trace_occ_in_inv _ (eq_sym H)
end.
have H_q := @tot_input_handlers_eq _ _ _ _ _ _ _ multi_map_congr h' inp' (nwState h').
rewrite /tot_mapped_input_handlers in H_q.
repeat break_let.
rewrite H_eq_n H_eq_inp in H_q.
match goal with
| H: input_handlers _ _ (tot_map_data (_ (tot_map_name_inv h))) = _ |- _ =>
rewrite -{2}H_eq_n tot_map_name_inv_inverse in H;
rewrite H in H_q
end.
find_inversion.
find_inversion.
exists ({| nwPackets := send_packets h' l0 ++ nwPackets ; nwState := update name_eq_dec nwState h' d0 |}).
split.
* apply (@StepAsync_input _ _ _ _ _ _ _ d0 l0) => //=.
find_rewrite.
suff H_suff: l1 = out' by rewrite H_suff.
by find_apply_lem_hyp map_eq_inv_eq; last exact: tot_map_output_injective.
* rewrite /= map_app.
set nwP1 := map tot_map_packet _.
set nwP2 := map (fun _ => _) (tot_map_name_msgs _).
set nwS1 := fun _ => _.
set nwS2 := update _ _ _ _.
have H_eq_nwp: nwP1 = nwP2.
rewrite /nwP1 /nwP2 {nwP1 nwP2}.
elim l0 => //=.
case => /= n m l' IH.
by rewrite IH.
have H_eq_nws: nwS1 = nwS2.
rewrite /nwS1 /nwS2.
rewrite /update /=.
apply functional_extensionality => n.
repeat break_if => //.
+ find_reverse_rewrite.
by find_rewrite_lem tot_map_name_inverse_inv.
+ find_rewrite.
by find_rewrite_lem tot_map_name_inv_inverse.
by rewrite H_eq_nwp H_eq_nws.
Qed.
Context {fail_fst : FailureParams multi_fst}.
Context {fail_snd : FailureParams multi_snd}.
Context {fail_map_congr : FailureParamsTotalMapCongruency fail_fst fail_snd base_map}.
Proof using name_map_bijective.
move => n.
elim => //=.
move => n' failed IH H_in H_in'.
case: H_in' => H_in'.
case: H_in.
left.
rewrite -(tot_map_name_inv_inverse n').
rewrite H_in'.
exact: tot_map_name_inv_inverse.
contradict H_in'.
apply: IH.
move => H_in'.
case: H_in.
by right.
Qed.
Proof using.
move => n.
elim => //.
move => n' l IH H_in.
case: H_in => H_in.
rewrite H_in.
by left.
right.
exact: IH.
Qed.

Lemma remove_tot_map_eq :
forall h failed,
map tot_map_name (remove name_eq_dec h failed) =
remove name_eq_dec (tot_map_name h) (map tot_map_name failed).