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}.
Proof using name_map_bijective multi_map_congr fail_map_congr.
move => net net' failed failed' tr H_step.
invcs H_step.
- rewrite /=.
case H_m: (pt_map_packet p) => [p'|].
destruct p, p'.
simpl in *.
move: H_m.
case H_m: pt_map_msg => [m|] //.
move => H_eq.
find_inversion.
left.
rewrite /pt_map_net /= H3 filterMap_app /= H_m /= 2!filterMap_app {H3}.
set p' := {| pSrc := _ ; pDst := _ ; pBody := _ |}.
have ->: tot_map_name pDst = Net.pDst p' by [].
apply (@StepFailure_deliver _ _ _ _ _ _ _ (filterMap pt_map_packet xs) (filterMap pt_map_packet ys) (filterMap pt_map_output out) (pt_map_data d) (filterMap pt_map_name_msg l)) => //=.
* exact: not_in_failed_not_in.
* rewrite /= -(pt_net_handlers_some _ _ _ _ H_m)  /pt_mapped_net_handlers /= tot_map_name_inv_inverse.
repeat break_let.
by find_inversion.
* pose p := {| pSrc := pSrc ; pDst := pDst ; pBody := pBody |}.
have H_p: pt_map_packet p = Some p'.
rewrite /pt_map_packet.
break_match.
rewrite /p in Heqp0.
find_inversion.
by rewrite H_m.
by rewrite (filterMap_pt_map_packet_map_eq_some _ _ H_p) (pt_map_update_eq_some _ _ _ H_p).
right.
rewrite /pt_map_net /=.
destruct p.
simpl in *.
move: H_m.
case H_m: pt_map_msg => [m|] //.
move => H_eq.
have H_m' := @pt_net_handlers_none _ _ _ _ _ name_map msg_map multi_map_congr _ _ _ _ _ _ _ H_m H6.
break_and.
rewrite H3 3!filterMap_app H1.
rewrite (filterMap_pt_map_name_msg_empty_eq _ pDst H0) /= H_m.
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.
by rewrite H_eq_s.
- rewrite /= /pt_map_net /=.
case H_i: pt_map_input => [inp'|].
left.
apply (@StepFailure_input _ _ _ _ _ _ _ _ _ (pt_map_data d) (filterMap pt_map_name_msg l)).
* exact: not_in_failed_not_in.
* rewrite /= -(pt_input_handlers_some _ _ _ H_i)  /pt_mapped_input_handlers /= tot_map_name_inv_inverse.
repeat break_let.
by tuple_inversion.
* rewrite /= -filterMap_pt_map_packet_map_eq -filterMap_app.
by rewrite pt_map_update_eq.
right.
rewrite /=.
have [H_d [H_l H_o]] := pt_input_handlers_none _ _ _ H_i H5.
rewrite H_o.
split => //.
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.
- case H_m: (pt_map_packet p) => [p'|].
left.
destruct p, p'.
simpl in *.
move: H_m.
case H_m: pt_map_msg => [m|] //.
move => H_eq.
find_inversion.
rewrite /pt_map_net /=.
find_rewrite.
rewrite filterMap_app /= H_m filterMap_app.
move: H4.
set p := {| pSrc := _ ; pDst := _ ; pBody := _ |}.
move => H_eq.
set p' := {| pSrc := _ ; pDst := _ ; pBody := _ |}.
exact: (@StepFailure_drop _ _ _ _ _ _ p' (filterMap pt_map_packet xs) (filterMap pt_map_packet ys)).
right.
split => //.
rewrite /pt_map_net /=.
find_rewrite.
by rewrite 2!filterMap_app /= H_m.
- rewrite /pt_map_net /=.
find_rewrite.
case H_p: pt_map_packet => [p'|]; last by right.
left.
rewrite filterMap_app /= H_p.
exact: (@StepFailure_dup _ _ _ _ _ _ p' (filterMap pt_map_packet xs) (filterMap pt_map_packet ys)).
- left.
exact: StepFailure_fail.
- rewrite remove_tot_map_eq /=.
left.
rewrite {2}/pt_map_net /=.
eapply (@StepFailure_reboot _ _ _ (tot_map_name h)) => //; first exact: in_failed_in.
by rewrite pt_map_update_eq /pt_map_net pt_reboot_eq /= tot_map_name_inv_inverse.
Qed.
Proof using name_map_bijective multi_map_congr fail_map_congr.
move => net failed tr H_step.
remember step_failure_init as y in *.
have H_eq_f: failed = fst (failed, net) by [].
have H_eq_n: net = snd (failed, net) by [].
rewrite H_eq_f {H_eq_f}.
rewrite {2}H_eq_n {H_eq_n}.
move: Heqy.
induction H_step using refl_trans_1n_trace_n1_ind => H_init /=.
rewrite H_init.
rewrite /step_failure_init /= /pt_map_net /=.
rewrite -pt_init_handlers_fun_eq.
exists [].
split => //.
exact: RT1nTBase.
concludes.
rewrite H_init {H_init x} in H_step2 H_step1.
case: x' H IHH_step1 H_step1 => failed' net'.
case: x'' H_step2 => failed'' net''.
rewrite /=.
move => H_step2 H IHH_step1 H_step1.
apply step_failure_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 _ _ _ _ (map tot_map_name failed'', pt_map_net net'')) => //.
exact: RT1nTBase.
* by rewrite 3!filterMap_app H_eq_tr.
move: H => [H_eq_n [H_eq_f H_eq]].
rewrite H_eq_n -H_eq_f.
move: IHH_step1 => [tr' [H_star H_tr]].
exists tr'.
split => //.
rewrite 2!filterMap_app.
by rewrite H_eq -app_nil_end.
Qed.
Definition pt_map_onet (onet : @ordered_network _ multi_fst) : @ordered_network _ multi_snd :=
{| onwPackets := fun src dst => filterMap pt_map_msg (onet.(onwPackets) (tot_map_name_inv src) (tot_map_name_inv dst)) ;
onwState := fun n => pt_map_data (onet.(onwState) (tot_map_name_inv n)) |}.
Proof using name_map_bijective.
move => f ms to from.
apply functional_extensionality => src.
apply functional_extensionality => dst.
rewrite /update2 /=.
case sumbool_and => H_dec; case sumbool_and => H_dec' //.
move: H_dec => [H_eq H_eq'].
case: H_dec' => H_dec'.
rewrite H_eq in H_dec'.
by rewrite tot_map_name_inverse_inv in H_dec'.
rewrite H_eq' in H_dec'.
by rewrite tot_map_name_inverse_inv in H_dec'.
move: H_dec' => [H_eq H_eq'].
case: H_dec => H_dec.
rewrite -H_eq in H_dec.
by rewrite tot_map_name_inv_inverse in H_dec.
rewrite -H_eq' in H_dec.
by rewrite tot_map_name_inv_inverse in H_dec.
Qed.
Proof using name_map_bijective.
move => f h l.
elim: l h f => //.
case => n m l IH h f.
rewrite /= IH /= /pt_map_name_msg /=.
case H_m: pt_map_msg => [m'|] /=.
rewrite 2!tot_map_name_inv_inverse /=.
set f1 := fun _ _ => _.
set f2 := update2 _ _ _ _ _.
have H_eq_f: f1 = f2.
rewrite /f1 /f2 {f1 f2}.
have H_eq := pt_map_msg_update2 f (f h n ++ [m]) n h.
move: H_eq.
rewrite filterMap_app /=.
case H_m': pt_map_msg => [m0|]; last by rewrite H_m' in H_m.
rewrite H_m' in H_m.
by inversion H_m.
by rewrite H_eq_f.
rewrite pt_map_msg_update2 /= filterMap_app /=.
case H_m': (pt_map_msg _) => [m'|]; first by rewrite H_m' in H_m.
rewrite -app_nil_end.
set f1 := update2 _ _ _ _ _.
set f2 := fun _ _ => _ _.
have H_eq_f: f1 = f2.
rewrite /f1 /f2 {f1 f2}.
apply functional_extensionality => src.
apply functional_extensionality => dst.
rewrite /update2 /=.
case (sumbool_and _ _ _ _) => H_dec //.
move: H_dec => [H_eq H_eq'].
by rewrite -H_eq -H_eq' 2!tot_map_name_inv_inverse.
by rewrite H_eq_f.
Qed.
Proof using name_map_bijective.
move => f from to ms l.
rewrite -pt_map_msg_update2.
by rewrite collate_pt_map_eq.
Qed.
Definition pt_map_trace_ev (e : @name _ multi_fst * (@input base_fst + (@output base_fst))) :
option (@name _ multi_snd * (@input base_snd + (@output base_snd))) :=
match e with
|  (n, inl i) =>
match pt_map_input i with
| Some i' => Some (tot_map_name n, inl i')
| None => None
end
| (n, inr o) =>
match pt_map_output o with
| Some o' => Some (tot_map_name n, inr o')
| None => None
end
end.
Proof using.
elim => //=.
move => o out IH to.
by case pt_map_output => [o'|]; rewrite IH.
Qed.

Theorem step_ordered_pt_mapped_simulation_1 :
forall net net' tr,
@step_ordered _ multi_fst net net' tr ->
@step_ordered _ multi_snd (pt_map_onet net) (pt_map_onet net') (filterMap pt_map_trace_ev tr) \/
pt_map_onet net' = pt_map_onet net /\ filterMap pt_map_trace_ev tr = [].