Section MoveToSymbol.
Variable sig : finType.
(* Halt function *)
Variable f : sig -> bool.
(* Rewrite function *)
Variable g : sig -> sig.
(* * One Step: * Read one symbol. If there was no symbol, return [Some tt] (break out of the loop). * If the symbol [s] fulfills [f], write [g s] and return [Some tt]. * Else, write [g s] and move right, return [None] (continue the loop). *)
Definition MoveToSymbol_Step : pTM sig (option unit) 1 :=
Switch (ReadChar)
(fun b : option sig =>
match b with
| Some x => if f x
(* then Return (Nop) (Some tt) (* found the symbol, break *) *)
then Return (Write (g x)) (Some tt) (* found the symbol, break *)
else Return (WriteMove (g x) Rmove) (None) (* wrong symbol, move right and continue *)
| _ => Return (Nop) (Some tt) (* there is no such symbol, break *)
end).
Definition MoveToSymbol_Step_Fun : tape sig -> tape sig :=
fun t1 =>
match current t1 with
| Some s => if (f s)
then tape_write t1 (Some (g s))
else doAct t1 (Some (g s), Rmove)
| _ => t1
end.
Definition MoveToSymbol_Step_Rel : Rel (tapes sig 1) (option unit * tapes sig 1) :=
Mk_R_p (fun tin '(yout, tout) =>
tout = MoveToSymbol_Step_Fun tin /\
yout = match current tin with
| Some m =>
if f m
then Some tt (* break *)
else None (* continue *)
| _ => (Some tt) (* break *)
end
).
(* * The main loop of the machine. * Execute MoveToSymbol_Step in a loop until MoveToSymbol_Step returned [Some tt] *)
Definition MoveToSymbol : pTM sig unit 1 := While MoveToSymbol_Step.
Definition rlength (t : tape sig) := length (tape_local t).
(* Function of [MoveToSymbol] *)
Function MoveToSymbol_Fun (t : tape sig) { measure rlength t } : tape sig :=
match current t with
| Some m => if f m
then tape_write t (Some (g m))
else MoveToSymbol_Fun (doAct t (Some (g m), Rmove))
| _ => t
end.
(* Termination *)
Function MoveToSymbol_steps (t : tape sig) { measure rlength t } : nat :=
match current t with
| Some m => if f m then 4 else 4 + (MoveToSymbol_steps (doAct t (Some (g m), Rmove)))
| _ => 4
end.
Local Arguments plus : simpl never. Local Arguments mult : simpl never.
(* Move to left *)
Definition MoveToSymbol_L := Mirror MoveToSymbol.
Definition llength (t : tape sig) := length (tape_local_l t).
Function MoveToSymbol_L_Fun (t : tape sig) { measure llength t } : tape sig :=
match current t with
| Some s  =>
if f s
then tape_write t (Some (g s))
else MoveToSymbol_L_Fun (doAct t (Some (g s), Lmove))
| _ => t
end.
Definition MoveToSymbol_L_Rel : Rel (tapes sig 1) (unit * tapes sig 1) :=
Mk_R_p (ignoreParam (fun tin tout => tout = MoveToSymbol_L_Fun tin)).

Lemma MoveToSymbol_L_Realise :
MoveToSymbol_L ⊨ MoveToSymbol_L_Rel.