Section Switch.
Variable n : nat.
Variable sig : finType.
Variable F : finType.
Variable pM1 : pTM sig F n.
Variable F' : finType.
Variable pMf : F -> pTM sig F' n.
(* The (unlabelled) machine [M] *)
Notation M1 := (projT1 pM1).
(* The labelling function of the machine [M] *)
Notation p1 := (projT2 pM1).
(* The (unlabelled) case-machine [M' y] *)
Notation "'Mf' y" := (projT1 (pMf y)) (at level 10).
(* The labelling function of the case-machine [M' y] *)
Notation "'p2' y" := (projT2 (pMf y)) (at level 10).
Definition Switch_trans :
(TM.state M1 + { f : F & TM.state (Mf f) }) * Vector.t (option sig) n ->
(TM.state M1 + { f : F & TM.state (Mf f) }) * Vector.t (option sig * move) n :=
fun '(q, s) =>
match q with
| inl q =>
if halt q
then (inr (existT _ (p1 q) (start (Mf (p1 q)))), nop_action)
else let (q', a) := trans (q, s) in (inl q', a)
| inr q =>
let (q', a) := trans (projT2 q, s) in
(inr (existT _ (projT1 q) q'), a)
end.
Definition Switch_halt : (TM.state M1 + { f : F & TM.state (Mf f) }) -> bool :=
fun q =>
match q with
| inl _ => false
| inr q => halt (projT2 q)
end.
Definition SwitchTM : TM sig n :=
{|
trans := Switch_trans;
halt  := Switch_halt;
start := inl (start M1);
|}.
Definition Switch_p : (state SwitchTM) -> F' :=
fun q => match q with
| inl q => p2 (p1 q) (start (Mf (p1 q))) (* Canonical value *)
| inr q => p2 (projT1 q) (projT2 q)
end.
Definition Switch : pTM sig F' n := (SwitchTM; Switch_p).
(* Lift configurations of [M1] to configurations of [Switch] *)
Definition lift_confL (c : mconfig sig (state M1) n) : mconfig sig (state SwitchTM) n :=
mk_mconfig (inl (cstate c)) (ctapes c).
(* Lift configuration of [M2] to configurations of [Switch] *)
Definition lift_confR (f : F) (c : mconfig sig (state (Mf f) ) n) : mconfig sig (state SwitchTM) n :=
mk_mconfig (inr (existT (fun f0 : F => state (Mf f0)) f (cstate c))) (ctapes c).
(* Lifted halting state of [M1] *)
Definition halt_liftL (c : mconfig sig (state (SwitchTM)) n) :=
match cstate c with
| inl q => halt (m := M1) q
| inr q => true
end.

(* Correctness *)
Lemma Switch_Realise (R1 : Rel _ (F * _)) (R2 : F -> Rel _ (F' * _)) :
pM1 ⊨ R1 ->
(forall f : F, pMf f ⊨ R2 f) -> Switch ⊨ (⋃_f (R1 |_ f) ∘ R2 f).