\chapter{Generalised Register Machines}
\label{chap:programming}

We can define Turing machines by combining sub-machines in an imperative style, where we use primitive machines like $\MS{DoAct}$ as the primitive
instructions of our language for Turing machines.  Furthermore, we can reuse machines in bigger contexts (w.r.t.\ number of tapes and symbols).
Recall that we do not reason about internal states of machines anymore.

At this point, we want to abstract from concrete tapes.  We think of tapes as \textit{registers} that may either contain a value of an arbitrary
encodable type, or may be resetted.  Note that this notion of a ``general register machine'' is more general than usual register machines, because
registers usually can only contain numbers.

When we speak of ``programming'' Turing machines, this means that instead of using primitive machines (like $\MS{DoAct}$) we only use machines that
directly change the value of a tape (like $\MS{ConstrS}$, which increases a number).  Using the definition of value-containment, we can also formalise
a ``callee-saving'' convention for computation of functions.  Furthermore, we show a general pattern how to program and verify Turing machines, and
present more complex case studies in this chapter.

\section{Value-Containment}
\label{sec:value-containment}

We first want to define what it means that a tape $t$ \emph{contains} a value $x$, written as $t \simeq x$.  Tapes, as defined in
Definition~\ref{def:tape}, are essentially a list of symbols, so we have to linearise values to strings.

\setCoqFilename{ProgrammingTuringMachines.TM.Code.Code}%
\begin{definition}[Encodable types][codable]
  \label{def:encodable}
  We say that a type $X$ is encodable on a finite alphabet $\Sigma_X$, if there is a function $encode : X \to \List(\Sigma_X)$.
\end{definition}

Morally, the encoding function should be injective.  There should also be a decoding function, such that the pair $(encode, decode)$ is a retraction
on $\List(\Sigma)$.  As we do not need any of these facts, we leave them out of this definition.

We can map encodings with retractions:
\begin{definition}[Map encodings][Encode_map]
  \label{def:Encode_map}
  Let $X$ be encodable on $\Sigma$ and $f : \Sigma \hookrightarrow \Tau$ be a retraction.  Then $X$ is also encodable on $\Tau$ with the following
  encoding function:
  \[ encodeMap~encode_\Sigma~f~(x) := \map{f}{(encode_\Sigma(x))}. \]
\end{definition}

Mapping of encodings are compatible with composition of retractions.  This means that if we map the encoding twice, this is the same as mapping the
encoding with the composition of both retractions:
\begin{lemma}[Composition and encoding mapping][Encode_map_comp]
  \label{lem:Encode_map_comp}
  Let $X$ be encodable on $\Sigma$ with the function $encode_\Sigma : X \to \List(\Sigma)$.  Let $f : \Sigma \hookrightarrow \Tau$ and
  $g : \Tau \hookrightarrow \Delta$ be retractions.  Then there is (extensionally) only one canonical way how $X$ can be encoded on $\Delta$, i.e.:
  \[
    encodeMap~(encodeMap~f~encode_\Sigma)~g~x = encodeMap~encode_\Sigma~(g \circ f)~x
  \]
\end{lemma}

For every following type $X$ we define an alphabet $\Sigma_X$ to encode $X$ on.  If $X$ is an type constructor and $Y$ is encoded on $\Sigma_Y$, we
define $\Sigma_{X(Y)}$ as the alphabet for $X(Y)$:
\begin{definition}[Basic encodings]
  \label{def:basic-encodings}
  ~
  \begin{enumerate}
  \coqitem[Encode_unit] We encode $\Unit$ on the empty alphabet $\Sigma_\Unit := \False$ with $encode~\unit := \nil$.
  \coqitem[Encode_bool] The type $\Bool$ is encoded on itself, i.e.\ $\Sigma_\Bool := \Bool$ and $encode(b):=[b]$.
  \coqitem[Encode_option] Let $X$ be encodable on $\Sigma_X$.  Then $\Option(X)$ is encodable on
    \[ \Sigma_{\Option(X)} ::= \MS{NONE} ~|~ \MS{SOME} ~|~ (x:\Sigma_X) \]
    With the retraction $RetrOpt : \Sigma_X \hookrightarrow \Sigma_{\Option(X)}$ and
    \begin{alignat*}{3}
      &encode~&&\None  &~:=~& [\MS{NONE}] \\
      &encode~&&\Some x&~:=~& \MS{SOME} \cons encode(x)
    \end{alignat*}
  \coqitem[Encode_sum] Let $X$ be encodable on $\Sigma_X$ and $Y$ on $\Sigma_Y$.  Then $X+Y$ is encodable on
    \[ \Sigma_{X+Y} ::= \MS{INL} ~|~ \MS{INR} ~|~ (x:\Sigma_X) ~|~ (y:\Sigma_Y) \] With the retractions
    $RetrInl : \Sigma_X \hookrightarrow \Sigma_{X+Y}$, $RetInr : \Sigma_Y \hookrightarrow \Sigma_{X+Y}$ and
    \begin{alignat*}{3}
      &encode~&&(\inl x)&~:=~& \MS{INL} \cons encode(x) \\
      &encode~&&(\inr y)&~:=~& \MS{INR} \cons encode(y)
    \end{alignat*}
  \coqitem[Encode_pair] Let $X$ be encodable on $\Sigma_X$ and $Y$ on $\Sigma_Y$.  Then $X \times Y$ is encodable on
    \[ \Sigma_{X \times Y} ::= (x:\Sigma_X) ~|~ (y:\Sigma_Y) \] With the retractions
    $RetrFst : \Sigma_X \hookrightarrow \Sigma_{X \times Y}$, $RetrSnd : \Sigma_Y \hookrightarrow \Sigma_{X \times Y}$ and
    \[
      encode(x,y) := encode(x) \app encode(y)
    \]
  \coqitem[Encode_list] Let $X$ be encodable on $\Sigma_X$.  Then $\List(X)$ is encodable on
    \[ \Sigma_{\List(X)} ::= \MS{NIL} ~|~ \MS{CONS} ~|~ (x:\Sigma_X) \]
    With the retraction $RetrList : \Sigma_X \hookrightarrow \Sigma_{\List(X)}$ and
    \begin{alignat*}{3}
      &encode~&&(\nil      ) &~:=~& [\MS{NIL}] \\
      &encode~&&(x \cons ls) &~:=~& \MS{CONS} \cons encode(x) \app encode(ls)
    \end{alignat*}
  \coqitem[Encode_nat] Natural numbers $\Nat$ are encodable on $\Sigma_\Nat ::= \MS{S} ~|~ \MS{0} $ with
    \begin{alignat*}{3}
      &encode~&&(0  ) &~:=~& [\MS{O}] \\
      &encode~&&(S~n) &~:=~& \MS{S} \cons encode(n)
    \end{alignat*}
  \end{enumerate}
  Note that we implicitly map the encoding functions in this definition.  Also note that $RetrLft : X \hookrightarrow X + Y$ is similar to
  $RetrInl : \Sigma_X \hookrightarrow \Sigma_{X+Y}$.
\end{definition}

This are all encodings we need in this thesis.  We say that $X$ is \textit{minimally encodable} on $\Sigma_X$, if $X$ is encodable on $\Sigma_X$
according to Definition~\ref{def:basic-encodings}.  Mapping of encodings introduces ambiguity: It is not only possible to encode multiple types on the
same alphabet, but there may also be several ways how to encode the same type on the same alphabet.  For example, the minimal alphabet of the type
$X+X$ is $\Sigma_{X+X}$.  Although there is only one way to encode $X+X$ on $\Sigma_{X+X}$, there are two possibilities how to encode $X$: using the
retraction $RetrInl$ or $RetrInr$.  We must deal with this problem, when we program and verify Turing machines, by explicitly specifying the right
retractions.

If $X$ is encodable on $\Sigma$, we encode values of $X$ on tapes with an extended alphabet $\Sigma^+$ that has an additional start and stop symbol.
\setCoqFilename{ProgrammingTuringMachines.TM.Code.CodeTM}%
\begin{definition}[$\Sigma^+$][boundary]
  Let $\Sigma : \Type$.  Then $\Sigma^+ ::= \MS{START} ~|~ \MS{STOP} ~|~ \MS{UNKNOWN} ~|~ (s: \Sigma)$.
  \setCoqFilename{ProgrammingTuringMachines.TM.Code.ChangeAlphabet}%
  Also, we define the retraction $\coqlink[Retract_plus]{RetrPlus} : \Sigma \hookrightarrow \Sigma^+$.
  \setCoqFilename{ProgrammingTuringMachines.TM.Code.CodeTM}%
\end{definition}
The $\MS{UNKNOWN}$ symbol is important later. We define what $t \simeq x$ means:
\begin{definition}[$t \simeq x$][tape_contains]
  \label{def:tape_contains}
  Let $X$ be encodable on $\Sigma$ and $t : \Tape_{\Sigma^+}$.
  \[
    t \simeq x := \exists~ls.~
    t = \MS{midtape}~ls~\MS{START}~(encode(x) \app [\MS{STOP}])
  \]
  In case the encoding is not clear, we write $t \simeq_f x$ with $t:\Tape_{\Tau^+}$ and $x:X$, when $X$ is minimally encodable on $\Sigma_X$ and
  $f: \Sigma_X \hookrightarrow \Tau$.
\end{definition}

Note that in Definition~\ref{def:tape_contains}, we have to map the encoding of $x$ to the extended alphabet $\Sigma^+$ using $RetrPlus$.  If
$t \simeq x$, the head of $t$ stands on the start symbol.  To the right, there is the encoding, which is terminated by one stop-symbol.  To the left
of the head, there may be arbitrarily many ``rest'' symbols.

We find the convention useful that there are no further symbols beyond the stop symbol.  In future work we also want to reason about space usage of
machines.  If a tape contains a value, the size of the tape (i.e.\ the number of symbols on it), only depends on the length of the encoding and the
number of rest symbols $ls$ to the left.  To avoid data leaks, we have the convention to only add symbols on the left side.  We also only write on
tapes, if the head of the tape is on the right-most symbol.

\begin{definition}[Right tape][isRight]
  \label{def:isRght}
  $isRight(t) := \exists m~rs.~t=\MS{midtape}~ls~m~\nil$.
  With other words, a tape $t$ is right, if and only if $\MS{current}(t) \neq \None \land \MS{right}(t) = \nil$.
\end{definition}

\section{Alphabet-Lifting}
\label{sec:LiftAlphabet-UNKNOWN}

