Section Shift.
Variable sig : finType.
Variable (f : sig -> bool). (* halt if this symbol was read (and overwritten) *)
Definition Shift_Step_Rel (s : sig) : pRel sig (sig + unit) 1 :=
fun tin '(yout, tout) =>
match current tin[@Fin0] with
| Some c =>
if f c
then tout[@Fin0] = doAct tin[@Fin0] (Some s, Nmove) /\ yout = inr tt
else tout[@Fin0] = doAct tin[@Fin0] (Some s, Rmove) /\ yout = inl c
| None => tout[@Fin0] = tape_write tin[@Fin0] (Some s) /\ yout = inr tt
end.
Definition Shift_Step (s : sig) : pTM sig (sig + unit) 1 :=
Switch (ReadChar)
(fun c => match c with
| Some c =>
if f c then Return (Write s) (inr tt)
else Return (WriteMove s Rmove) (inl c)
| None => Return (Write s) (inr tt)
end).
Definition Shift := StateWhile Shift_Step.
Definition Shift_fun_measure (t : tape sig) := length (tape_local t).
Function Shift_fun (s : sig) (t : tape sig) {measure Shift_fun_measure t} :=
match current t with
| Some c =>
if f c then doAct t (Some s, Nmove)
else Shift_fun c (doAct t (Some s, Rmove))
| None => tape_write t (Some s)
end.

Lemma Shift_fun_correct_midtape s ls m rs r :
f m = false ->
f r = false ->
(forall x, In x rs -> f x = false) ->
Shift_fun s (midtape ls m (rs ++ [r])) =
midtape (rev rs ++ m :: s :: ls) r nil.