Section FixM.
Variable Σ : finType.
Let n := (projT1 (finite_n Σ)).
Let f := (projT1 (projT2 (finite_n Σ))).
Let g := (proj1_sig (projT2 (projT2 (finite_n Σ)))).
Let Hf := (proj1 (proj2_sig (projT2 (projT2 (finite_n Σ))))).
Let Hg := (proj2 (proj2_sig (projT2 (projT2 (finite_n Σ))))).
Instance R : Retract (Fin.t n) Σ.
Definition encode_tape' (t : tape Σ) : tape bool := encode_tape (mapTape f t).
Variable M : TM Σ 1.
Definition Step (q : state M) : pTM (finType_CS bool) (state M + state M) 1 :=
Switch (ReadB n) (fun c_i => if halt q then Return Nop (inr q)
else let '(q', e) := trans M (q, [| map_opt g c_i |]) in
let '(existT _ (c', m) _) := destruct_vector_cons e in
WriteB (map_opt f c') ;; MoveB m n ;; Return Nop (inl q')).
Smpl Add (eapply ReadB_Realise') : TM_Correct.
Smpl Add (eapply WriteB_Realise') : TM_Correct.
Smpl Add (eapply MoveB_Realise') : TM_Correct.

Lemma Step_Realise q :
Step q ⊨ fun t '(q_, t') =>
forall t_sig, t = [| encode_tape' t_sig |] ->
if halt q then q_ = inr q /\ t' = t
else let '(q', a) := trans M (q, [| current t_sig |]) in
let '(existT _ (c', m) _) := destruct_vector_cons a in
q_ = inl q' /\ t' = [| encode_tape' (mv m (wr c' t_sig)) |].