In Section~\ref{sec:sigma-Lift}, we defined the alphabet-lift operator.  We noted that we need a semantically \textit{relevant} default symbol in the
smaller alphabet $\Sigma$.  All ``programmed'' Turing machines are defined on an extended alphabet $\Sigma^+$.  It seems therefore useful to introduce
a uniform default symbol $\MS{UNKNOWN}$ to $\Sigma^+$.  Intuitively, nothing can go wrong, because, by definition, $\MS{UNKNOWN}$ is not part of any
encoding.  This intuition is confirmed by the following lemma: \setCoqFilename{ProgrammingTuringMachines.TM.Code.ChangeAlphabet}%
\begin{lemma}[$surject$ and value-containment][contains_translate_tau]
  \label{lem:contains_translate_tau}
  Let $f: \Sigma \hookrightarrow \Tau$ be a retraction.  Let $x:X$, where $X$ is encodable on $\Sigma$, and $t:\Tape_{\Tau^+}$:
  \[
    mapTape~(surject~(RetrPlus \circ f)~\MS{UNKNOWN})~t \simeq x ~\iff~ t \simeq_f x
  \]
\end{lemma}
Note that the encoding on the right side is mapped with the retraction $f$.

We write $\LiftAlphabet{M}{f}$ for $\LiftAlphabet{M}{(RetrPlus \circ f , \MS{UNKNOWN})}$.  Note that we also use the $\Uparrow$ notation for the
tapes-lift, but it is always clear whether we mean the tape-lift or alphabet-lift.  We use the notation
$\LiftBoth{M}{f}{I} := \LiftTapes{(\LiftAlphabet{M}{f})}{I}$, for first applying the alphabet-lift, and after that the tapes-lift.

\section{Value-Manipulating Machines}
\label{sec:value-manipulate}

We have defined what it means that a tape contains a value.  Now we want to define machines that manipulate values, e.g.\ increase or decrease a
number.  Another very useful operation is to copy a value from one tape to another tape.

\subsection{Write Value}
\label{sec:WriteValue}
\setCoqFilename{ProgrammingTuringMachines.TM.Code.WriteValue}%

We define a wrapper around the machine $\MS{WriteString}$ from Section~\ref{sec:WriteString}.  We parametrise $\MS{WriteValue}$ over the encoding
$str : \List(\Sigma_X$) of a value $x:X$.\footnote{The reason why $\MS{WriteValue}$ is not parametrised over values $x:X$ is, that we would also need
  to parametrise the machine over the encoding function of $X$.  With this approach, only the correctness Lemma~\ref{lem:WriteValue_Sem} and the correctness
  relation are parametrised over the encoding.}
\begin{definition}[$\MS{WriteValue}$][WriteValue]
  \label{def:WriteValue}
  Let $str:\List(\Sigma)$
  \[
    \MS{WriteValue}(str) := \MS{WriteString}~\MS{L}~\left(\rev{\left(\MS{START} \cons \map{RetrPlus}{str} \app [\MS{STOP}]\right)}\right)
  \]
\end{definition}
The machine writes the stop symbol, the encoding $str$, and the start symbol in reversed order from right to left.  After the execution of the
machine, the tape contains the value $x$ with the encoding $str$, under the precondition that the tape was initially right.
\begin{lemma}[Correctness of $\MS{WriteValue}$][WriteValue_Sem]
  \label{lem:WriteValue_Sem}
  Let $X$ be encodable over $\Sigma_X$ and $str : \List(\Sigma)$.
  \[
    \MS{WriteValue}(str) \RealiseIn{3 + 2 \cdot \length{str}} WriteValueRel(str)
  \]
  \[
    WriteValueRel(str) := \lambda t~t'.~\forall (x:X).~encode(x) = str \rightarrow isRight~t[0] \rightarrow t'[0] \simeq x.
  \]
\end{lemma}

\subsection{Constructor and Deconstructor Machines}
\label{sec:constructors-deconstructors}

For each encodable type $X$, there is a set of machines: constructor machines and one deconstructor machine.  These machines are defined on the
minimal alphabet $\Sigma_X^+$.  Constructor machines, informally, ``apply'' a constructor of the inductive type $X$ to the value on the tape $t[0]$.
In general, we have one constructor machine for each constructor of the inductive type.  If the constructor has additional arguments, these are
encoded on more input tapes $t[1], t[2], \cdots$.  There is only one deconstructor machine for each type.  The deconstructor machine for $X$ has one
label for every constructor of $X$.  It makes a case-distinction over the value of the tape, and it terminates in the label that corresponds to the
constructor.  Deconstructor machines may have additional tapes for storing additional arguments of constructors.

\subsubsection{Natural numbers}
\label{sec:match-nat}
\setCoqFilename{ProgrammingTuringMachines.TM.Code.CaseNat}%

We consider the inductive type $\Nat$, that has two constructors: $S$ and $0$.  The constructor machine $\MS{ConstrO}$ writes the number $0$ on a
right tape.  The constructor machine $\MS{ConstrS}$ assumes that $t[0]$ contains a number $n$, and increases that number.

We define the $0$-constructor with $\MS{WriteValue}$:
\begin{definition}[$\MS{ConstrO}$][Constr_O]
  \label{def:Constr_O}
  $\MS{ConstrO} := \MS{WriteValue}~[\MS{O}]$.
\end{definition}
\begin{lemma}[Correctness of $\MS{ConstrO}$][Constr_O_Sem]
  \label{lem:Constr_O_Sem}
  $\MS{ConstrO} \RealiseIn{5} ConstrORel$ with
  \[
    ConstrORel := \lambda t~t'.~isRight~t[0] \rightarrow t'[0] \simeq 0
  \]
\end{lemma}
\begin{proof}
  With Lemma~\ref{lem:RealiseIn_monotone} and~\ref{lem:WriteValue_Sem}.
\end{proof}

The $S$ constructor overwrites the current symbol (which is the start symbol) with $\MS{S}$ and writes a new start symbol one step left.
\begin{definition}[$\MS{ConstrS}$][Constr_S]
  $\MS{ConstrS} := \MS{WriteMove}~\MS{S}~\MS{L} \Seq \MS{Write}~\MS{START}$
\end{definition}
\begin{lemma}[Correctness of $\MS{ConstrS}$][Constr_S_Sem]
  $\MS{ConstrS} \RealiseIn{3} ConstrSRel$ with
  \[
    ConstrSRel := \lambda t~t'.~\forall n.~ t[0] \simeq n \rightarrow t'[0] \simeq S~n.
  \]
\end{lemma}

$\MS{CaseNat}$ is the deconstructor machine for $\Nat$.  It reads a number from tape $t[0]$.  If it is $0$, $\MS{CaseNat}$ leaves the number unchanged
and terminates in the label $\false$.  Else, it decreases the number and terminates in~$\true$.

Initially, the tape $t[0]$ contains some number $n$.  Thus, the head of $t[0]$ must be on the start symbol.  The machine moves one step right and
reads the first symbol of the encoding.  This symbol either is $\MS{S}$ or $\MS{O}$.  If the machine read the symbol $\MS{O}$, this means that the
number $n$ is $0$, so the machine moves back to the start symbol and terminates in the label $\false$, indicating that the number was $0$.  On the
other side, if the machine read $\MS{S}$, this means the number $n$ is the successor of some number $n'$.  To decrement $n$, it overwrites the current
$\MS{S}$ with a new start symbol and terminates on this symbol in the label $\true$.

\begin{definition}[$\MS{CaseNat}$][CaseNat]
  \label{def:CaseNat}
  ~
\begin{lstlisting}[style=semicoqstyle]
$\MS{CaseNat} :=$
  $\MS{Move}~\MS{R}$;
  $\Switch~\MS{Read}$
       ($\lambda(s:\Option(\Sigma_\Nat^+)).~\MS{match}~s$
          [$\Some {\MS{S}}$=>$\Return{(\MS{Write}~\MS{START})}{\true}$
          |$\Some {\MS{O}}$=>$\Return{(\MS{Move}~\MS{L})}{\false}$
          |_=>_
          ])
\end{lstlisting}
\end{definition}

Note, that the placeholder ``$\_$'' stands for some unspecified machine, e.g.\ in this case $\Return{\Nop}{b}$ where $b:\Bool$ can be chosen
arbitrarily.  We do not give this part explicitly here, because the premise of the correctness relation of $\MS{CaseNat}$ guaranties that there must
be a symbol under the head that is either $\MS{S}$ or $\MS{O}$, so this part of the machine must never execute.

\begin{lemma}[Correctness of $\MS{CaseNat}$][CaseNat_Sem]
  $\MS{CaseNat} \RealiseIn{5} CaseNatRel$ with
