Section CopySymbols.
Variable sig : finType.
(* Termination check *)
Variable f : sig -> bool.
Definition CopySymbols_Step : pTM sig (option unit) 2 :=
Switch (ReadChar_at Fin0)
(fun b : option sig =>
match b with
| Some x =>
(* First write the read symbol to tape 1 *)
if f x
then (* found the symbol: write it to tape 1; break and return *)
Return (LiftTapes (Write x) [|Fin1|]) (Some tt)
else (* wrong symbol: write it to tape 1 and move both tapes right and continue *)
Return (LiftTapes (Write x) [|Fin1|];;
MovePar Rmove Rmove) (None)
| _ => Return Nop (Some tt) (* there is no such symbol, break and return *)
end).
Definition CopySymbols_Step_Rel : pRel sig (option unit) 2 :=
fun tin '(yout, tout) =>
match current tin[@Fin0] with
| Some x =>
if (f x)
then tout[@Fin0] = tin[@Fin0] /\
tout[@Fin1] = tape_write tin[@Fin1] (Some x) /\
yout = Some tt (* break *)
else tout[@Fin0] = tape_move_right tin[@Fin0] /\
tout[@Fin1] = doAct tin[@Fin1] (Some x, Rmove) /\
yout = None (* continue *)
| _ => tout = tin /\
yout = Some tt
end.
(* * The main loop of the machine. * Execute CopySymbols_Step in a loop until CopySymbols_Step returned [Some tt] *)
Definition CopySymbols : pTM sig unit 2 := While CopySymbols_Step.
Definition rlength (t : tape sig) := length (tape_local t).
Definition rlength' (tin : tape sig * tape sig) : nat := rlength (fst tin).
(* Function of CopySymbols *)
Function CopySymbols_Fun (tin : tape sig * tape sig) { measure rlength' tin } : tape sig * tape sig :=
match current (fst tin) with
| Some s =>
if f s
then (fst tin, tape_write (snd tin) (Some s))
else CopySymbols_Fun (tape_move_right (fst tin), doAct (snd tin) (Some s, Rmove))
| _ => tin
end.
Definition CopySymbols_Rel : Rel (tapes sig 2) (unit * tapes sig 2) :=
ignoreParam (fun tin tout => (tout[@Fin0], tout[@Fin1]) = CopySymbols_Fun (tin[@Fin0], tin[@Fin1])).

Lemma CopySymbols_false s t1 t2 :
current t1 = Some s ->
f s = false ->
CopySymbols_Fun (t1, t2) = CopySymbols_Fun (tape_move_right t1, doAct t2 (Some s, Rmove)).