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 midtape_left_midtape {Σ : finType} (l1 l2 : list Σ) m m' r n :
n = S (length l1) ->
Nat.iter n (@tape_move_left Σ) (midtape (rev l1 ++ [m'] ++ l2) m r) = midtape l2 m' (l1 ++ m :: r).