\begin{lstlisting}[style=semicoqstyle]
$CaseNatRel :=$
  $\lambda t~(l, t').~\forall (n:\Nat).~t[0] \simeq n \rightarrow$
    $\MS{match}~l,n$
    [$\false,0$=>$t'[0] \simeq 0$
    |$\true,S~n'$=>$t'[0] \simeq n'$
    |_,_=>$\False$
    ]
\end{lstlisting}
\end{lemma}
\begin{proof}
  We know that $t[0] \simeq n$.  This means $t[0] = \MS{midtape}~ls~\MS{START}~(\MS{S}^n \app \MS{O} \cons \MS{STOP})$ for some $ls$.  The proof is
  mechanical, like the above correctness proofs.  It makes a case-distinction over $n$.
\end{proof}

Note that for the case that $n$ is $0$, we could also write $t'=t$ in the correctness relation.  But we have the following convention: When some tape
does not change, we use the weaker postcondition that the tape $t'$ still contains the same values (and that the same tapes are right).  This
convention has the advantage that when we apply the alphabet-lift with a retraction $f$, we would otherwise get assumptions in correctness proofs
like:
\begin{align*}
  & mapTapes~\left(surject~(RetrPlus \circ f)~\MS{UNKNOWN}\right)~t = \\
  & mapTapes~\left(surject~(RetrPlus \circ f)~\MS{UNKNOWN}\right)~t'
\end{align*}
\setCoqFilename{ProgrammingTuringMachines.TM.Code.ChangeAlphabet}%
To show that $t'[i]$ contains the same value as $t[i]$, we would have to apply a \coqlink[contains_translate_eq]{lemma}.  Using this convention we get
this for free.%
\setCoqFilename{ProgrammingTuringMachines.TM.Code.CaseNat}%

\subsubsection{Sum Types}
\label{sec:match-sum}

Let $X$ be encodable on $\Sigma_X$ and $Y$ on $\Sigma_Y$.  $\MS{CaseSum} : \TM_{\Sigma_{X+Y}^+}^1(\Bool)$ reads a value $s:X+Y$.  If it is $\inl x$
(or $\inr~l$), it replaces the $\MS{INL}$ (or $\MS{INR}$) symbol with a new start symbol and terminates in $\true$ (or $\false$).

\setCoqFilename{ProgrammingTuringMachines.TM.Code.CaseSum}%
\begin{definition}[$\MS{CaseSum}$][CaseSum]
  \label{def:CaseSum}
  ~
  \small
\begin{lstlisting}[style=semicoqstyle]
$\MS{CaseSum} :=$
  $\MS{Move}~R\Seq$
  $\Switch~\MS{Read}$
       ($\lambda(s:\Option(\Sigma_{X+Y}^+)).~\MS{match}~s$
         [$\Some {\MS{INL}}$=>$\Return{(\MS{Write}~\MS{START})}{\true}$
         |$\Some {\MS{INR}}$=>$\Return{(\MS{Write}~\MS{START})}{\false}$
         |_=>_
         ])
\end{lstlisting}
\end{definition}

\begin{lemma}[Correctness of $\MS{CaseSum}$][CaseSum_Sem]
  \label{lem:CaseSum_Realise}
  $\MS{CaseSum} \RealiseIn{5} CaseSumRel$ with
\begin{lstlisting}[style=semicoqstyle]
$CaseSumRel :=$
  $\lambda t~(l, t').$ $\forall (s:X+Y).$ $t[0] \simeq s \rightarrow \MS{match}~l,s$
    [$\false$, $\inl x$=>$t'[0] \simeq x$
    |$\true$, $\inr y$=>$t'[0] \simeq y$
    |_,_=>$\False$
    ]
\end{lstlisting}
\end{lemma}

We have one constructor machine for $\inl$ and $\inr$, respectively.  They are both analogous.  They overwrite the start symbol with $\MS{INL}$ or
$\MS{INR}$ and write a new start symbol one step further left.
\begin{definition}[$\MS{ConstrInl}$][Constr_inl]
  \label{def:Constr_inl}
  $\MS{ConstrInl} := \MS{WriteMove}~\MS{INL}~\MS{L} \Seq \MS{Write}~\MS{START}$.
\end{definition}
\begin{lemma}[Correctness of $\MS{ConstrInl}$][Constr_inl_Sem]
  \label{lem:Constr_inl_Sem}
  $\MS{ConstrInl} \RealiseIn{3} ConstrInlRel$ with
  \[
    ConstrInlRel := \lambda t~t'.~\forall(x:X).~t[0] \simeq x \rightarrow t'[0] \simeq \inl x
  \]
\end{lemma}

\subsubsection{Option Types}
\label{sec:match-option}

The types $\Option(X)$ and $X+\Unit$ are isomorphic.  Furthermore, the alphabets to encode these types on, $\Sigma_{\Option(X)}$ and $\Sigma_{X+1}$,
are also isomorphic.  We can use this fact to derive a deconstructor machine and constructor machines for the type $\Option(X)$.  Let
$f : \Sigma_{X+\Unit} \hookrightarrow \Sigma_{\Option(X)}$ be the canonical retraction.  Then, we can define $\MS{CaseOption}$ as
$\LiftAlphabet{\MS{CaseSum}}{f}$.  However, in the case that $o=\None$, the output tape $t'$ contains $\unit$.  Thus, the tape has form
$t' = \MS{midtape}~ls~\MS{START}~[\MS{STOP}]$ (for some $ls$).  However, we want that the tape is right in this case.  That is, because $\Option(X)$
is not a recursive data type and the information that $o=\None$ is already encoded in the label of the state in which $\MS{CaseOption}$ terminates.
So in this case, the tape moves one step to the right:
\begin{definition}[$\MS{CaseOption}$][CaseOption]
  \label{def:CaseOption}
  ~
  \[
    \MS{CaseOption} := \If{(\LiftAlphabet{\MS{CaseSum}}{f})}{(\Return{\Nop}{\true})}({\Return{(\MS{Move}~\MS{R})}{\false})}
  \]
\end{definition}

\begin{lemma}[Correctness of $\MS{CaseOption}$][CaseOption_Sem]
  \label{lem:CaseOption_Realise}
  $\MS{CaseOption} \RealiseIn{7} CaseOptionRel$ with
\begin{lstlisting}[style=semicoqstyle]
$CaseOptionRel :=$
  $\lambda t~(l, t').$ $\forall (o:\Option(X)).$ $t[0] \simeq o \rightarrow \MS{match}~l, o$
    [$\false$, $\None$     =>$isRight(t'[0])$
    |$\true$, $\Some x$=>$t'[0] \simeq x$
    |_,_=>$\False$
    ]
\end{lstlisting}
\end{lemma}
Note that we have to add $2$ extra steps: one for the conditional and one for the $\MS{Move}$ in the $\None$-case.

We can also derive the $\Some{\cdot}$ constructor of $\Option(X)$ from the $\inl$ constructor of $X+\Unit$.
\begin{definition}[$\MS{ConstrSome}$][Constr_Some]
  \label{def:Constr_Some}
  $\MS{ConstrSome} := \LiftAlphabet{\MS{ConstrInl}}{f}$.
\end{definition}
\begin{lemma}[Correctness of $\MS{ConstrSome}$][Constr_Some_Sem]
  \label{lem:Constr_Some_Sem}
  $\MS{ConstrSome} \RealiseIn{3} ConstrSomeRel$ with
  \[
    ConstrSomeRel := \lambda t~t'.~\forall(x:X).~t[0] \simeq x \rightarrow t'[0] \simeq \Some{x}
  \]
\end{lemma}
For the $\None$ constructor, we simply use $\MS{WriteValue}$.
\begin{definition}[$\MS{ConstrNone}$][Constr_None]
  \label{def:Constr_None}
  $\MS{ConstrNone} := \MS{WriteValue}~[\MS{NONE}]$.
\end{definition}
\begin{lemma}[Correctness of $\MS{ConstrNone}$][Constr_None_Sem]
  \label{lem:Constr_None_Sem}
  $\MS{ConstrNone} \RealiseIn{3} ConstrNoneRel$ with
  \[
    ConstrNoneRel := \lambda t~t'.~isRight~t[0] \rightarrow t'[0] \simeq \None
  \]
\end{lemma}

\subsubsection{Product Types}
\label{sec:CasePair}

The deconstructor and constructor machines for product types have to explicitly copy parts of values.  Thus, their running time depends on the value.  We
use the machines $\MS{MoveToSymbol}$ and $\MS{CopySymbols}$.

Let $X$ and $Y$ be encodable on $\Sigma_X$ and $\Sigma_Y$.  The deconstructor $\MS{CasePair} : \TM_{\Sigma_{X \times Y}^+}^2$ copies the first
component of the pair $(x,y):X \times Y$ to tape~$1$, the second component remains on tape~$0$.  The machine works as follows: first it writes the
stop symbol on tape~$1$.  Then, it seeks the last character of the encoding of $x$ on tape $0$, copies the encoding of $x$ from right to left to
tape~$1$, including the start symbol.  At this point, tape $0$ contains $(x,y)$ and tape $1$ contains $x$.  Then it again moves tape $0$ to last
symbol of the encoding of $x$ on tape~$0$ and overwrites it with a new start symbol.

\setCoqFilename{ProgrammingTuringMachines.TM.Code.CasePair}%
\begin{definition}[$\MS{CasePair}$][CasePair]
  \label{def:CasePair}
  ~
  \begin{alignat*}{2}
    &\MS{CasePair}&~:=~& \LiftTapes{(\MS{WriteMove}~\MS{STOP}~\MS{L})}{\Vector{1}} \Seq \\
    &              &    & \LiftTapes{(\MS{MoveToSymbol}~f~id \Seq \MS{Move}~\MS{L})}{\Vector{0}} \Seq \\
    &              &    & \MS{CopySymbolsL}~g\Seq \\
    &              &    & \LiftTapes{(\MS{MoveToSymbol}~f~id \Seq \MS{Move}~\MS{L} \Seq \MS{Write}~\MS{START})}{\Vector{0}}
  \end{alignat*}
  Where $f : \Sigma_{X \times Y}^+ \to \Bool$ is true for symbols that are mapped from the alphabet $\Sigma_Y$.  $g(s)$ is $\true$ if and only if
  $s=\MS{START}$.
\end{definition}

The correctness and termination proofs of $\MS{CasePair}$ are quite technical.  We have lemmas about the tape-functions of $\MS{CopyValueL}$,
$\MS{MoveToSymbol}$, and the respective running time functions.  However, it is interesting to note that we have to do a case-distinction, whether $y$
is empty.  If it is empty, then the first $\MS{MoveToSymbol}~f~id$ moves to the stop symbol.  If it is not empty, it moves to the first symbol of the
encoding of $y$.  In both cases, $\MS{Move}~L$ moves to the last symbol of $x$ (or to the start symbol, if $x$ is empty).

\begin{lemma}[Correctness of $\MS{CasePair}$][CasePair_Realise]
  \label{lem:CasePair_Realise}
  $\MS{CasePair} \Realise CasePairRel$ with
  \small
  \[
    CasePairRel := \lambda t~t'.~\forall (p: X \times Y).~t[0] \simeq p \rightarrow isRight~t[1] \rightarrow t'[0] \simeq \pi_2(p) \land t'[1] \simeq \pi_1(p)
  \]
\end{lemma}
\begin{lemma}[Running time of $\MS{CasePair}$][CasePair_Terminates]
  \label{lem:CasePair_TerminatesIn}
  $\MS{CasePair} \TerminatesIn CasePairT$ with
  \[
    CasePairT := \lambda t~k.~\exists (p: X \times Y).~t[0] \simeq p \land 34 + 16 \cdot \size{\pi_1(p)} \leq k
  \]
\end{lemma}

The constructor copies the first component $x$ from tape $0$ to tape $1$, which initially contains the second component $y$, from right to left.  By
that, it overwrites the start symbol on tape $1$ with the last symbol of the encoding of $x$.

\begin{definition}[$\MS{ConstrPair}$][Constr_pair]
  \label{def:Constr_pair}
  ~
  \[
    \MS{ConstrPair} := \LiftTapes{(\MS{MoveToSymbol}~h~id)}{\Vector{0}} \Seq \MS{CopySymbolsL}~g
  \]
  Where $g$ is the same function as in Definition~\ref{def:CasePair}.  $h(s)$ is $\true$ if and only if $s=\MS{STOP}$.
\end{definition}

\begin{lemma}[Correctness of $\MS{ConstrPair}$][Constr_pair_Realise]
  \label{lem:Constr_pair_Realise}
  \small
  $\MS{ConstrPair} \Realise ConstrPairRel$ with
  \[
    ConstrPairRel := \lambda t~t'.~\forall (x:X)~(y:Y).~t[0] \simeq x \rightarrow t[1] \simeq y \rightarrow t'[0] \simeq x \land t'[1] \simeq (x,y)
  \]
\end{lemma}
\begin{lemma}[Running time of $\MS{ConstrPair}$][Constr_pair_Terminates]
  \label{lem:Constr_pair_TerminatesIn}
  $\MS{ConstrPair} \TerminatesIn ConstrPairT$ with
  \[
    ConstrPairT := \lambda t~k.~\exists (x: X).~t[0] \simeq x \land 19 + 12 \cdot \size{x} \leq k
  \]
\end{lemma}

\subsubsection{List Types}
\label{sec:CaseList}
\setCoqFilename{ProgrammingTuringMachines.TM.Code.CaseList}%

The definition of $\MS{CaseList}$ is quite complex.  For brevity we only state the correctness statements of the match-machine here.  The machine
$\MS{CaseList} : \TM_{\Sigma_{\List(X)}^+}^2(\Bool)$ expects a list on tape $0$.  If it is $\nil$, it terminates in the label $\false$ and leaves the
tapes unchanged.  If the list is $x \cons xs$, it moves $x$ to tape $1$ and terminates in the label $\true$.

\begin{lemma}[Correctness of $\MS{CaseList}$][CaseList_Realise]
  \label{lem:CaseList_Realise}
  $\MS{CaseList} \Realise CaseListRel$ with
\begin{lstlisting}[style=semicoqstyle]
$CaseListRel :=$
  $\lambda t~(l, t').~\forall (xs:\List(X)).~t[0] \simeq xs \rightarrow isRight~t[1] \rightarrow \MS{match}~l, xs$
    [$\false, \nil$ => $t'[0] \simeq \nil \land isRight~t'[1]$
    |$\true, x \cons xs'$ => $t'[0] \simeq xs' \land t'[1] \simeq x$
    |_,_ => $\False$
    ].
\end{lstlisting}
\end{lemma}

The $\nil$ constructor is defined using $\MS{WriteValue}$.
\begin{definition}[$\MS{ConstrNil}$][Constr_nil]
  $\MS{ConstrNil} := \MS{WriteValue}~[\MS{NIL}]$.
\end{definition}
\begin{lemma}[Correctness of $\MS{ConstrNil}$][Constr_nil_Sem]
  $\MS{ConstrNil} \RealiseIn{5} ConstrNilRel$ with
  \[
    ConstrNilRel := \lambda t~t.~isRight~t[0] \rightarrow t'[0] \simeq \nil
  \]
\end{lemma}

The ``$\cons$'' constructor machine $\MS{ConstrCons}$ expects a list on tape $0$ and a value $x:X$ on tape $1$.  It moves the head of tape $1$ to the
last symbol of the encoding of $x$ and copies them on tape $0$ from right to left.  Thereby, it overwrites the current start symbol on tape $1$, but
also copies the start symbol from tape $1$ to tape $0$.  After that, the machine overwrites this start symbol with $\MS{CONS}$ and writes a new start
symbol on tape $0$.

\begin{definition}[$\MS{ConstrCons}$][Constr_cons]
  \label{def:Constr_cons}
  \begin{alignat*}{2}
    &\MS{ConstrCons}&~:=~& \LiftTapes{(\MS{MoveToSymbol}~h~id \Seq \MS{Move}~\MS{L})}{\Vector{1}} \Seq \\
    &               &    & \LiftTapes{(\MS{CopySymbolsL~h'})}{\Vector{1;0}} \Seq \\
    &               &    & \LiftTapes{(\MS{WriteMove}~\MS{CONS}~\MS{L} \Seq \MS{Write}~\MS{START})}{\Vector{0}}
  \end{alignat*}
  With $h, h' : \Sigma_{List(X)}^+ \to \Bool$ such that $h(s)=\true$ if and only if $s=\MS{STOP}$, and $h'(s)=\false$ if and only if $s$ is mapped
  from the alphabet $\Sigma_X$.
\end{definition}

\begin{lemma}[Correctness of $\MS{ConstrCons}$][Constr_cons_Realise]
  \label{lem:Constr_cons_Realise}
  $\MS{ConstrCons} \Realise ConstrConsRel$ with
  \begin{align*}
    & ConstrConRel := \\
    & \quad \lambda t~t'.~\forall (xs:\List(X))~(x:X).~t[0] \simeq xs \rightarrow t[1] \simeq x \rightarrow t'[0] \simeq x \cons xs \land t'[1] \simeq x.
  \end{align*}
\end{lemma}

\subsubsection{Finite Types}

All finite types $\Sigma$ can be encoded on themself, i.e.\ $encode(x)=[x]$ for $x:\Sigma$.  The deconstructor machine for finite types moves the head
from the starting symbol to the symbol and reads it.  After that, it moves the head one further so that the tape is right and terminates in the label
corresponding to the read symbol.

\setCoqFilename{ProgrammingTuringMachines.TM.Code.CaseFin}%
\begin{definition}[$\MS{CaseFin}$][CaseFin]
  \label{def:CaseFin}
  Let $def:\Sigma$.
  \small
\begin{lstlisting}[style=semicoqstyle]
$\MS{CaseFin} :=$
  $\MS{Move}~\MS{R} \Seq \Switch~\MS{Read}$($\lambda s.~\MS{match}~s$[$\Some{x} \Rightarrow \Return{(\MS{Move}~\MS{R})}{x}$|_$\Rightarrow\Return{\Nop}{def}$])
\end{lstlisting}
\end{definition}

\begin{lemma}[Correctness of $\MS{CaseFin}$][CaseFin_Sem]
  \label{lem:CaseFin_Sem}
  $\MS{CaseFin} \RealiseIn{5} CaseFinRel$ with
  \[
    CaseFinRel := \lambda t~(l,t').~\forall(x:\Sigma).~t[0] \simeq x \rightarrow isRight~t'[0] ~\land~ l=x
  \]
\end{lemma}

\subsection{Copy Values}
\label{sec:copy}

In Section~\ref{sec:CopySymbols}, we defined a machine that copies symbols until a certain symbol from one tape to another tape.  In
Section~\ref{sec:MoveToSymbol}, we also defined a machine that moves the head to a certain symbol.  We want to use these machines to define a machine
that copies a value from tape $t[0]$ on tape $t[1]$.  By the convention we set up in Section~\ref{sec:value-containment}, if we write new symbols on a
tape, this tape must be right.  With other words, the machine $\MS{CopySymbols}$ can assume that the ``target'' tape is right.  Formally, the
correctness relation is defined as:
\setCoqFilename{ProgrammingTuringMachines.TM.Code.Copy}%
\begin{definition}[Correctness relation of $\MS{CopyValue}$][CopyValue_Rel]
  \label{def:CopyValue_Rel}
  ~
  \[
    CopyValueRel := \lambda t~t'.~\forall (x:X).~t[0] \simeq x \rightarrow isRight~t[1] \rightarrow t'[0] \simeq x \land t'[1] \simeq x
  \]
% \begin{lstlisting}[style=semicoqstyle]
% CopyValueRel :=
%   $\lambda t~t.\forall (x:X).$
%     $t[0] \simeq x \rightarrow$
%     $isRight t[1] \rightarrow$
%     $t'[0] \simeq x \land$
%     $t'[1] \simeq x.$
% \end{lstlisting}
\end{definition}

The algorithm of $\MS{CopyValue}$ works as follows.  First, the machine moves the head of tape $0$ right, from the start symbol to the stop symbol.
Then it copies the symbols, from the stop symbol to the start symbol, to tape $1$.

\begin{definition}[$\MS{CopyValue}$][CopyValue]
  \label{def:CopyValue}
  ~
  \small
  \[
    \MS{CopyValue} := \LiftTapes{(\MS{MoveToSymbol}~(\lambda x.~x=\MS{STOP})~~id)}{\Vector{0}} \Seq \MS{CopySymbolsL}~(\lambda x.~x=\MS{START})
  \]
\end{definition}

Note that the second parameter of $\MS{MoveToSymbol}$ is the translation function.  In this case, the machine should simply move the head and leave
the symbols unchanged, so we choose the identity function for the parameter.

\begin{lemma}[Correctness of $\MS{CopyValue}$][CopyValue_Realise]
  \label{lem:CopyValue_Realise}
  $\MS{CopyValue} \Realise CopyValueRel$.
\end{lemma}

The running time of $\MS{CopyValue}$ is linear in the size of the encoding of $x$.
\begin{lemma}[Running time of $\MS{CopyValue}$][CopyValue_Terminates]
  \label{lem:CopyValue_TerminatesIn}
  ~
  \[
    \MS{CopyValue} \TerminatesIn (\lambda t~k.~\exists(x:X).~t[0] \simeq x \land 25 + 12 \cdot \size{x} \leq k)
  \]
\end{lemma}

Although $\MS{CopyValue}$ terminates for all tapes, we restricted running time relations to reasonable tapes, i.e.\ in this case tape vectors $t$ that
actually have a symbol on $t[0]$.  The reason for that is that we want to relate the value to the number of steps.

\subsection{Translate Values}
\label{sec:Translate}

In Section~\ref{sec:value-containment}, we observed that the containment relation is ambiguous: if $X$ is minimally encodable on $\Sigma_X$, there may
be two retractions $f_1, f_2 : \Sigma_X \hookrightarrow \Tau$ on the alphabet $\Tau$.  In Section~\ref{sec:MoveToSymbol}, we gave the
$\MS{MoveToSymbol}$ machine the feature to translate the symbols it reads.  Using this feature, we define a machine that translates between the two
possibilities of the encoding of $X$ on $\Tau$.  For that, we have to define a function $tanslate~f_1~f_2 : \Tau^+ \to \Tau^+$.

\begin{definition}[Translation between two encodings][translate]
  \label{def:translate}
  Let $f_1, f_2 : \Sigma \hookrightarrow \Tau$ be two retractions on $\Tau$.
  \begin{alignat*}{2}
    & translate~f_1~f_2~(\tau) &~:=~& \tau \qquad\text{(if $\tau \in \{\MS{UNKNOWN}, \MS{START}, \MS{STOP}\}$)} \\
    & translate~f_1~f_2~(\tau) &~:=~&
    \begin{cases}
      f_2(\sigma)  & f_1^{-1}(\tau) = \Some{\sigma} \\
      \MS{UNKNOWN} & f_1^{-1}(\tau) = \None
    \end{cases}
  \end{alignat*}
\end{definition}

This function translates a symbol of $\Tau$ to $\Sigma$, using the partial inversion function $f_1^{-1}$ and afterwards applies the injection $f_2$
from $\Sigma$ to $\Tau$ and the (implicit) injection from $\Tau$ to $\Tau^+$.

\begin{definition}[$\MS{Translate}$][Translate]
  ~
  \begin{alignat*}{2}
    & \MS{Translate}~f_1~f_2 &~:=~& \MS{MoveToSymbol}~(\lambda x.~x=\MS{STOP})~(translate~f_1~f_2) \Seq \\
    &                        &~  ~& \MS{MoveToSymbolL}~(\lambda x.~x=\MS{START})~id
  \end{alignat*}
\end{definition}

\begin{lemma}[Correctness of $\MS{Translate}$][Translate_Realise]
  $\MS{Translate}~f_1~f_2 \Realise TranslateRel~f_1~f_2$ with
  \[
    TranslateRel~f_1~f_2 := \lambda t~t'.~\forall(x:X).~t[0] \simeq_{f_1} x \rightarrow t[0] \simeq_{f_2} x
  \]
\end{lemma}

\subsection{Reset Tapes}
\label{sec:reset-tape}

The aforementioned machine $\MS{MoveToSymbol}~(\lambda x.~x=\MS{STOP})~id$ can also be used to ``reset'' a tape.  This means that if the tape contains
some value, after the execution of this machine the tape is right.  This is especially important to prevent memory leaks in loops, where we may want
to write on a tape multiple times.  We must always reset every ``used'' tape before writing on it again.

\begin{definition}[$\MS{ResetTape}$][Reset]
  \label{def:Reset}
  $\MS{ResetTape} := \MS{MoveToSymbol}~(\lambda x.~x=\MS{STOP})~id$
\end{definition}

\begin{lemma}[Correctness of $\MS{ResetTape}$][Reset_Realise]
  \label{lem:Reset_Realise}
  $\MS{ResetTape} \Realise ResetTapeRel$ with
  \[
    ResetTapeRel := \lambda t~t'.~\forall(x:X).~t[0] \simeq x \rightarrow isRight(t'[0])
  \]
\end{lemma}

\section{Extending Alphabets}
\label{sec:extend-alphabet}

Consider that we have machines $M_1 : \TM_{\Sigma_X^+}^n$ and $M_2 : \TM_{\Sigma_Y^+}^n$ that operate on values of type $X$ and $Y$, where $X$ is
encodable on $\Sigma_X$ and $Y$ on $\Sigma_Y$.  We could combine these machines using the alphabet-lift, to get a machine $M : \TM_{\Sigma^+}^n$.  The
choice of $\Sigma$ is relevant.  For example, we could choose $\Sigma := \Sigma_X + \Sigma_Y$.  Then, if we want to use $M$ for another machine
$M' : \TM_{\Tau^+}^n$, we have to give a retraction $f : \Sigma_X+\Sigma_Y \hookrightarrow \Tau$.  However, there is a problem of generality:
\begin{fact}
  There exist types $X,Y,Z$ with retractions $f_1 : X \hookrightarrow Z$ and $f_2 : Y \hookrightarrow Z$, such that there is no retraction
  $(f_1+f_2) : X+Y \hookrightarrow Z$.
\end{fact}
\begin{proof}
  There is no injective function $\Unit+\Unit\to\Unit$.
\end{proof}

That means that we would have to show a precondition to combine two retractions $f_1 : \Sigma_X \hookrightarrow \Tau$ and
$f_2 : \Sigma_Y \hookrightarrow \Tau$ and get a retraction $(f_1+f_2) : \Sigma_X + \Sigma_Y \hookrightarrow \Tau$:
\begin{fact}
  If the retractions $f_1 : X \hookrightarrow Z$ and $f_2 : Y \hookrightarrow Z$ have disjoint images in $Z$, then we can define a retraction
  $(f_1+f_2) : X+Y \hookrightarrow Z$.
\end{fact}

We could live with the restriction that we have to show that the retractions have disjoint images.  However, this approach does not scale good when we
have to add more alphabets and retractions, we would have to show that all retractions have mutually disjoint images.  It is easier and more general,
to parametrise the machine $M$ over the alphabet $\Sigma$ and the two retractions $f_1$ and $f_2$.  In the definition of $M$, we apply the tapes-lift
on $M_1$ and $M_2$.

\section{Designing Machines}
\label{sec:programming-design}
\setCoqFilename{ProgrammingTuringMachines.TM.Code.CodeTM}%

As noted above, when we speak of ``programming'' Turing machines, we mean that we use tapes as registers, and use the control-flow operators and
lifting operators to compose machines.  Moreover, we only use machines that directly change the values of registers (tapes).  We have machines that do
a case-distinction on values, and machines that apply constructors to the value that a tape contains.

Our $\While$ operator corresponds to ``do-while'' in imperative languages, i.e.\ the machine $M$ has to decide at the end of its execution whether to
continue or break out of the loop.  Tail-recursive functions can easily be transformed into ``do-while'' loops.  Thus, when we translate functions to
Turing machines, we first have to implement the function as a tail-recursive function, which is then translated to a Turing machine in ``programming
style''.

% When we define and prove the semantical properties machines, we break the machine down to parts and verify each part independently.  For example, if
% we have a machine $\While~\MS{Step}$, then we first have to encode the loop-invariant into the relation $StepRel$.

We make an informal distinction between three \textit{roles} of tapes: \textit{input tapes}, \textit{output tapes}, and \textit{internal tapes}.  Each
kind of tape has an invariant, which is encoded in the correctness relation of the machine.  For input tapes, we have the invariant that the value on
the tape is not changed by the computation.  Output tapes are initially right, and contain a value after the execution.  Internal tapes are right
before and after the execution.

The deconstructor machines do case-distinctions over the value on a tape, and may alter the value on the tape thereby.  Each deconstruction is
reversible using the corresponding constructor machine.  However, if we use deconstructors inside a loop, we can not restore the value that the tape
contained before the loop.  We have to copy the value to an internal tape, use the copy for the computation, and leave the ``original'' value
unchanged.  After the loop, the internal tape for the copy is resetted.

With this distinction of input, output, and internal tapes, we can formalise a convention for functional computation of binary functions: The tapes
$t[0]$ and $t[1]$ are the input tapes for $x$ and $y$, $t[2]$ is the output tape for $f~x~y$, and all other tapes are internal tapes.
\begin{definition}[Functional computation correctness relation][Computes2_Rel]
  \label{def:Computes2_Rel}
  Let $f : X \to Y \to Z$, where $X$ and $Y$ are encodable on $\Sigma$.  Then
  $FunRel(f) \subseteq \Tape_{\Sigma^+}^{3+n} \times \Tape_{\Sigma^+}^{3+n}$ is defined as:
  \begin{alignat*}{2}
     FunRel(f) &:= \lambda t~t'.~\forall (x:X)~(y:Y). \\
    &\qquad t[0] \simeq x \rightarrow t[1] \simeq y \rightarrow \\
    &\qquad isRight~t[2] \rightarrow \\
    &\qquad \left(\forall (i:\Fin_n).~isRight~t[3+i] \right) \rightarrow \\
    &\qquad t'[0] \simeq x ~\land~ t'[1] \simeq y ~\land~ \\
    &\qquad t'[2] \simeq f~x~y ~\land~ \\
    &\qquad \left(\forall (i:\Fin_n).~isRight~t'[3+i] \right).
  \end{alignat*}
  We say that a machine $M$ computes the function $f$, if $M \Realise FunRel~f$.
\end{definition}

Similarly, we can define the running time function of such a machine.
\begin{definition}[Functional computation running time relation][Computes2_T]
  \label{def:Computes2_T}
  Let $steps : X \to Y \to \Nat$ , where $X$ and $Y$ are encodable on $\Sigma$.  Then $FunT(steps) \subseteq \Tape_{\Sigma^+}^{3+n} \times \Nat$ is
  defined~as:
  \begin{alignat*}{2}
     FunT(steps) &:= \lambda t~k.~\exists (x:X)~(y:Y). \\
    &\qquad t[0] \simeq x ~\land~ t[1] \simeq y ~\land~ \\
    &\qquad isRight~t[2] ~\land~ \\
    &\qquad \left(\forall (i:\Fin_n).~isRight~t[3+i] \right) ~\land~ \\
    &\qquad steps~x~y \leq k
  \end{alignat*}
\end{definition}

Note that these definitions can be generalised to unary functions or functions with higher arity.

Internal tapes may be used to copy input-values on, if their value changes in the loop.  The general design for implementing a machine $M$ that
computes a binary function $f$, is the following:
\begin{align*}
  M := & \LiftTapes{\MS{CopyValue}}{\Vector{0; 3}} \Seq \LiftTapes{\MS{CopyValue}}{\Vector{1; 4}} \Seq \\
       & \LiftTapes{\MS{WriteValue}~\cdots}{\Vector{\cdots}} \Seq \\
       & \LiftTapes{\MS{Loop}}{\Vector{3; 4; 2; 5; 6; 7; \cdots}} \Seq \\
       & \LiftTapes{\MS{Reset}}{\Vector{3}} \Seq \LiftTapes{\MS{Reset}}{\Vector{4}} \Seq \LiftTapes{\MS{Reset}}{\Vector{5}} \Seq \cdots
\end{align*}
with $\MS{Loop} := \While(\MS{Step})$.  $\MS{Step}$ is labelled over $\Option(\Unit)$, where $\Some\unit$ means to break out of the loop and
$\None$ to continue.  Note that $\MS{Step}$ and $\MS{Loop}$ have only ``access'' to the copies of $x$ and $l$, but not to the ``original'' on $t[0]$
and $t[1]$ of $M$.  This also means that $\MS{Step}$ has two tapes less than $M$.  The copy of $x$ and $y$ is on the $0$st and $1$st tape of
$\MS{Step}$, the output is on tape $2$, all further tapes are internal tapes.  Before the loop, some tapes may be initialised with values (using
either $\MS{WriteValue}$, or constructors).  After the loop, all tapes that $\MS{Step}$ did not reset, including the tapes that contain the modified
copies of $x$ and $y$ and additional internal tapes, are resetted by $M$.

Before we can define the machine $M$, we first have to decide on which alphabet $M$ is defined.  If the machine operates on only one data type, then
we define $M$ over the smallest alphabet to encode this type on.  On the other hand, if $M$ operates on more alphabets, we use the technique from
Section~\ref{sec:extend-alphabet}.

For the verification of $M$, we first have to give the correctness relation of $\MS{Step}$.  It should encode the loop invariant as general as
possible.  Then we can define the correctness relation $LoopRel$ of $\MS{Loop}$ and prove $\MS{Loop} \Realise LoopRel$.  After that, we define running
time relations $StepT$ and $LoopT$, and show $\MS{Step} \TerminatesIn StepT$, and after that $\MS{Loop} \TerminatesIn LoopT$.  Finally, we prove
$M \Realise FunRel~f$ and $M \TerminatesIn FunT~steps$, where $f:X \to Y \to Z$ is the function that $M$ computes and $steps:X \to Y \to \Nat$ the
running time function.

\section{Case Studies}
\label{sec:case-studies}

This is the end of the framework for verified programming of Turing machines.  As a benchmark for it, and to test the above general design pattern for
function-computing machines, we implement a few machines that compute functions.\footnote{Note that we amend the design pattern a bit for convenience
  in Chapter~\ref{chap:heap}.}

\subsection{Addition}
\label{sec:Add}
\setCoqFilename{ProgrammingTuringMachines.TM.Code.NatTM}%

We want to implement the functions $add,mult:\Nat\to\Nat\to\Nat$, according to Definition~\ref{def:Computes2_Rel}.  First, we define the machine
$\MS{Add}$ that computes the addition function.  We reuse this machine to implement a machine $\MS{Mult}$ that computes the multiplication function.

The algorithm that our machine implements can be described with the following pseudocode:%
{ \small
\begin{lstlisting}[style=pseudocode]
a := n
b := m
While (b--) {
  a++
}
Reset b
\end{lstlisting}
}%
The output tape is the tape that is represented by the variable $a$.  First, we copy the input $n$ to this tape, and the number $m$ to an internal
tape.  In the loop, as long as we can decrease the copy of $m$, we increment $a$.  After the loop, we reset the copy $b$ and the machine terminates.
The first step in the design of the machine is to specify, which tape contains which variable.  This is visualised in Table~\ref{tab:tapes-Add}.

\begin{table}[h]
  \centering
  \begin{tabular}{l|l|l|l}
     Tape of $\MS{Add}$ & Variable & Role      & Tape in $\MS{AddStep}$ \\ \hline
     $0$                & $m$      & Input     & --                     \\
     $1$                & $n$      & Input     & --                     \\
     $2$                & $a$      & Output    & $0$                    \\
     $3$                & $b$      & Internal  & $1$                    \\
  \end{tabular}
  \caption{Tape assignment for $\MS{Add}$ and $\MS{AddStep}$}
  \label{tab:tapes-Add}
\end{table}

Because the machine only operates on natural numbers, we choose $\Sigma_\Nat^+$ as the alphabet of $\MS{Add}$ and all its sub-machines.

The next step is to implement the step machine.  $\MS{AddStep}$ has only access to the variables $a$ and $b$, that are stored on tape $0$ and $1$, as
also visualised in Table~\ref{tab:tapes-Add}.  The decrement operation and test whether $b$ was $0$ is implemented using the deconstructor machine
$\MS{CaseNat}$.  In the case that $b$ is $0$, the step machine terminates in $\Some\unit$, so that the loop brakes.  In case $b$ is greater than $0$,
$\MS{CaseNat}$ decreases $b$ and the step machine increases $a$.  Then it terminates in $\None$, so that the loop continues.
\begin{definition}[$\MS{AddStep}$][Add_Step]
  \label{def:Add_Step}
  \[
    \MS{AddStep} :=
    \If{(\LiftTapes{\MS{CaseNat}}{\Vector{1}})}{(\Return{(\LiftTapes{\MS{ConstrS}}{\Vector{0}})}{\None})}{(\Return{\Nop}{\Some\unit})}
  \]
\end{definition}

Because all parts of $\MS{AddStep}$ terminate in constant time, we get the constant running time part of the semantics of $\MS{AddStep}$ for free.
\begin{lemma}[Correctness of $\MS{AddStep}$][Add_Step_Sem]
  \label{lem:Add_Step_Sem}
  $\MS{AddStep} \RealiseIn{9} AddStepRel$ with
\begin{lstlisting}[style=semicoqstyle]
$AddStepRel$ :=
  $\lambda~t~(l, t').~ \forall (a~b:\Nat).$
    $t[0] \simeq a \rightarrow t[1] \simeq b \rightarrow$
    $\MS{match}~l, b$
    [$\Some\unit, O$=>$t'[0] \simeq a ~\land~ t'[1] \simeq b$
    |$\None, S~b'$=>$t'[0] \simeq S~a ~\land~ t'[1] \simeq b'$
    |_,_=>$\False$
    ].
\end{lstlisting}
\end{lemma}

According to the general design plan, we define $\MS{AddLoop} := \While~\MS{AddStep}$.  The correctness relation of $\MS{AddLoop}$ now says, that
after the execution of the loop, $t'[0]$ contains $a+b$ and $t'[1]$ contains $0$:
\begin{lemma}[Correctness of $\MS{AddLoop}$][Add_Loop_Realise]
  \label{lem:Add_Loop_Realise}
  $\MS{AddLoop} \Realise AddLoopRel$ with
  \[
    AddLoopRel := \lambda t~t'.~\forall (a~b:\Nat).~t[0] \simeq a \rightarrow t[1] \simeq b \rightarrow t'[0] \simeq a+b \land t'[1] \simeq 0.
  \]
\end{lemma}
\begin{proof}
  Using the $\While$-induction Lemma~\ref{lem:WhileInduction}.  In case the loop terminates, $b$ is $0$ and $t'[0] \simeq a$, therefore $t'[0]$
  contains $a=a+0=a+b$.  In the induction/loop case, we know that $b=S~b'$ and that $t'[0] \simeq S~a$ and $t'[1] \simeq b'$.  By the inductive
  hypothesis, we know that $t''[0]$ contains $b' + S~a = a+b$ and $t''[1] \simeq 0$.
\end{proof}

The running time of $\MS{AddLoop}$ must be shown separately.  We know that the loop is executed $b+1$ times, and each iteration takes $9$ steps.  We
have to add $1$ step for each re-iteration of the loop.  Thus, the total step number is $9+10 \cdot b$.
\begin{lemma}[Running time of $\MS{AddLoop}$][Add_Loop_Terminates]
  \label{lem:Add_Loop_TerminatesIn}
  $\MS{AddLoop} \downarrow AddLoopT$ with
  \[
    AddLoopT := \lambda t~k.~\exists (a~b:\Nat).~t[0] \simeq a \land t[1] \simeq b \land 9+10 \cdot b \leq k
  \]
\end{lemma}

Now we can define the full machine $\MS{Add}$:
\begin{definition}[$\MS{Add}$][Add]
  \label{def:Add}
  ~
  \[
    \MS{Add} :=
    \LiftTapes{\MS{CopyValue}}{\Vector{1;2}} \Seq
    \LiftTapes{\MS{CopyValue}}{\Vector{0;3}} \Seq
    \LiftTapes{\MS{AddLoop}}{\Vector{2;3}} \Seq
    \LiftTapes{\MS{Reset}}{\Vector{3}}.
  \]
\end{definition}

At this point, we introduce a graphical notation of \emph{execution protocols}, that show the value of each tape after the execution of each
sub-machine.  In the left column, we have the input values for each tape, or $\dashv$ if the tape is initially right.  Each further column denotes the
(lifted) sub-machines.  We write entries $j: x$ in each cell that is in the index-vector of the sub-machine, where $j$ is the tape-index of the lifted
machine and $x$ is the value after the execution of the sub-machine on this tape.  We write $j:~\dashv$ when the tape $j$ is right after the execution
of the sub-machine.  If a cell of the table is empty, the tape has not changed, then read further left in the same row.  In Table~\ref{tab:exec-Add},
we have an example of an execution protocol for $\MS{Add}$.

\begin{table}[h]
  \centering
  \begin{tabular}{l||l|l|l|l}
    Input       & $\MS{CopyValue}$ & $\MS{CopyValue}$ & $\MS{AddLoop}$ & $\MS{Reset}$ \\ \hline
    $0: m$      &                  & $0 : m$          &                &              \\
    $1: n$      & $0 : n$          &                  &                &              \\
    $2:~\dashv$ & $1 : n$          &                  & $0: m+n$       &              \\
    $3:~\dashv$ &                  & $1 : m$          & $1: 0$         & $0:~ \dashv$ \\
  \end{tabular}
  \caption{Execution protocol of $\MS{Add}$}
  \label{tab:exec-Add}
\end{table}

From the execution protocol in Table~\ref{tab:exec-Add}, we can see that after the execution of all four sub-machines, the tapes $0$ and $1$ still
contain the values $m$ and $n$, tape $2$ contains $m+n$, and tape $3$ is right.  Execution protocols serve as outlines of the formal correctness
proofs.  We conclude the correctness of $\MS{Add}$.
\begin{lemma}[Correctness of $\MS{Add}$][Add_Computes]
  \label{lem:Add_Computes}
  $\MS{Add} \Realise FunRel~add$.
\end{lemma}

For the running time function of $\MS{Add}$, we have to add linear components for copying $m$ and $n$, a constant for $\MS{Reset}$, and $1$ step for
each sequential composition operator.
\begin{lemma}[Running time of $\MS{Add}$][Add_Terminates]
  $\MS{Add} \downarrow FunT~stepsAdd$ with
  \[
    stepsAdd~m~n := 98 + 22 \cdot m + 12 \cdot n
  \]
\end{lemma}

\begin{table}[h]
  \centering
  \begin{tabular}{l|l|l}
    Sub-Machine & Running time & Accumulated running time \\ \hline
    $\LiftTapes{\MS{CopyValue}}{\Vector{1;2}}$  & $37 + 12 \cdot n$ & $98 + 22 \cdot m + 12 \cdot n$ \\
    $\LiftTapes{\MS{CopyValue}}{\Vector{0;3}}$  & $37 + 12 \cdot m$ & $60 + 22 \cdot m$ \\
    $\LiftTapes{\MS{AddLoop}}{\Vector{2;3}}$    & $9 + 10 \cdot m$  & $22 + 10 \cdot m$ \\
    $\LiftTapes{\MS{Reset}}{\Vector{3}}$        & $12$              & $12$ \\
  \end{tabular}
  \caption{Accumulated sub-running times of $\MS{Add}$}
  \label{tab:runningtime-Add}
\end{table}

When we prove the running time of sequences of multiple machines, we have to give running time functions for all suffixes of the sequence in terms of the
sequence operator.  We accumulate the running times from down to top and have to add one additional step for each sequence operator.  This is visualised in
Table~\ref{tab:runningtime-Add}.

\subsection{Multiplication}
\label{sec:Mult}

We use the machine $\MS{Add}$ to implement a machine $\MS{Mult}$ that computes the multiplication function $mult : \Nat\to\Nat\to\Nat$.  The machine
$\MS{Mult}$ ``calls'' the machine $\MS{Add}$ $m$-times to add $n$ to a counter $c$ that is initialised with $0$.  The following pseudo code presents
the algorithm that we implement: { \small
\begin{lstlisting}[style=pseudocode]
$c$  := $0$
$m'$ := $m$
While ($m'$--) {
  $c'$ := $\MS{Add}$($n$, $c$)
  Reset $c$
  $c$ := $c'$
  Reset $c'$
}
Reset $m'$
\end{lstlisting}
}%
Note that we do not have to copy $n$, since we do not write on $n$ and the machine $\MS{Add}$ does not change
$n$.  Also note that we can not simply add $n$ to $c$, since input and output tapes are distinct.  Therefore, we have to store the result of the
addition to an intermediate variable (i.e.\ internal tape), which has to be resetted afterwards.

\begin{table}[t]
  \centering
  \begin{tabular}{l|l|l|l|l}
    Tape of $\MS{Mult}$ & Variable & Role & Tape in $\MS{MultStep}$ & Tape in $\MS{Add}$ \\ \hline
    $0$ & $m$  & Input    & --  & --  \\
    $1$ & $n$  & Input    & $1$ & $0$ (input) \\
    $2$ & $c$  & Output   & $2$ & $1$ (input) \\
    $3$ & $c'$ & Internal & $3$ & $2$ (output) \\
    $4$ & --   & Internal & $4$ & $3$ (internal) \\
    $5$ & $m'$ & Internal & $0$ & --  \\
  \end{tabular}
  \caption{Tape assignment for $\MS{Mult}$}
  \label{tab:tapes-Mult}
\end{table}
\begin{table}[t]
  \centering
  \begin{tabular}{l||l|l|l|l|l}
    Input       & $\MS{CaseNat}$ & $\MS{Add}$  & $\MS{Reset}$ & $\MS{CopyValue}$ & $\MS{Reset}$   \\ \hline
    $0: m$      & $0 : m'$        &             &              &                  &                \\
    $1: n$      &                 & $0: n$      &              &                  &                \\
    $2: c$      &                 & $1: c$      & $0:~\dashv$  & $1: n+c$         &                \\
    $3:~\dashv$ &                 & $2: n+c$    &              & $0: n+c$         & $0:~\dashv$    \\
    $4:~\dashv$ &                 & $3:~\dashv$ &              &                  &                \\
  \end{tabular}
  \caption{Execution protocol of $\MS{MultStep}$ for $m=S~m'$}
  \label{tab:exec-MultStep}
\end{table}

The tape-assignment is visualised in Table~\ref{tab:tapes-Mult}.  The step machine, $\MS{MultStep}$, has only access to the copy of $m$, which is
mapped to tape $0$ of $\MS{MultStep}$.  In the following, we use also use the name $m$ for its copy in the context of $\MS{MultStep}$.
\begin{definition}[$\MS{MultStep}$][Mult_Step]
  \label{def:Mult_Step}
  \begin{alignat*}{2}
    &\MS{MultStep} &~:=~&
           \MS{If}~\LiftTapes{\MS{CaseNat}}{\Vector{0}} \\
    &&& \MS{Then}  ~\Return{\left( \LiftTapes{\MS{Add}}{\Vector{1;2;3;4}} \Seq
                                \LiftTapes{\MS{Reset}}{\Vector{2}} \Seq
                                \LiftTapes{\MS{CopyValue}}{\Vector{3;2}} \Seq
                                \LiftTapes{\MS{Reset}}{\Vector{3}} \right)}{\None} \\
    &&& \MS{Else}~~~\Return{\MS{Nop}}{\Some\unit}.
  \end{alignat*}
\end{definition}
An execution protocol of $\MS{MultStep}$ for the case $m=S~m'$ (where $m$ is the copy) is shown in Table~\ref{tab:exec-MultStep}.  The correctness
relation of $\MS{MultStep}$ is analogous to $\MS{AddStep}$.
\begin{lemma}[Correctness of $\MS{MultStep}$][Mult_Step_Realise]
  \label{lem:Mult_Step_Sem}
  $\MS{MultStep} \RealiseIn{9} MultStepRel$ with
  \small
\begin{lstlisting}[style=semicoqstyle]
$MultStepRel$ :=
  $\lambda~t~(l, t').~ \forall (c~m~n:\Nat).$
    $t[0] \simeq m \rightarrow t[1] \simeq n \rightarrow t[2] \simeq c \rightarrow isRight~t[3] \rightarrow isRight~t[4] \rightarrow$
    $\MS{match}~l, m$
    [$\Some\unit, O \Rightarrow t'[0] \simeq 0 ~\land~ t'[1] \simeq n ~\land~ t'[2] \simeq c ~\land~ isRight~t'[3] ~\land~ isRight~t'[4]$
    |$\None, S~m' \Rightarrow t'[0] \simeq m' ~\land~ t'[1] \simeq n ~\land~ t'[2] \simeq n+c ~\land~ isRight~t'[3] ~\land~ isRight~t'[4]$
    |_,_ => $\False$
    ].
\end{lstlisting}
\end{lemma}
Note that in the correctness Lemma~\ref{lem:Add_Step_Sem} of $\MS{AddStep}$, we also prove termination in constant running time.  This is not true for
$\MS{MultStep}$, because it calls $\MS{Add}$, which has not constant running time.

As usual, we define $\MS{MultLoop} := \While~\MS{MultStep}$.  The correctness statement of $\MS{MultLoop}$ says that if the first three tapes contain
$m$, $n$, $c$, and all other tapes are right, then after the execution of the loop, the tapes contain $0$, $n$, and $m \cdot n + c$ and the other
tapes are right.  Thus, when we instantiate the $c$-tape with the value $0$, the output tape contains $m \cdot n$.

\enlargethispage{0.5cm}

\begin{lemma}[Correctness of $\MS{MultLoop}$][Mult_Loop_Realise]
  \label{lem:Mult_Loop_Realise}
  $\MS{MultLoop} \Realise MultLoopRel$ with
  \begin{alignat*}{2}
    & MultLoopRel ~&:=& \lambda t~t'.~\forall (c~m~n:\Nat). \\
    &&& t[0] \simeq m \rightarrow t[1] \simeq \rightarrow t[2] \simeq c \rightarrow isRigth~t[3] \rightarrow isRight~t[4] \rightarrow \\
    &&& t'[0] \simeq 0 \land t'[1] \simeq n \land t'[2] \simeq m \cdot n + c \land isRight~t'[3] \land isRight~t'[4]
  \end{alignat*}
\end{lemma}

It is now easy to define the rest of $\MS{Mult}$.
\begin{definition}[$\MS{Mult}$][Mult]
  \label{def:Mult}
  \[
    \MS{Mult} :=
    \LiftTapes{\MS{CopyValue}}{\Vector{0;5}} \Seq
    \LiftTapes{\MS{ConstrO}}{\Vector{2}} \Seq
    \LiftTapes{\MS{MultLoop}}{5;1;2;3;4} \Seq
    \LiftTapes{\MS{Reset}}{\Vector{5}}
  \]
\end{definition}

It follows that $\MS{Mult}$ computes the function $mult$, w.r.t.\ Definition~\ref{def:Computes2_Rel}.
\begin{lemma}[Correctness of $\MS{Mult}$][Mult_Computes]
  \label{lem:Mult_Computes}
  $\MS{Mult} \Realise FunRel~mult$.
\end{lemma}

For brevity,  we omit the concrete running time function here.
\begin{lemma}[Running time of $\MS{Mult}$][Mult_Terminates]
  There is a function $multSteps : \Nat\to\Nat\to\Nat$, such that $multSteps \in \mathcal{O}(m \cdot n^2)$ and
  $\MS{Mult} \TerminatesIn FunT~multSteps$.
\end{lemma}

\subsection{Mapping of Sum Functions}
\label{sec:SumTM}
\setCoqFilename{ProgrammingTuringMachines.TM.Code.SumTM}%

Let $f : X \to Z$ and $g : Y \to Z$.  Then we can define the canonical function $(f+g) : X+Y \to Z$ by $(f+g)(\inl x):=f(x)$ and
$(f+g)(\inr l):=g(l)$.  We want to define an operator that takes machines $M_1, M_2$ that compute the unary functions $f$ and $g$, and yields a
machine $\MS{MapSum}$ that computes the function $(f+g)$.

First we have to define precisely, which machine has which alphabet.  Let $X, Y$ be encodable over $\Sigma_X, \Sigma_Y$.  We assume
$M_1, M_2 : \TM_{\Sigma_M^+}^{2+n}$, i.e.\ both machines have the same alphabet, and they have at least two tapes (i.e.\ an input and output tape).
We assume that $\Sigma_M$ includes $\Sigma_X$, $\Sigma_Y$, and $\Sigma_Z$.  Formally, this means that we assume retractions $f_X,f_Y,f_Z$ between
$\Sigma_X, \Sigma_Y, \Sigma_Z$ and $\Sigma_M$.  Let $\Sigma$ be the alphabet for $\MS{MapSum}$, with a retraction
$f_M : \Sigma_M \hookrightarrow \Sigma$.  Furthermore, it should be possible to encode $X+Y$ on $\Sigma$, so we assume a retraction
$f_{X+Y} : \Sigma_{X+Y} \hookrightarrow \Sigma$.  We notice that there are now two possibilities how to encode $X$ (and dually $Y$) on $\Sigma$: via
the retractions $f_M \circ f_X$ and $f_{X+Y} \circ RetrInl$, see Figure~\ref{fig:retracts-MapSum}.  These retractions might be extensionally equal for
concrete choices of alphabets, but we want to be as general as possible.  As a consequence, we need to translate between these representations, using
$\MS{Translate}$ of Section~\ref{sec:Translate}.  Note that there is only one way to encode $Z$ on $\Sigma$, namely via $f_M \circ f_Z $.

The machine $\MS{MapSum}$ first makes a case-distinction on the value $s:X+Y$ on the input tape $0$.  If it is $x$ (on the alphabet $\Sigma_{X+Y}$),
it is translated to the alphabet of $M_1$.  Then we execute the alphabet-lifted machine $M_1$.  This writes the output $f_1(x)$ on the output tape $1$
and leaves $x$ unchanged.  After that, $\MS{MapSum}$ translates $x$ back to the alphabet $\Sigma_{X+Y}$ and applies the constructor $\inl$, so the
input tape contains $\inl x$ again.  The case when the input was $s=\inl y$ is symmetric.

\begin{definition}[$\MS{MapSum}$][MapSum]
  \label{def:MapSum}
  ~
  \begin{align*}
    & \MS{MapSum}~:= \\
    &\quad \MS{If}~{\LiftBoth{\MS{CaseSum}}{f_{X+Y}}{\Vector{0}}} \\
    &\quad \MS{Then}~ \LiftTapes{(\MS{Translate}~(f_{X+Y} \circ RetrInl)~(f_M \circ f_X))}{\Vector{0}} \Seq \\
    &\quad \phantom{\MS{Then}}~ \LiftAlphabet{M_1}{f_M} \Seq \\
    &\quad \phantom{\MS{Then}}~ \LiftTapes{(\MS{Translate}~(f_M \circ f_X)~(f_{X+Y} \circ RetrInl))}{\Vector{0}} \Seq \\
    &\quad \phantom{\MS{Then}}~ \LiftBoth{\MS{ConstrInl}}{f_{X+Y}}{\Vector{0}} \\
    &\quad \MS{Else}~~~ \LiftTapes{(\MS{Translate}~(f_{X+Y} \circ RetrInr)~(f_M \circ f_Y))}{\Vector{0}} \Seq \\
    &\quad \phantom{\MS{Then}}~ \LiftAlphabet{M_2}{f_M} \Seq \\
    &\quad \phantom{\MS{Then}}~ \LiftTapes{(\MS{Translate}~(f_M \circ f_Y)~(f_{X+Y} \circ RetrInr))}{\Vector{0}} \Seq \\
    &\quad \phantom{\MS{Then}}~ \LiftBoth{\MS{ConstrInr}}{f_{X+Y}}{\Vector{0}}
  \end{align*}
\end{definition}

\begin{lemma}[Correctness of $\MS{MapSum}$][MapSum_Computes]
  \label{lem:MapSum_Computes}
  If $M_1 \Realise FunRel(f_1)$ and $M_2 \Realise FunRel(f_2)$, then $\MS{MapSum} \Realise FunRel(f_1+f_2)$.
\end{lemma}

\begin{figure}
  \center
  \begin{tikzcd}
    \Sigma_X \arrow[r, "f_X", hook] \arrow[d, "RetrInl", hook, swap] & \Sigma_M \arrow[r, "f_M", hook] & \Sigma \\
    \Sigma_{X+Y} \arrow[urr, "f_{X+Y}", hook, swap]
  \end{tikzcd}
  \caption{Non-commutative diagram of the retractions involved in the definition of $\MS{MapSum}$}
  \label{fig:retracts-MapSum}
  \begin{tikzcd}
    & \Sigma_{\List(X)} \arrow[dr, "f_{\List(X)}", hook] & \\
    \Sigma_X \arrow[ur, "RetrList", hook] \arrow[dr, "RetrOpt", hook, swap] & & \Sigma \\
    & \Sigma_{\Option(X)} \arrow[ur, "f_{\Option(X)}", hook] & \Sigma_\Nat \arrow[u, "f_\Nat", hook, swap]
  \end{tikzcd}
  \caption{Retractions involved in the definition of $\MS{Nth}$}
  \label{fig:retracts-Nth}
\end{figure}

\subsection{List Access}
\label{sec:Nth}
\setCoqFilename{ProgrammingTuringMachines.TM.Code.ListTM}%

In this section, we show how to implement machines that compute the function $nth : \List(X) \to \Nat \to \Option(X)$.

Let $X$ be encodable on $\Sigma_X$.  We implement a machine $\MS{Nth} : \TM_{\Sigma^+}^4$ that computes the function
$nth : \List(X) \to \Nat \to \Option(X)$.  We assume retractions $f_{\List(X)} : \Sigma_{\List(X)} \hookrightarrow \Sigma$,
$f_{\Option(X)} : \Sigma_{\Option(X)} \hookrightarrow \Sigma$, and $f_\Nat : \Sigma_\Nat \hookrightarrow \Sigma$.  Now there are two ways to encode
$X$ on $\Sigma$: via $f_{\Option(X)} \circ RetrOpt$ and $f_{\List(X)} \circ RetrList$, see Figure~\ref{fig:retracts-Nth}.

The tape assignment is visualised in Table~\ref{tab:tapes-Nth}.

\begin{table}[!htb]
  \centering
  \begin{tabular}{l|l|l|l}
    Tape of $\MS{Nth}$ & Variable & Role & Tape in $\MS{NthStep}$ \\ \hline
    $0$ & $xs$         & Input    & --  \\
    $1$ & $n$          & Input    & --  \\
    $2$ & $x$          & Output   & $2$ \\
    $2$ & $xs$ (copy)  & Internal & $0$ \\
    $3$ & $n$ (copy)   & Internal & $1$ \\
  \end{tabular}
  \caption{Tape assignment for $\MS{Nth}$ and $\MS{NthStep}$}
  \label{tab:tapes-Nth}
\end{table}

The step machine first destructs~$n$.  If it was~$0$ and the list is empty, it writes~$\None$ to the output tape.  Else, it applies the $\Some{\cdot}$
constructor to the head.  Note that before we can apply the constructor,~$x$ has to be translated to the $\Sigma_{\Option(X)}$ alphabet.  In case~$n$
was non-zero, if the list is empty, the machine applies the~$\None$ constructor to the output tape.  Else, it deletes the head (which was temporary
stored on the output tape) and continues the loop.

\begin{definition}[$\MS{NthStep}$][Nth_Step]
  \label{def:Nth_Step}
  ~
  \begin{align*}
    & \MS{MapSum}~:= \\
    &\quad \MS{If}~\LiftBoth{\MS{CaseNat}}{f_\Nat}{\Vector{1}} \\
    &\quad \MS{Then}~ \MS{If}~\LiftBoth{\MS{CaseList}}{f_{\List(X)}}{\Vector{0;2}} \\
    &\quad \phantom{\MS{Then}}~\MS{Then}~   \Return{(\LiftTapes{\MS{Reset}}{\Vector{2}})}{\None} \\
    &\quad \phantom{\MS{Then}}~\MS{Else}~~~ \Return{(\LiftBoth{\MS{ConstrNone}}{f_{\Option(X)}}{\Vector{2}})}{\Some\unit} \\
    &\quad \MS{Else}~~~ \MS{If}~\LiftBoth{\MS{CaseList}}{f_{\List(X)}}{\Vector{0;2}} \\
    &\quad \phantom{\MS{Then}}~\MS{Then}~   \Return{(\LiftTapes{(\MS{Translate}~(f_{\List(X)} \circ RetrList)~(f_{\Option(X)} \circ RetrOpt) \Seq \\
    &\quad \phantom{\phantom{\MS{Then}}~\MS{Then}~\MS{Return}}\quad\quad~~ \LiftAlphabet{\MS{ContrSome}}{f_{\Option(X)}})}{\Vector{2}})}{\Some\unit} \\
    &\quad \phantom{\MS{Then}}~\MS{Else}~~~ \Return{(\LiftBoth{\MS{ConstrNone}}{f_{\Option(X)}}{\Vector{2}})}{\Some\unit}
  \end{align*}
\end{definition}

The correctness relation of $\MS{NthStep}$ has to capture all four cases.

\begin{lemma}[Correctness of $\MS{NthStep}$][Nth_Step_Realise]
  \label{lem:Nth_Step_Realise}
  $\MS{NthStep} \Realise NthStepRel$ with
  \small
\begin{lstlisting}[style=semicoqstyle]
$NthStepRel :=$
  $\lambda t~(l, t').$
    $\forall (xs : \List(X))~(n : \Nat).$
      $t[0] \simeq xs \rightarrow t[1] \simeq n \rightarrow isRight~t[2]$ ->
      $\MS{match}~l, n, xs$
      [$\None, S~n', x \cons xs' \Rightarrow t'[0] \simeq xs' \land t'[1] \simeq n' ~\land~ isRight~t'[2]$
      |$\Some\unit, S~n', \nil \Rightarrow t'[0] \simeq l~ \land t'[1] \simeq n' \land t'[2] \simeq \None$
      |$\Some\unit, 0, x \cons xs' \Rightarrow t'[0] \simeq xs' \land t'[1] \simeq 0 \land t'[2] \simeq \Some x$
      |$\Some\unit, 0, \nil \Rightarrow t'[0] \simeq l \land t'[1] \simeq n \land t'[2] \simeq \None$
      |_,_,_=>$\False$
      ].
\end{lstlisting}
\end{lemma}

Now, we can prove the correctness of the loop, $\MS{NthLoop} := \While~\MS{NthStep}$.  When the loop terminates, the value of the variable $n$ is
$n - (S~\length{xs})$ and the new value of $xs$ is $skipn~(S~n)~xs$, where $skipn : \Nat \to \List(X) \to \List(X)$ applies $\tl$ $n$-times.  Note
that if $n < \length{xs}$, the new value of $n$ will be $0$ and the machine returns a $\Some\cdot$ value.

\begin{lemma}[Correctness of $\MS{NthLoop}$][Nth_Loop_Realise]
  \label{lem:Nth_Loop_Realise}
  $\MS{NthLoop} \Realise NthLoopRel$ with
  \begin{alignat*}{2}
    & NthLoopRel &~:=~& \lambda t~t'.~\forall (xs:\List(X))~(n:\Nat).~t[0] \simeq xs \rightarrow t[1] \simeq n \rightarrow isRight~t[2] \rightarrow \\
    &            &~  ~& \phantom{\lambda t~t'.}~t'[0] \simeq skipn~(S~n)~l \land t'[1] \simeq n-(1+\length{xs}) \land t'[2] \simeq nth~xs~n.
  \end{alignat*}
\end{lemma}

The full machine $\MS{Nth}$ makes copies of $n$ and $xs$ and runs $\MS{NthLoop}$ on the copies.  After that, it resets the internal tapes $2$ and $3$
with the copies of $n$ and $xs$.  Note that for the correctness of $\MS{Reset}$ it is only important that there is a value on the tape.  Only the
running time (which we omit here) does depend on the actual value.
\begin{definition}[$\MS{Nth}$][Nth]
  \[
    \MS{Nth} := \LiftTapes{\MS{CopyValue}}{\Vector{0;3}} \Seq
    \LiftTapes{\MS{CopyValue}}{\Vector{1;4}} \Seq
    \LiftTapes{\MS{NthLoop}}{\Vector{3;4;2}} \Seq
    \LiftTapes{\MS{Reset}}{\Vector{3}} \Seq
    \LiftTapes{\MS{Reset}}{\Vector{4}}
  \]
\end{definition}
Note that we copy and reset values of different types.  We have to insert this semantic information in correctness proofs when we apply the respective
correctness lemmas of $\MS{Copy}$ and $\MS{Reset}$ in the relation-derivation phase of correctness proofs.

It follows that $\MS{Nth}$ computes the function $nth$.
\begin{lemma}[Correctness of $\MS{Nth}$][Nth_Computes]
  \label{lem:Nth_Computes}
  $\MS{Nth} \Realise FunRel~nth$.
\end{lemma}

% % This is not proven in Coq
% For brevity, we omit the concrete running time function.
% \begin{lemma}[Running time of $\MS{Nth}$][Nth_Terminates]
%   \label{lem:Nth_TerminatesIn}
%   There is a function $NthSteps:\List(X)\to\Nat\to\Nat$, such that $NthSteps \in \mathcal{O}(\size{ls})$ and $\MS{Nth} \TerminatesIn NthSteps$.
% \end{lemma}

%%% Local Variables:
%%% TeX-master: "thesis"
%%% End: