Module TM := TM Ctx. Export TM.
(** During computation, a tape is represented similarly to [tape], but with finite lists at each side, implicitly completed with [s0]. *)
Definition ctape : Type := list Sym * Sym * list Sym.
(** Lifting [ctape] into the corresponding [tape]. *)
Fixpoint lift_side (xs : list Sym) : Stream Sym :=
match xs with
| [] => const s0
| x :: xs => Cons x (lift_side xs)
end.
Definition lift_tape (t : ctape) : tape :=
match t with (l, s, r) => (lift_side l, s, lift_side r) end.
Definition lift (c : Q * ctape) : Q * tape :=
match c with (q, t) => (q, lift_tape t) end.
Local Obligation Tactic := intros; subst;
simpl; rewrite const_unfold; congruence.
(** Deciding whether two [ctape]s correspond to the same [tape]. *)
Program Fixpoint empty_side (xs : list Sym)
: {lift_side xs = const s0} + {lift_side xs <> const s0} :=
match xs with
| x :: xs => eqb_sym x s0 && Reduce (empty_side xs)
| [] => Yes
end.
Local Obligation Tactic := intros; subst; simpl in *; try congruence.
Program Fixpoint eqb_side (xs ys : list Sym)
: {lift_side xs = lift_side ys} + {lift_side xs <> lift_side ys} :=
match xs with
| x :: xs' =>
match ys with
| y :: ys' => eqb_sym x y && Reduce (eqb_side xs' ys')
| [] => Reduce (empty_side xs)
end
| [] => Reduce (empty_side ys)
end.
Program Definition eqb_tape (t t' : ctape)
: {lift_tape t = lift_tape t'} + {lift_tape t <> lift_tape t'} :=
match t, t' with
| (l, s, r), (l', s', r') =>
eqb_side l l' && (eqb_sym s s' && Reduce (eqb_side r r'))
end.
Program Definition eqb (c c' : Q * ctape)
: {lift c = lift c'} + {lift c <> lift c'} :=
match c, c' with
| q;; t, q';; t' => eqb_q q q' && Reduce (eqb_tape t t')
end.
(** Movement on [ctape]s. *)
Definition left (t : ctape) : ctape :=
match t with
| ([], s, r) => ([], s0, s :: r)
| (s' :: l, s, r) => (l, s', s :: r)
end.
Definition right (t : ctape) : ctape :=
match t with
| (l, s, []) => (s :: l, s0, [])
| (l, s, s' :: r) => (s :: l, s', r)
end.
Arguments left : simpl never.
Arguments right : simpl never.

Lemma lift_right : forall t, lift_tape (right t) = move_right (lift_tape t).