Section fix_Sigma.
Variable n : nat.
Definition encode_sym (s : Fin.t n) : list bool :=
let i := proj1_sig (Fin.to_nat s) in
repeat false i ++ repeat true (n - i).
Fixpoint encode_string (s : list (Fin.t n)) :=
match s with
| [] => []
| i :: l => false :: encode_sym i ++ true :: encode_string l
end.
Definition encode_tape (t : tape (Fin.t n)) :=
match t with
| niltape => niltape
| midtape ls c_i rs => midtape (rev (encode_string (rev ls))) false (encode_sym c_i ++ true :: encode_string rs)
| leftof c_i rs => leftof false (encode_sym c_i ++ true :: encode_string rs)
| rightof c_i ls => rightof true (rev (encode_sym c_i) ++ false :: rev(encode_string (rev (ls))))
end.
End fix_Sigma.
Fixpoint ReadB (n : nat) : pTM (FinType (EqType bool)) (option (Fin.t n)) 1.
Definition isTotal {Σ} {L} {n} (M : pTM Σ L n) := exists c, projT1 M ↓ fun t k => c <= k.
Ltac help :=
intros;TMSimp; destruct_tapes; TMSimp; try lia;
try match goal with
[ |- ?L <= ?R ] => tryif (is_evar R) then (eapply le_plus_l) else (ring_simplify; shelve)
| _ => idtac
end.
Fixpoint MoveM {Σ : finType} (D : move) (n : nat) : pTM Σ unit 1 :=
match n with
| 0 => Nop
| S n => MoveM D n ;; Move D
end.
Definition TestLeftof {Σ : finType} : pTM Σ bool 1 :=
Switch ReadChar (fun s1 => match s1 with Some _ => Return Nop false | None => Move Rmove ;; Switch ReadChar (fun s2 => match s2 with None => Return Nop false | Some _ => Return (Move Lmove) true end) end).
Definition MoveL_rel {Σ : finType} D (n : nat) : Vector.t (tape Σ) 1 -> unit * Vector.t (tape Σ) 1 -> Prop :=
fun t '(_, t') => t' = Vector.map (Nat.iter n (fun t => @tape_move Σ t D)) t.
Definition WriteB (n : nat) (c : option (Fin.t n)) : pTM (FinType (EqType bool)) unit 1 :=
match c with
| None => Nop
| Some c =>
Switch TestLeftof (fun b => if b then WriteString Lmove (rev (false :: encode_sym c ++ [true])) else
WriteString Rmove (false :: encode_sym c ++ [true]) ;; MoveM Lmove (S n))
end.
Definition MoveB (m : move) n : pTM (finType_CS bool) unit 1 :=
Switch TestLeftof (fun b => match b, m with
| true, Rmove => Move Rmove
| _, _ => MoveM m (2 + n)
end).
Arguments Nat.iter : simpl never.
Opaque Nat.iter.

Lemma MoveB_Realise (n : nat) m :
MoveB m n ⊨ fun t '(l, t') => forall t_sig, t = [| encode_tape t_sig |] -> t' = [| @encode_tape n (mv m t_sig) |].