Section Compare.
Variable sig : finType.
Variable stop : sig -> bool. (* stop symbol(s) *)
Definition Compare_Step : pTM sig (option bool) 2 :=
Switch
(CaseChar2 (fun c1 c2 =>
match c1, c2 with
| Some c1, Some c2 =>
if (stop c1) && (stop c2)
then Some true (* both stop symbols were reached at the same time ~> strings are equal *)
else if (stop c1) || (stop c2)
then Some false (* Only one stop symbol was reached ~> one string is longer *)
else if Dec (c1 = c2)
then None (* up to here, the strings are the same *)
else Some false (* symbols differ! *)
| _, _ => Some false (* At least one string not terminated *)
end))
(fun x : option bool => match x with
| Some b => Return Nop (Some b)
| None => Return (MovePar Rmove Rmove) None
end).
Definition Compare_Step_Rel : pRel sig (option bool) 2 :=
fun tin '(yout, tout) =>
match current tin[@Fin0], current tin[@Fin1] with
| Some c1, Some c2 =>
if (stop c1) && (stop c2)
then yout = Some true /\ tout = tin
else if (stop c1) || (stop c2)
then yout = Some false /\ tout = tin
else if Dec (c1 = c2)
then yout = None /\ tout[@Fin0] = tape_move_right tin[@Fin0] /\ tout[@Fin1] = tape_move_right tin[@Fin1]
else yout = Some false /\ tout = tin
| _, _ => yout = Some false /\ tout = tin
end.
Definition Compare := While Compare_Step.
Definition Compare_fun_measure (t : tape sig * tape sig) : nat := length (tape_local (fst t)).
Function Compare_fun (t : tape sig * tape sig) {measure Compare_fun_measure t} : bool * (tape sig * tape sig) :=
match (current (fst t)), (current (snd t)) with
| Some c1, Some c2 =>
if (stop c1) && (stop c2)
then (true, t)
else if (stop c1) || (stop c2)
then (false, t)
else if Dec (c1 = c2)
then Compare_fun (tape_move_right (fst t), tape_move_right (snd t))
else (false, t)
| _, _ => (false, t)
end.
Definition Compare_Rel : pRel sig bool 2 :=
fun tin '(yout, tout) => (yout, (tout[@Fin0], tout[@Fin1])) = Compare_fun (tin[@Fin0], tin[@Fin1]).

Lemma Compare_Realise : Compare ⊨ Compare_Rel.