thys/UTM.thy
author Christian Urban <christian dot urban at kcl dot ac dot uk>
Sun, 10 Feb 2013 19:49:07 +0000
changeset 163 67063c5365e1
parent 145 38d8e0e37b7d
child 166 99a180fd4194
permissions -rwxr-xr-x
changed theory names to uppercase
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     1
theory UTM
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
     2
imports Recursive Abacus UF GCD Turing_Hoare
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     3
begin
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     4
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     5
section {* Wang coding of input arguments *}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     6
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     7
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     8
  The direct compilation of the universal function @{text "rec_F"} can not give us UTM, because @{text "rec_F"} is of arity 2,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     9
  where the first argument represents the Godel coding of the TM being simulated and the second argument represents the right number (in Wang's coding) of the TM tape. 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    10
  (Notice, left number is always @{text "0"} at the very beginning). However, UTM needs to simulate the execution of any TM which may
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    11
  very well take many input arguments. Therefore, a initialization TM needs to run before the TM compiled from @{text "rec_F"}, and the sequential 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    12
  composition of these two TMs will give rise to the UTM we are seeking. The purpose of this initialization TM is to transform the multiple 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    13
  input arguments of the TM being simulated into Wang's coding, so that it can be consumed by the TM compiled from @{text "rec_F"} as the second
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    14
  argument. 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    15
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    16
  However, this initialization TM (named @{text "t_wcode"}) can not be constructed by compiling from any resurve function, because every recursive 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    17
  function takes a fixed number of input arguments, while @{text "t_wcode"} needs to take varying number of arguments and tranform them into 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    18
  Wang's coding. Therefore, this section give a direct construction of @{text "t_wcode"} with just some parts being obtained from recursive functions.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    19
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    20
\newlength{\basewidth}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    21
\settowidth{\basewidth}{xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    22
\newlength{\baseheight}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    23
\settoheight{\baseheight}{$B:R$}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    24
\newcommand{\vsep}{5\baseheight}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    25
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    26
The TM used to generate the Wang's code of input arguments is divided into three TMs
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
    27
 executed sequentially, namely $prepare$, $mainwork$ and $adjust$\<exclamdown>\<pounds>According to the
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    28
 convention, start state of ever TM is fixed to state $1$ while the final state is
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    29
 fixed to $0$.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    30
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    31
The input and output of $prepare$ are illustrated respectively by Figure
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    32
\ref{prepare_input} and \ref{prepare_output}.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    33
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    34
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    35
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    36
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    37
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    38
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    39
  [tbox/.style = {draw, thick, inner sep = 5pt}]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    40
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    41
  \node (1) [tbox, text height = 3.5pt, right = -0.9pt of 0] {\wuhao $m$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    42
  \node (2) [tbox, right = -0.9pt of 1] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    43
  \node (3) [tbox, right = -0.9pt of 2] {\wuhao $a_1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    44
  \node (4) [tbox, right = -0.9pt of 3] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    45
  \node (5) [tbox, right = -0.9pt of 4] {\wuhao $a_2$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    46
  \node (6) [right = -0.9pt of 5] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    47
  \node (7) [tbox, right = -0.9pt of 6] {\wuhao $a_n$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    48
  \draw [->, >=latex, thick] (1)+(0, -4\baseheight) -- (1);
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    49
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    50
\caption{The input of TM $prepare$} \label{prepare_input}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    51
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    52
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    53
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    54
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    55
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    56
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    57
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    58
  \node (1) [draw, text height = 3.5pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    59
  \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    60
  \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    61
  \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $a_1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    62
  \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    63
  \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {\wuhao $a_2$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    64
  \node (7) [right = -0.9pt of 6] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    65
  \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $a_n$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    66
  \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    67
  \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    68
  \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {\wuhao $1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    69
  \draw [->, >=latex, thick] (10)+(0, -4\baseheight) -- (10);
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    70
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    71
\caption{The output of TM $prepare$} \label{prepare_output}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    72
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    73
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    74
As shown in Figure \ref{prepare_input}, the input of $prepare$ is the same as the the input
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    75
of UTM, where $m$ is the Godel coding of the TM being interpreted and $a_1$ through $a_n$ are the $n$ input arguments of the TM under interpretation. The purpose of $purpose$ is to transform this initial tape layout to the one shown in Figure \ref{prepare_output},
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    76
which is convenient for the generation of Wang's codding of $a_1, \ldots, a_n$. The coding procedure starts from $a_n$ and ends after $a_1$ is encoded. The coding result is stored in an accumulator at the end of the tape (initially represented by the $1$ two blanks right to $a_n$ in Figure \ref{prepare_output}). In Figure \ref{prepare_output}, arguments $a_1, \ldots, a_n$ are separated by two blanks on both ends with the rest so that movement conditions can be implemented conveniently in subsequent TMs, because, by convention,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    77
two consecutive blanks are usually used to signal the end or start of a large chunk of data. The diagram of $prepare$ is given in Figure \ref{prepare_diag}.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    78
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    79
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    80
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    81
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    82
\scalebox{0.9}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    83
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    84
     \node[circle,draw] (1) {$1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    85
     \node[circle,draw] (2) at ($(1)+(0.3\basewidth, 0)$) {$2$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    86
     \node[circle,draw] (3) at ($(2)+(0.3\basewidth, 0)$) {$3$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    87
     \node[circle,draw] (4) at ($(3)+(0.3\basewidth, 0)$) {$4$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    88
     \node[circle,draw] (5) at ($(4)+(0.3\basewidth, 0)$) {$5$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    89
     \node[circle,draw] (6) at ($(5)+(0.3\basewidth, 0)$) {$6$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    90
     \node[circle,draw] (7) at ($(6)+(0.3\basewidth, 0)$) {$7$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    91
     \node[circle,draw] (8) at ($(7)+(0.3\basewidth, 0)$) {$0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    92
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    93
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    94
     \draw [->, >=latex] (1) edge [loop above] node[above] {$S_1:L$} (1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    95
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    96
     \draw [->, >=latex] (1) -- node[above] {$S_0:S_1$} (2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    97
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    98
     \draw [->, >=latex] (2) edge [loop above] node[above] {$S_1:R$} (2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    99
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   100
     \draw [->, >=latex] (2) -- node[above] {$S_0:L$} (3)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   101
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   102
     \draw [->, >=latex] (3) edge[loop above] node[above] {$S_1:S_0$} (3)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   103
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   104
     \draw [->, >=latex] (3) -- node[above] {$S_0:R$} (4)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   105
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   106
     \draw [->, >=latex] (4) edge[loop above] node[above] {$S_0:R$} (4)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   107
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   108
     \draw [->, >=latex] (4) -- node[above] {$S_0:R$} (5)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   109
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   110
     \draw [->, >=latex] (5) edge[loop above] node[above] {$S_1:R$} (5)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   111
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   112
     \draw [->, >=latex] (5) -- node[above] {$S_0:R$} (6)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   113
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   114
     \draw [->, >=latex] (6) edge[bend left = 50] node[below] {$S_1:R$} (5)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   115
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   116
     \draw [->, >=latex] (6) -- node[above] {$S_0:R$} (7)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   117
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   118
     \draw [->, >=latex] (7) edge[loop above] node[above] {$S_0:S_1$} (7)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   119
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   120
     \draw [->, >=latex] (7) -- node[above] {$S_1:L$} (8)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   121
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   122
 \end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   123
\caption{The diagram of TM $prepare$} \label{prepare_diag}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   124
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   125
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   126
The purpose of TM $mainwork$ is to compute the Wang's encoding of $a_1, \ldots, a_n$. Every bit of $a_1, \ldots, a_n$, including the separating bits, is processed from left to right.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   127
In order to detect the termination condition when the left most bit of $a_1$ is reached,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   128
TM $mainwork$ needs to look ahead and consider three different situations at the start of
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   129
every iteration:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   130
\begin{enumerate}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   131
    \item The TM configuration for the first situation is shown in Figure \ref{mainwork_case_one_input},
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   132
        where the accumulator is stored in $r$, both of the next two bits
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   133
        to be encoded are $1$. The configuration at the end of the iteration
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   134
        is shown in Figure \ref{mainwork_case_one_output}, where the first 1-bit has been
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   135
        encoded and cleared. Notice that the accumulator has been changed to
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   136
        $(r+1) \times 2$ to reflect the encoded bit.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   137
    \item The TM configuration for the second situation is shown in Figure
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   138
        \ref{mainwork_case_two_input},
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   139
        where the accumulator is stored in $r$, the next two bits
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   140
        to be encoded are $1$ and $0$. After the first
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   141
        $1$-bit was encoded and cleared, the second $0$-bit is difficult to detect
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   142
        and process. To solve this problem, these two consecutive bits are
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   143
        encoded in one iteration.  In this situation, only the first $1$-bit needs
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   144
        to be cleared since the second one is cleared by definition.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   145
        The configuration at the end of the iteration
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   146
        is shown in Figure \ref{mainwork_case_two_output}.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   147
        Notice that the accumulator has been changed to
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   148
        $(r+1) \times 4$ to reflect the two encoded bits.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   149
    \item The third situation corresponds to the case when the last bit of $a_1$ is reached.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   150
        The TM configurations at the start and end of the iteration are shown in
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   151
        Figure \ref{mainwork_case_three_input} and \ref{mainwork_case_three_output}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   152
        respectively. For this situation, only the read write head needs to be moved to
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   153
        the left to prepare a initial configuration for TM $adjust$ to start with.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   154
\end{enumerate}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   155
The diagram of $mainwork$ is given in Figure \ref{mainwork_diag}. The two rectangular nodes
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   156
labeled with $2 \times x$ and $4 \times x$ are two TMs compiling from recursive functions
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   157
so that we do not have to design and verify two quite complicated TMs.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   158
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   159
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   160
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   161
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   162
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   163
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   164
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   165
  \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   166
  \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   167
  \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   168
  \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $a_1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   169
  \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   170
  \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {\wuhao $a_2$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   171
  \node (7) [right = -0.9pt of 6] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   172
  \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $a_i$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   173
  \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {\wuhao $1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   174
  \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {\wuhao $1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   175
  \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   176
  \node (12) [right = -0.9pt of 11] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   177
  \node (13) [draw, right = -0.9pt of 12, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   178
  \node (14) [draw, text height = 3.9pt, right = -0.9pt of 13, thick, inner sep = 5pt] {\wuhao $r$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   179
  \draw [->, >=latex, thick] (13)+(0, -4\baseheight) -- (13);
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   180
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   181
\caption{The first situation for TM $mainwork$ to consider} \label{mainwork_case_one_input}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   182
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   183
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   184
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   185
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   186
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   187
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   188
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   189
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   190
  \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   191
  \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   192
  \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   193
  \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $a_1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   194
  \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   195
  \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {\wuhao $a_2$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   196
  \node (7) [right = -0.9pt of 6] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   197
  \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $a_i$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   198
  \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {\wuhao $1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   199
  \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   200
  \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   201
  \node (12) [right = -0.9pt of 11] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   202
  \node (13) [draw, right = -0.9pt of 12, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   203
  \node (14) [draw, text height = 2.7pt, right = -0.9pt of 13, thick, inner sep = 5pt] {\wuhao $(r+1) \times 2$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   204
  \draw [->, >=latex, thick] (13)+(0, -4\baseheight) -- (13);
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   205
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   206
\caption{The output for the first case of TM $mainwork$'s processing}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   207
\label{mainwork_case_one_output}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   208
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   209
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   210
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   211
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   212
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   213
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   214
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   215
  \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   216
  \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   217
  \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   218
  \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $a_1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   219
  \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   220
  \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {\wuhao $a_2$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   221
  \node (7) [right = -0.9pt of 6] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   222
  \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $a_i$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   223
  \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {\wuhao $1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   224
  \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   225
  \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {\wuhao $1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   226
  \node (12) [draw, right = -0.9pt of 11, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   227
  \node (13) [right = -0.9pt of 12] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   228
  \node (14) [draw, right = -0.9pt of 13, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   229
  \node (15) [draw, text height = 3.9pt, right = -0.9pt of 14, thick, inner sep = 5pt] {\wuhao $r$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   230
  \draw [->, >=latex, thick] (14)+(0, -4\baseheight) -- (14);
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   231
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   232
\caption{The second situation for TM $mainwork$ to consider} \label{mainwork_case_two_input}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   233
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   234
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   235
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   236
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   237
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   238
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   239
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   240
  \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   241
  \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   242
  \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   243
  \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $a_1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   244
  \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   245
  \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {\wuhao $a_2$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   246
  \node (7) [right = -0.9pt of 6] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   247
  \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $a_i$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   248
  \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {\wuhao $1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   249
  \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   250
  \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   251
  \node (12) [draw, right = -0.9pt of 11, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   252
  \node (13) [right = -0.9pt of 12] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   253
  \node (14) [draw, right = -0.9pt of 13, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   254
  \node (15) [draw, text height = 2.7pt, right = -0.9pt of 14, thick, inner sep = 5pt] {\wuhao $(r+1) \times 4$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   255
  \draw [->, >=latex, thick] (14)+(0, -4\baseheight) -- (14);
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   256
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   257
\caption{The output for the second case of TM $mainwork$'s processing}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   258
\label{mainwork_case_two_output}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   259
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   260
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   261
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   262
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   263
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   264
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   265
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   266
  \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   267
  \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   268
  \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   269
  \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   270
  \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   271
  \node (6) [right = -0.9pt of 5] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   272
  \node (7) [draw, right = -0.9pt of 6, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   273
  \node (8) [draw, text height = 3.9pt, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $r$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   274
  \draw [->, >=latex, thick] (7)+(0, -4\baseheight) -- (7);
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   275
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   276
\caption{The third situation for TM $mainwork$ to consider} \label{mainwork_case_three_input}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   277
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   278
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   279
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   280
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   281
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   282
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   283
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   284
  \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   285
  \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   286
  \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   287
  \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   288
  \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   289
  \node (6) [right = -0.9pt of 5] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   290
  \node (7) [draw, right = -0.9pt of 6, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   291
  \node (8) [draw, text height = 3.9pt, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $r$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   292
  \draw [->, >=latex, thick] (3)+(0, -4\baseheight) -- (3);
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   293
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   294
\caption{The output for the third case of TM $mainwork$'s processing}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   295
\label{mainwork_case_three_output}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   296
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   297
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   298
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   299
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   300
\scalebox{0.9}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   301
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   302
     \node[circle,draw] (1) {$1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   303
     \node[circle,draw] (2) at ($(1)+(0.3\basewidth, 0)$) {$2$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   304
     \node[circle,draw] (3) at ($(2)+(0.3\basewidth, 0)$) {$3$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   305
     \node[circle,draw] (4) at ($(3)+(0.3\basewidth, 0)$) {$4$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   306
     \node[circle,draw] (5) at ($(4)+(0.3\basewidth, 0)$) {$5$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   307
     \node[circle,draw] (6) at ($(5)+(0.3\basewidth, 0)$) {$6$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   308
     \node[circle,draw] (7) at ($(2)+(0, -7\baseheight)$) {$7$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   309
     \node[circle,draw] (8) at ($(7)+(0, -7\baseheight)$) {$8$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   310
     \node[circle,draw] (9) at ($(8)+(0.3\basewidth, 0)$) {$9$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   311
     \node[circle,draw] (10) at ($(9)+(0.3\basewidth, 0)$) {$10$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   312
     \node[circle,draw] (11) at ($(10)+(0.3\basewidth, 0)$) {$11$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   313
     \node[circle,draw] (12) at ($(11)+(0.3\basewidth, 0)$) {$12$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   314
     \node[draw] (13) at ($(6)+(0.3\basewidth, 0)$) {$2 \times x$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   315
     \node[circle,draw] (14) at ($(13)+(0.3\basewidth, 0)$) {$j_1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   316
     \node[draw] (15) at ($(12)+(0.3\basewidth, 0)$) {$4 \times x$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   317
     \node[draw] (16) at ($(15)+(0.3\basewidth, 0)$) {$j_2$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   318
     \node[draw] (17) at ($(7)+(0.3\basewidth, 0)$) {$0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   319
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   320
     \draw [->, >=latex] (1) edge[loop left] node[above] {$S_0:L$} (1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   321
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   322
     \draw [->, >=latex] (1) -- node[above] {$S_1:L$} (2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   323
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   324
     \draw [->, >=latex] (2) -- node[above] {$S_1:R$} (3)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   325
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   326
     \draw [->, >=latex] (2) -- node[left] {$S_1:L$} (7)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   327
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   328
     \draw [->, >=latex] (3) edge[loop above] node[above] {$S_1:S_0$} (3)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   329
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   330
     \draw [->, >=latex] (3) -- node[above] {$S_0:R$} (4)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   331
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   332
     \draw [->, >=latex] (4) edge[loop above] node[above] {$S_0:R$} (4)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   333
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   334
     \draw [->, >=latex] (4) -- node[above] {$S_1:R$} (5)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   335
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   336
     \draw [->, >=latex] (5) edge[loop above] node[above] {$S_1:R$} (5)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   337
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   338
     \draw [->, >=latex] (5) -- node[above] {$S_0:S_1$} (6)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   339
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   340
     \draw [->, >=latex] (6) edge[loop above] node[above] {$S_1:L$} (6)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   341
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   342
     \draw [->, >=latex] (6) -- node[above] {$S_0:R$} (13)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   343
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   344
     \draw [->, >=latex] (13) -- (14)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   345
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   346
     \draw (14) -- ($(14)+(0, 6\baseheight)$) -- ($(1) + (0, 6\baseheight)$) node [above,midway] {$S_1:L$}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   347
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   348
     \draw [->, >=latex] ($(1) + (0, 6\baseheight)$) -- (1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   349
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   350
     \draw [->, >=latex] (7) -- node[above] {$S_0:R$} (17)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   351
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   352
     \draw [->, >=latex] (7) -- node[left] {$S_1:R$} (8)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   353
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   354
     \draw [->, >=latex] (8) -- node[above] {$S_0:R$} (9)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   355
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   356
     \draw [->, >=latex] (9) -- node[above] {$S_0:R$} (10)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   357
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   358
     \draw [->, >=latex] (10) -- node[above] {$S_1:R$} (11)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   359
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   360
     \draw [->, >=latex] (10) edge[loop above] node[above] {$S_0:R$} (10)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   361
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   362
     \draw [->, >=latex] (11) edge[loop above] node[above] {$S_1:R$} (11)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   363
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   364
     \draw [->, >=latex] (11) -- node[above] {$S_0:S_1$} (12)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   365
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   366
     \draw [->, >=latex] (12) -- node[above] {$S_0:R$} (15)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   367
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   368
     \draw [->, >=latex] (12) edge[loop above] node[above] {$S_1:L$} (12)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   369
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   370
     \draw [->, >=latex] (15) -- (16)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   371
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   372
     \draw (16) -- ($(16)+(0, -4\baseheight)$) -- ($(1) + (0, -18\baseheight)$) node [below,midway] {$S_1:L$}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   373
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   374
     \draw [->, >=latex] ($(1) + (0, -18\baseheight)$) -- (1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   375
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   376
 \end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   377
\caption{The diagram of TM $mainwork$} \label{mainwork_diag}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   378
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   379
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   380
The purpose of TM $adjust$ is to encode the last bit of $a_1$. The initial and final configuration
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   381
of this TM are shown in Figure \ref{adjust_initial} and \ref{adjust_final} respectively.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   382
The diagram of TM $adjust$ is shown in Figure \ref{adjust_diag}.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   383
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   384
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   385
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   386
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   387
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   388
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   389
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   390
  \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   391
  \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   392
  \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   393
  \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   394
  \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   395
  \node (6) [right = -0.9pt of 5] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   396
  \node (7) [draw, right = -0.9pt of 6, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   397
  \node (8) [draw, text height = 3.9pt, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $r$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   398
  \draw [->, >=latex, thick] (3)+(0, -4\baseheight) -- (3);
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   399
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   400
\caption{Initial configuration of TM $adjust$} \label{adjust_initial}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   401
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   402
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   403
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   404
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   405
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   406
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   407
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   408
  \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   409
  \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   410
  \node (3) [draw, text height = 2.9pt, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $r+1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   411
  \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   412
  \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   413
  \node (6) [right = -0.9pt of 5] {\ldots \ldots};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   414
  \draw [->, >=latex, thick] (1)+(0, -4\baseheight) -- (1);
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   415
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   416
\caption{Final configuration of TM $adjust$} \label{adjust_final}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   417
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   418
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   419
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   420
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   421
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   422
\scalebox{0.9}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   423
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   424
     \node[circle,draw] (1) {$1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   425
     \node[circle,draw] (2) at ($(1)+(0.3\basewidth, 0)$) {$2$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   426
     \node[circle,draw] (3) at ($(2)+(0.3\basewidth, 0)$) {$3$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   427
     \node[circle,draw] (4) at ($(3)+(0.3\basewidth, 0)$) {$4$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   428
     \node[circle,draw] (5) at ($(4)+(0.3\basewidth, 0)$) {$5$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   429
     \node[circle,draw] (6) at ($(5)+(0.3\basewidth, 0)$) {$6$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   430
     \node[circle,draw] (7) at ($(6)+(0.3\basewidth, 0)$) {$7$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   431
     \node[circle,draw] (8) at ($(4)+(0, -7\baseheight)$) {$8$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   432
     \node[circle,draw] (9) at ($(8)+(0.3\basewidth, 0)$) {$9$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   433
     \node[circle,draw] (10) at ($(9)+(0.3\basewidth, 0)$) {$10$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   434
     \node[circle,draw] (11) at ($(10)+(0.3\basewidth, 0)$) {$11$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   435
     \node[circle,draw] (12) at ($(11)+(0.3\basewidth, 0)$) {$0$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   436
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   437
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   438
     \draw [->, >=latex] (1) -- node[above] {$S_1:R$} (2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   439
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   440
     \draw [->, >=latex] (1) edge[loop above] node[above] {$S_0:S_1$} (1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   441
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   442
     \draw [->, >=latex] (2) -- node[above] {$S_1:R$} (3)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   443
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   444
     \draw [->, >=latex] (3) edge[loop above] node[above] {$S_0:R$} (3)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   445
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   446
     \draw [->, >=latex] (3) -- node[above] {$S_1:R$} (4)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   447
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   448
     \draw [->, >=latex] (4) -- node[above] {$S_1:L$} (5)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   449
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   450
     \draw [->, >=latex] (4) -- node[right] {$S_0:L$} (8)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   451
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   452
     \draw [->, >=latex] (5) -- node[above] {$S_0:L$} (6)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   453
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   454
     \draw [->, >=latex] (5) edge[loop above] node[above] {$S_1:S_0$} (5)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   455
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   456
     \draw [->, >=latex] (6) -- node[above] {$S_1:R$} (7)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   457
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   458
     \draw [->, >=latex] (6) edge[loop above] node[above] {$S_0:L$} (6)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   459
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   460
     \draw (7) -- ($(7)+(0, 6\baseheight)$) -- ($(2) + (0, 6\baseheight)$) node [above,midway] {$S_0:S_1$}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   461
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   462
     \draw [->, >=latex] ($(2) + (0, 6\baseheight)$) -- (2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   463
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   464
     \draw [->, >=latex] (8) edge[loop left] node[left] {$S_1:S_0$} (8)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   465
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   466
     \draw [->, >=latex] (8) -- node[above] {$S_0:L$} (9)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   467
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   468
     \draw [->, >=latex] (9) edge[loop above] node[above] {$S_0:L$} (9)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   469
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   470
     \draw [->, >=latex] (9) -- node[above] {$S_1:L$} (10)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   471
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   472
     \draw [->, >=latex] (10) edge[loop above] node[above] {$S_0:L$} (10)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   473
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   474
     \draw [->, >=latex] (10) -- node[above] {$S_0:L$} (11)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   475
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   476
     \draw [->, >=latex] (11) edge[loop above] node[above] {$S_1:L$} (11)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   477
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   478
     \draw [->, >=latex] (11) -- node[above] {$S_0:R$} (12)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   479
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   480
 \end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   481
\caption{Diagram of TM $adjust$} \label{adjust_diag}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   482
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   483
*}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   484
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   485
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   486
definition rec_twice :: "recf"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   487
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   488
  "rec_twice = Cn 1 rec_mult [id 1 0, constn 2]"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   489
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   490
definition rec_fourtimes  :: "recf"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   491
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   492
  "rec_fourtimes = Cn 1 rec_mult [id 1 0, constn 4]"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   493
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   494
definition abc_twice :: "abc_prog"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   495
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   496
  "abc_twice = (let (aprog, ary, fp) = rec_ci rec_twice in 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   497
                       aprog [+] dummy_abc ((Suc 0)))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   498
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   499
definition abc_fourtimes :: "abc_prog"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   500
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   501
  "abc_fourtimes = (let (aprog, ary, fp) = rec_ci rec_fourtimes in 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   502
                       aprog [+] dummy_abc ((Suc 0)))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   503
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   504
definition twice_ly :: "nat list"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   505
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   506
  "twice_ly = layout_of abc_twice"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   507
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   508
definition fourtimes_ly :: "nat list"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   509
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   510
  "fourtimes_ly = layout_of abc_fourtimes"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   511
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   512
definition t_twice_compile :: "instr list"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   513
where
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   514
  "t_twice_compile= (tm_of abc_twice @ (shift (mopup 1) (length (tm_of abc_twice) div 2)))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   515
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   516
definition t_twice :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   517
  where
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   518
  "t_twice = adjust t_twice_compile"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   519
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   520
definition t_fourtimes_compile :: "instr list"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   521
where
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   522
  "t_fourtimes_compile= (tm_of abc_fourtimes @ (shift (mopup 1) (length (tm_of abc_fourtimes) div 2)))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   523
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   524
definition t_fourtimes :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   525
  where
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   526
  "t_fourtimes = adjust t_fourtimes_compile"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   527
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   528
definition t_twice_len :: "nat"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   529
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   530
  "t_twice_len = length t_twice div 2"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   531
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   532
definition t_wcode_main_first_part:: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   533
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   534
  "t_wcode_main_first_part \<equiv> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   535
                   [(L, 1), (L, 2), (L, 7), (R, 3),
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   536
                    (R, 4), (W0, 3), (R, 4), (R, 5),
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   537
                    (W1, 6), (R, 5), (R, 13), (L, 6),
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   538
                    (R, 0), (R, 8), (R, 9), (Nop, 8),
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   539
                    (R, 10), (W0, 9), (R, 10), (R, 11), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   540
                    (W1, 12), (R, 11), (R, t_twice_len + 14), (L, 12)]"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   541
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   542
definition t_wcode_main :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   543
  where
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   544
  "t_wcode_main = (t_wcode_main_first_part @ shift t_twice 12 @ [(L, 1), (L, 1)]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   545
                    @ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)])"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   546
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   547
fun bl_bin :: "cell list \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   548
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   549
  "bl_bin [] = 0" 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   550
| "bl_bin (Bk # xs) = 2 * bl_bin xs"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   551
| "bl_bin (Oc # xs) = Suc (2 * bl_bin xs)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   552
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   553
declare bl_bin.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   554
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   555
type_synonym bin_inv_t = "cell list \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   556
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   557
fun wcode_before_double :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   558
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   559
  "wcode_before_double ires rs (l, r) =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   560
     (\<exists> ln rn. l = Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   561
               r = Oc\<up>((Suc (Suc rs))) @ Bk\<up>(rn ))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   562
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   563
declare wcode_before_double.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   564
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   565
fun wcode_after_double :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   566
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   567
  "wcode_after_double ires rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   568
     (\<exists> ln rn. l = Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   569
         r = Oc\<up>(Suc (Suc (Suc 2*rs))) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   570
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   571
declare wcode_after_double.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   572
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   573
fun wcode_on_left_moving_1_B :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   574
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   575
  "wcode_on_left_moving_1_B ires rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   576
     (\<exists> ml mr rn. l = Bk\<up>(ml) @ Oc # Oc # ires \<and> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   577
               r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   578
               ml + mr > Suc 0 \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   579
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   580
declare wcode_on_left_moving_1_B.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   581
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   582
fun wcode_on_left_moving_1_O :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   583
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   584
  "wcode_on_left_moving_1_O ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   585
     (\<exists> ln rn.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   586
               l = Oc # ires \<and> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   587
               r = Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   588
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   589
declare wcode_on_left_moving_1_O.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   590
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   591
fun wcode_on_left_moving_1 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   592
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   593
  "wcode_on_left_moving_1 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   594
          (wcode_on_left_moving_1_B ires rs (l, r) \<or> wcode_on_left_moving_1_O ires rs (l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   595
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   596
declare wcode_on_left_moving_1.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   597
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   598
fun wcode_on_checking_1 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   599
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   600
   "wcode_on_checking_1 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   601
    (\<exists> ln rn. l = ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   602
              r = Oc # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   603
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   604
fun wcode_erase1 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   605
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   606
"wcode_erase1 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   607
       (\<exists> ln rn. l = Oc # ires \<and> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   608
                 tl r = Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   609
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   610
declare wcode_erase1.simps [simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   611
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   612
fun wcode_on_right_moving_1 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   613
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   614
  "wcode_on_right_moving_1 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   615
       (\<exists> ml mr rn.        
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   616
             l = Bk\<up>(ml) @ Oc # ires \<and> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   617
             r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   618
             ml + mr > Suc 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   619
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   620
declare wcode_on_right_moving_1.simps [simp del] 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   621
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   622
declare wcode_on_right_moving_1.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   623
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   624
fun wcode_goon_right_moving_1 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   625
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   626
  "wcode_goon_right_moving_1 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   627
      (\<exists> ml mr ln rn. 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   628
            l = Oc\<up>(ml) @ Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   629
            r = Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   630
            ml + mr = Suc rs)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   631
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   632
declare wcode_goon_right_moving_1.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   633
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   634
fun wcode_backto_standard_pos_B :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   635
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   636
  "wcode_backto_standard_pos_B ires rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   637
          (\<exists> ln rn. l =  Bk # Bk\<up>(ln) @ Oc # ires \<and> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   638
               r =  Bk # Oc\<up>((Suc (Suc rs))) @ Bk\<up>(rn ))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   639
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   640
declare wcode_backto_standard_pos_B.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   641
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   642
fun wcode_backto_standard_pos_O :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   643
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   644
   "wcode_backto_standard_pos_O ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   645
        (\<exists> ml mr ln rn. 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   646
            l = Oc\<up>(ml) @ Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   647
            r = Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   648
            ml + mr = Suc (Suc rs) \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   649
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   650
declare wcode_backto_standard_pos_O.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   651
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   652
fun wcode_backto_standard_pos :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   653
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   654
  "wcode_backto_standard_pos ires rs (l, r) = (wcode_backto_standard_pos_B ires rs (l, r) \<or>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   655
                                            wcode_backto_standard_pos_O ires rs (l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   656
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   657
declare wcode_backto_standard_pos.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   658
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   659
lemma [simp]: "<0::nat> = [Oc]"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   660
apply(simp add: tape_of_nat_abv tape_of_nat_list.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   661
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   662
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   663
lemma tape_of_Suc_nat: "<Suc (a ::nat)> = replicate a Oc @ [Oc, Oc]"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   664
apply(simp only: tape_of_nat_abv exp_ind, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   665
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   666
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   667
lemma [simp]: "length (<a::nat>) = Suc a"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   668
apply(simp add: tape_of_nat_abv tape_of_nat_list.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   669
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   670
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   671
lemma [simp]: "<[a::nat]> = <a>"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   672
apply(simp add: tape_of_nat_abv tape_of_nl_abv
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   673
  tape_of_nat_list.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   674
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   675
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   676
lemma bin_wc_eq: "bl_bin xs = bl2wc xs"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   677
proof(induct xs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   678
  show " bl_bin [] = bl2wc []" 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   679
    apply(simp add: bl_bin.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   680
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   681
next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   682
  fix a xs
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   683
  assume "bl_bin xs = bl2wc xs"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   684
  thus " bl_bin (a # xs) = bl2wc (a # xs)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   685
    apply(case_tac a, simp_all add: bl_bin.simps bl2wc.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   686
    apply(simp_all add: bl2nat.simps bl2nat_double)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   687
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   688
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   689
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   690
lemma bl_bin_nat_Suc:  
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   691
  "bl_bin (<Suc a>) = bl_bin (<a>) + 2^(Suc a)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   692
apply(simp add: tape_of_nat_abv bl_bin.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   693
apply(induct a, auto simp: bl_bin.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   694
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   695
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   696
lemma [simp]: " rev (a\<up>(aa)) = a\<up>(aa)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   697
apply(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   698
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   699
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   700
lemma tape_of_nl_append_one: "lm \<noteq> [] \<Longrightarrow>  <lm @ [a]> = <lm> @ Bk # Oc\<up>Suc a"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   701
apply(induct lm, auto simp: tape_of_nl_cons split:if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   702
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   703
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   704
lemma tape_of_nl_rev: "rev (<lm::nat list>) = (<rev lm>)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   705
apply(induct lm, simp, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   706
apply(auto simp: tape_of_nl_cons tape_of_nl_append_one split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   707
apply(simp add: exp_ind[THEN sym])
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   708
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   709
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   710
lemma [simp]: "a\<up>(Suc 0) = [a]" 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   711
by(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   712
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   713
lemma tape_of_nl_cons_app1: "(<a # xs @ [b]>) = (Oc\<up>(Suc a) @ Bk # (<xs@ [b]>))"
133
ca7fb6848715 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 131
diff changeset
   714
apply(case_tac xs, simp add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
ca7fb6848715 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 131
diff changeset
   715
apply(simp add: tape_of_nl_abv  tape_of_nat_list.simps tape_of_nat_abv)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   716
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   717
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   718
lemma bl_bin_bk_oc[simp]:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   719
  "bl_bin (xs @ [Bk, Oc]) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   720
  bl_bin xs + 2*2^(length xs)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   721
apply(simp add: bin_wc_eq)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   722
using bl2nat_cons_oc[of "xs @ [Bk]"]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   723
apply(simp add: bl2nat_cons_bk bl2wc.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   724
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   725
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   726
lemma tape_of_nat[simp]: "(<a::nat>) = Oc\<up>(Suc a)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   727
apply(simp add: tape_of_nat_abv)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   728
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   729
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   730
lemma tape_of_nl_cons_app2: "(<c # xs @ [b]>) = (<c # xs> @ Bk # Oc\<up>(Suc b))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   731
proof(induct "length xs" arbitrary: xs c,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   732
  simp add: tape_of_nl_abv  tape_of_nat_list.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   733
  fix x xs c
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   734
  assume ind: "\<And>xs c. x = length xs \<Longrightarrow> <c # xs @ [b]> = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   735
    <c # xs> @ Bk # Oc\<up>(Suc b)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   736
    and h: "Suc x = length (xs::nat list)" 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   737
  show "<c # xs @ [b]> = <c # xs> @ Bk # Oc\<up>(Suc b)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   738
  proof(case_tac xs, simp add: tape_of_nl_abv  tape_of_nat_list.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   739
    fix a list
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   740
    assume g: "xs = a # list"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   741
    hence k: "<a # list @ [b]> =  <a # list> @ Bk # Oc\<up>(Suc b)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   742
      apply(rule_tac ind)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   743
      using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   744
      apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   745
      done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   746
    from g and k show "<c # xs @ [b]> = <c # xs> @ Bk # Oc\<up>(Suc b)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   747
      apply(simp add: tape_of_nl_abv tape_of_nat_list.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   748
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   749
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   750
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   751
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   752
lemma [simp]: "length (<aa # a # list>) = Suc (Suc aa) + length (<a # list>)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   753
apply(simp add: tape_of_nl_abv tape_of_nat_list.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   754
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   755
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   756
lemma [simp]: "bl_bin (Oc\<up>(Suc aa) @ Bk # tape_of_nat_list (a # lista) @ [Bk, Oc]) =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   757
              bl_bin (Oc\<up>(Suc aa) @ Bk # tape_of_nat_list (a # lista)) + 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   758
              2* 2^(length (Oc\<up>(Suc aa) @ Bk # tape_of_nat_list (a # lista)))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   759
using bl_bin_bk_oc[of "Oc\<up>(Suc aa) @ Bk # tape_of_nat_list (a # lista)"]
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   760
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   761
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   762
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   763
declare replicate_Suc[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   764
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   765
lemma [simp]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   766
  "bl_bin (<aa # list>) + (4 * rs + 4) * 2 ^ (length (<aa # list>) - Suc 0)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   767
  = bl_bin (Oc\<up>(Suc aa) @ Bk # <list @ [0]>) + rs * (2 * 2 ^ (aa + length (<list @ [0]>)))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   768
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   769
apply(case_tac "list", simp add: add_mult_distrib)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   770
apply(simp add: tape_of_nl_cons_app2 add_mult_distrib)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   771
apply(simp add: tape_of_nl_abv tape_of_nat_list.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   772
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   773
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   774
lemma tape_of_nl_app_Suc: "((<list @ [Suc ab]>)) = (<list @ [ab]>) @ [Oc]"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   775
apply(induct list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   776
apply(simp add: tape_of_nl_abv tape_of_nat_list.simps exp_ind)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   777
apply(case_tac list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   778
apply(simp_all add:tape_of_nl_abv tape_of_nat_list.simps exp_ind)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   779
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   780
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   781
lemma [simp]: "bl_bin (Oc # Oc\<up>(aa) @ Bk # <list @ [ab]> @ [Oc])
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   782
              = bl_bin (Oc # Oc\<up>(aa) @ Bk # <list @ [ab]>) +
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   783
              2^(length (Oc # Oc\<up>(aa) @ Bk # <list @ [ab]>))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   784
apply(simp add: bin_wc_eq)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   785
apply(simp add: bl2nat_cons_oc bl2wc.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   786
using bl2nat_cons_oc[of "Oc # Oc\<up>(aa) @ Bk # <list @ [ab]>"]
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   787
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   788
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   789
lemma [simp]: "bl_bin (Oc # Oc\<up>(aa) @ Bk # <list @ [ab]>) + (4 * 2 ^ (aa + length (<list @ [ab]>)) +
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   790
         4 * (rs * 2 ^ (aa + length (<list @ [ab]>)))) =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   791
       bl_bin (Oc # Oc\<up>(aa) @ Bk # <list @ [Suc ab]>) +
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   792
         rs * (2 * 2 ^ (aa + length (<list @ [Suc ab]>)))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   793
apply(simp add: tape_of_nl_app_Suc)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   794
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   795
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   796
declare tape_of_nat[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   797
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   798
fun wcode_double_case_inv :: "nat \<Rightarrow> bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   799
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   800
  "wcode_double_case_inv st ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   801
          (if st = Suc 0 then wcode_on_left_moving_1 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   802
          else if st = Suc (Suc 0) then wcode_on_checking_1 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   803
          else if st = 3 then wcode_erase1 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   804
          else if st = 4 then wcode_on_right_moving_1 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   805
          else if st = 5 then wcode_goon_right_moving_1 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   806
          else if st = 6 then wcode_backto_standard_pos ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   807
          else if st = 13 then wcode_before_double ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   808
          else False)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   809
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   810
declare wcode_double_case_inv.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   811
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   812
fun wcode_double_case_state :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   813
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   814
  "wcode_double_case_state (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   815
   13 - st"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   816
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   817
fun wcode_double_case_step :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   818
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   819
  "wcode_double_case_step (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   820
      (if st = Suc 0 then (length l)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   821
      else if st = Suc (Suc 0) then (length r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   822
      else if st = 3 then 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   823
                 if hd r = Oc then 1 else 0
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   824
      else if st = 4 then (length r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   825
      else if st = 5 then (length r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   826
      else if st = 6 then (length l)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   827
      else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   828
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   829
fun wcode_double_case_measure :: "config \<Rightarrow> nat \<times> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   830
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   831
  "wcode_double_case_measure (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   832
     (wcode_double_case_state (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   833
      wcode_double_case_step (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   834
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   835
definition wcode_double_case_le :: "(config \<times> config) set"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   836
  where "wcode_double_case_le \<equiv> (inv_image lex_pair wcode_double_case_measure)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   837
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   838
lemma [intro]: "wf lex_pair"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   839
by(auto intro:wf_lex_prod simp:lex_pair_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   840
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   841
lemma wf_wcode_double_case_le[intro]: "wf wcode_double_case_le"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   842
by(auto intro:wf_inv_image simp: wcode_double_case_le_def )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   843
term fetch
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   844
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   845
lemma [simp]: "fetch t_wcode_main (Suc 0) Bk = (L, Suc 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   846
apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   847
                fetch.simps nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   848
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   849
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   850
lemma [simp]: "fetch t_wcode_main (Suc 0) Oc = (L, Suc (Suc 0))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   851
apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   852
                fetch.simps nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   853
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   854
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   855
lemma [simp]: "fetch t_wcode_main (Suc (Suc 0)) Oc = (R, 3)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   856
apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   857
                fetch.simps nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   858
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   859
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   860
lemma [simp]: "fetch t_wcode_main (Suc (Suc (Suc 0))) Bk = (R, 4)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   861
apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   862
                fetch.simps nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   863
done 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   864
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   865
lemma [simp]: "fetch t_wcode_main (Suc (Suc (Suc 0))) Oc = (W0, 3)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   866
apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   867
                fetch.simps nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   868
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   869
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   870
lemma [simp]: "fetch t_wcode_main 4 Bk = (R, 4)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   871
apply(subgoal_tac "4 = Suc 3")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   872
apply(simp only: t_wcode_main_def t_wcode_main_first_part_def
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   873
                fetch.simps nth_of.simps, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   874
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   875
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   876
lemma [simp]: "fetch t_wcode_main 4 Oc = (R, 5)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   877
apply(subgoal_tac "4 = Suc 3")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   878
apply(simp only: t_wcode_main_def t_wcode_main_first_part_def
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   879
                fetch.simps nth_of.simps, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   880
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   881
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   882
lemma [simp]: "fetch t_wcode_main 5 Oc = (R, 5)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   883
apply(subgoal_tac "5 = Suc 4")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   884
apply(simp only: t_wcode_main_def t_wcode_main_first_part_def
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   885
                fetch.simps nth_of.simps, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   886
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   887
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   888
lemma [simp]: "fetch t_wcode_main 5 Bk = (W1, 6)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   889
apply(subgoal_tac "5 = Suc 4")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   890
apply(simp only: t_wcode_main_def t_wcode_main_first_part_def
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   891
                fetch.simps nth_of.simps, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   892
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   893
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   894
lemma [simp]: "fetch t_wcode_main 6 Bk = (R, 13)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   895
apply(subgoal_tac "6 = Suc 5")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   896
apply(simp only: t_wcode_main_def t_wcode_main_first_part_def
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   897
                fetch.simps nth_of.simps, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   898
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   899
  
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   900
lemma [simp]: "fetch t_wcode_main 6 Oc = (L, 6)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   901
apply(subgoal_tac "6 = Suc 5")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   902
apply(simp only: t_wcode_main_def t_wcode_main_first_part_def
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   903
                fetch.simps nth_of.simps, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   904
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   905
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   906
lemma [elim]: "Bk\<up>(mr) = [] \<Longrightarrow> mr = 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   907
apply(case_tac mr, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   908
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   909
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   910
lemma [simp]: "wcode_on_left_moving_1 ires rs (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   911
apply(simp add: wcode_on_left_moving_1.simps wcode_on_left_moving_1_B.simps
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   912
                wcode_on_left_moving_1_O.simps) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   913
done                                           
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   914
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   915
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   916
declare wcode_on_checking_1.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   917
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   918
lemmas wcode_double_case_inv_simps = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   919
  wcode_on_left_moving_1.simps wcode_on_left_moving_1_O.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   920
  wcode_on_left_moving_1_B.simps wcode_on_checking_1.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   921
  wcode_erase1.simps wcode_on_right_moving_1.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   922
  wcode_goon_right_moving_1.simps wcode_backto_standard_pos.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   923
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   924
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   925
lemma [simp]: "wcode_on_left_moving_1 ires rs (b, r) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   926
apply(simp add: wcode_double_case_inv_simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   927
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   928
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   929
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   930
lemma [elim]: "\<lbrakk>wcode_on_left_moving_1 ires rs (b, Bk # list);
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   931
                tl b = aa \<and> hd b # Bk # list = ba\<rbrakk> \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   932
               wcode_on_left_moving_1 ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   933
apply(simp only: wcode_on_left_moving_1.simps wcode_on_left_moving_1_O.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   934
                wcode_on_left_moving_1_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   935
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   936
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   937
apply(case_tac ml, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   938
apply(rule_tac x = "mr - Suc (Suc 0)" in exI, rule_tac x = rn in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   939
apply(case_tac mr, simp, case_tac nat, simp, simp add: exp_ind)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   940
apply(rule_tac disjI1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   941
apply(rule_tac x = nat in exI, rule_tac x = "Suc mr" in exI, rule_tac x = rn in exI, 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   942
      simp, simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   943
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   944
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   945
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   946
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   947
declare replicate_Suc[simp]
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   948
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   949
lemma [elim]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   950
  "\<lbrakk>wcode_on_left_moving_1 ires rs (b, Oc # list); tl b = aa \<and> hd b # Oc # list = ba\<rbrakk> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   951
    \<Longrightarrow> wcode_on_checking_1 ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   952
apply(simp only: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   953
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   954
apply(erule_tac [!] exE)+
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   955
apply(case_tac mr, simp, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   956
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   957
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   958
lemma [simp]: "wcode_on_checking_1 ires rs (b, []) = False" 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   959
apply(auto simp: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   960
done         
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   961
 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   962
lemma [simp]: "wcode_on_checking_1 ires rs (b, Bk # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   963
apply(auto simp: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   964
done         
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   965
  
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   966
lemma [elim]: "\<lbrakk>wcode_on_checking_1 ires rs (b, Oc # ba);Oc # b = aa \<and> list = ba\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   967
  \<Longrightarrow> wcode_erase1 ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   968
apply(simp only: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   969
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   970
apply(rule_tac x = ln in exI, rule_tac x = rn in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   971
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   972
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   973
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   974
lemma [simp]: "wcode_on_checking_1 ires rs (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   975
apply(simp add: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   976
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   977
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   978
lemma [simp]: "wcode_on_checking_1 ires rs ([], Bk # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   979
apply(simp add: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   980
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   981
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   982
lemma [simp]: "wcode_erase1 ires rs (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   983
apply(simp add: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   984
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   985
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   986
lemma [simp]: "wcode_on_right_moving_1 ires rs (b, []) = False"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   987
apply(simp add: wcode_double_case_inv_simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   988
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   989
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   990
lemma [simp]: "wcode_on_right_moving_1 ires rs (b, []) = False"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   991
apply(simp add: wcode_double_case_inv_simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   992
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   993
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   994
lemma [elim]: "\<lbrakk>wcode_on_right_moving_1 ires rs (b, Bk # ba);  Bk # b = aa \<and> list = b\<rbrakk> \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   995
  wcode_on_right_moving_1 ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   996
apply(simp only: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   997
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   998
apply(rule_tac x = "Suc ml" in exI, rule_tac x = "mr - Suc 0" in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   999
      rule_tac x = rn in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1000
apply(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1001
apply(case_tac mr, simp, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1002
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1003
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1004
lemma [elim]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1005
  "\<lbrakk>wcode_on_right_moving_1 ires rs (b, Oc # ba); Oc # b = aa \<and> list = ba\<rbrakk> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1006
  \<Longrightarrow> wcode_goon_right_moving_1 ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1007
apply(simp only: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1008
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1009
apply(rule_tac x = "Suc 0" in exI, rule_tac x = "rs" in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1010
      rule_tac x = "ml - Suc (Suc 0)" in exI, rule_tac x = rn in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1011
apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1012
apply(case_tac ml, simp, case_tac nat, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1013
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1014
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1015
lemma [simp]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1016
  "wcode_on_right_moving_1 ires rs (b, []) \<Longrightarrow> False"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1017
apply(simp add: wcode_double_case_inv_simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1018
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1019
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1020
lemma [elim]: "\<lbrakk>wcode_erase1 ires rs (b, Bk # ba); Bk # b = aa \<and> list = ba; c = Bk # ba\<rbrakk> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1021
  \<Longrightarrow> wcode_on_right_moving_1 ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1022
apply(simp only: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1023
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1024
apply(rule_tac x = "Suc 0" in exI, rule_tac x = "Suc (Suc ln)" in exI, 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1025
      rule_tac x = rn in exI, simp add: exp_ind del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1026
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1027
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1028
lemma [elim]: "\<lbrakk>wcode_erase1 ires rs (aa, Oc # list);  b = aa \<and> Bk # list = ba\<rbrakk> \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1029
  wcode_erase1 ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1030
apply(simp only: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1031
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1032
apply(rule_tac x = ln in exI, rule_tac x = rn in exI, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1033
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1034
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1035
lemma [elim]: "\<lbrakk>wcode_goon_right_moving_1 ires rs (aa, []); b = aa \<and> [Oc] = ba\<rbrakk> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1036
              \<Longrightarrow> wcode_backto_standard_pos ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1037
apply(simp only: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1038
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1039
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1040
apply(simp only:wcode_backto_standard_pos_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1041
apply(rule_tac x = ml in exI, rule_tac x = "Suc 0" in exI, rule_tac x = ln in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1042
      rule_tac x = rn in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1043
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1044
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1045
lemma [elim]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1046
  "\<lbrakk>wcode_goon_right_moving_1 ires rs (aa, Bk # list);  b = aa \<and> Oc # list = ba\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1047
  \<Longrightarrow> wcode_backto_standard_pos ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1048
apply(simp only: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1049
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1050
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1051
apply(simp only:wcode_backto_standard_pos_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1052
apply(rule_tac x = ml in exI, rule_tac x = "Suc 0" in exI, rule_tac x = ln in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1053
      rule_tac x = "rn - Suc 0" in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1054
apply(case_tac mr, simp, case_tac rn, simp, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1055
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1056
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1057
lemma [elim]: "\<lbrakk>wcode_goon_right_moving_1 ires rs (b, Oc # ba);  Oc # b = aa \<and> list = ba\<rbrakk> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1058
  \<Longrightarrow> wcode_goon_right_moving_1 ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1059
apply(simp only: wcode_double_case_inv_simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1060
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1061
apply(rule_tac x = "Suc ml" in exI, rule_tac x = "mr - Suc 0" in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1062
      rule_tac x = ln in exI, rule_tac x = rn in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1063
apply(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1064
apply(case_tac mr, simp, case_tac rn, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1065
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1066
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1067
lemma [elim]: "\<lbrakk>wcode_backto_standard_pos ires rs (b, []);  Bk # b = aa\<rbrakk> \<Longrightarrow> False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1068
apply(auto simp: wcode_double_case_inv_simps wcode_backto_standard_pos_O.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1069
                 wcode_backto_standard_pos_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1070
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1071
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1072
lemma [elim]: "\<lbrakk>wcode_backto_standard_pos ires rs (b, Bk # ba); Bk # b = aa \<and> list = ba\<rbrakk> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1073
  \<Longrightarrow> wcode_before_double ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1074
apply(simp only: wcode_double_case_inv_simps wcode_backto_standard_pos_B.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1075
                 wcode_backto_standard_pos_O.simps wcode_before_double.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1076
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1077
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1078
apply(rule_tac x = ln in exI, rule_tac x = rn in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1079
apply(auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1080
apply(case_tac [!] mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1081
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1082
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1083
lemma [simp]: "wcode_backto_standard_pos ires rs ([], Oc # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1084
apply(auto simp: wcode_backto_standard_pos.simps wcode_backto_standard_pos_B.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1085
                 wcode_backto_standard_pos_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1086
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1087
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1088
lemma [simp]: "wcode_backto_standard_pos ires rs (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1089
apply(auto simp: wcode_backto_standard_pos.simps wcode_backto_standard_pos_B.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1090
                 wcode_backto_standard_pos_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1091
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1092
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1093
lemma [elim]: "\<lbrakk>wcode_backto_standard_pos ires rs (b, Oc # list); tl b = aa; hd b # Oc # list =  ba\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1094
       \<Longrightarrow> wcode_backto_standard_pos ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1095
apply(simp only:  wcode_backto_standard_pos.simps wcode_backto_standard_pos_B.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1096
                 wcode_backto_standard_pos_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1097
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1098
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1099
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1100
apply(case_tac ml, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1101
apply(rule_tac disjI1, rule_tac conjI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1102
apply(rule_tac x = ln  in exI, simp, rule_tac x = rn in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1103
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1104
apply(rule_tac x = nat in exI, rule_tac x = "Suc mr" in exI, rule_tac x = ln in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1105
      rule_tac x = rn in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1106
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1107
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1108
declare nth_of.simps[simp del] fetch.simps[simp del]
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1109
lemma wcode_double_case_first_correctness:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1110
  "let P = (\<lambda> (st, l, r). st = 13) in 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1111
       let Q = (\<lambda> (st, l, r). wcode_double_case_inv st ires rs (l, r)) in 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1112
       let f = (\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp) in
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1113
       \<exists> n .P (f n) \<and> Q (f (n::nat))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1114
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1115
  let ?P = "(\<lambda> (st, l, r). st = 13)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1116
  let ?Q = "(\<lambda> (st, l, r). wcode_double_case_inv st ires rs (l, r))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1117
  let ?f = "(\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1118
  have "\<exists> n. ?P (?f n) \<and> ?Q (?f (n::nat))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1119
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1120
    show "wf wcode_double_case_le"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1121
      by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1122
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1123
    show "\<forall> na. \<not> ?P (?f na) \<and> ?Q (?f na) \<longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1124
                   ?Q (?f (Suc na)) \<and> (?f (Suc na), ?f na) \<in> wcode_double_case_le"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1125
    proof(rule_tac allI, case_tac "?f na", simp add: step_red)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1126
      fix na a b c
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1127
      show "a \<noteq> 13 \<and> wcode_double_case_inv a ires rs (b, c) \<longrightarrow>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1128
               (case step0 (a, b, c) t_wcode_main of (st, x) \<Rightarrow> 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1129
                   wcode_double_case_inv st ires rs x) \<and> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1130
                (step0 (a, b, c) t_wcode_main, a, b, c) \<in> wcode_double_case_le"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1131
        apply(rule_tac impI, simp add: wcode_double_case_inv.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1132
        apply(auto split: if_splits simp: step.simps, 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1133
              case_tac [!] c, simp_all, case_tac [!] "(c::cell list)!0")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1134
        apply(simp_all add: wcode_double_case_inv.simps wcode_double_case_le_def
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1135
                                        lex_pair_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1136
        apply(auto split: if_splits)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1137
        done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1138
    qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1139
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1140
    show "?Q (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1141
      apply(simp add: steps.simps wcode_double_case_inv.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1142
                                  wcode_on_left_moving_1.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1143
                                  wcode_on_left_moving_1_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1144
      apply(rule_tac disjI1)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1145
      apply(rule_tac x = "Suc m" in exI, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1146
      apply(rule_tac x = "Suc 0" in exI, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1147
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1148
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1149
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1150
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1151
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1152
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1153
  thus "let P = \<lambda>(st, l, r). st = 13;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1154
    Q = \<lambda>(st, l, r). wcode_double_case_inv st ires rs (l, r);
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1155
    f = steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1156
    in \<exists>n. P (f n) \<and> Q (f n)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1157
    apply(simp add: Let_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1158
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1159
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1160
    
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1161
lemma tm_append_shift_append_steps: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1162
"\<lbrakk>steps0 (st, l, r) tp stp = (st', l', r'); 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1163
  0 < st';
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1164
  length tp1 mod 2 = 0
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1165
  \<rbrakk>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1166
  \<Longrightarrow> steps0 (st + length tp1 div 2, l, r) (tp1 @ shift tp (length tp1 div 2) @ tp2) stp 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1167
  = (st' + length tp1 div 2, l', r')"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1168
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1169
  assume h: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1170
    "steps0 (st, l, r) tp stp = (st', l', r')"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1171
    "0 < st'"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1172
    "length tp1 mod 2 = 0 "
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1173
  from h have 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1174
    "steps (st + length tp1 div 2, l, r) (tp1 @ shift tp (length tp1 div 2), 0) stp = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1175
                            (st' + length tp1 div 2, l', r')"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1176
    by(rule_tac tm_append_second_steps_eq, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1177
  then have "steps (st + length tp1 div 2, l, r) ((tp1 @ shift tp (length tp1 div 2)) @ tp2, 0) stp = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1178
                            (st' + length tp1 div 2, l', r')"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1179
    using h
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1180
    apply(rule_tac tm_append_first_steps_eq, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1181
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1182
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1183
    by simp
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1184
qed 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1185
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1186
lemma t_twice_len_ge: "Suc 0 \<le> length t_twice div 2"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1187
apply(simp add: t_twice_def mopup.simps t_twice_compile_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1188
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1189
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1190
lemma [intro]: "rec_calc_rel (recf.id (Suc 0) 0) [rs] rs"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1191
  apply(rule_tac calc_id, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1192
  done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1193
  
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1194
lemma [intro]: "rec_calc_rel (constn 2) [rs] 2"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1195
using prime_rel_exec_eq[of "constn 2" "[rs]" 2]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1196
apply(subgoal_tac "primerec (constn 2) 1", auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1197
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1198
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1199
lemma  [intro]: "rec_calc_rel rec_mult [rs, 2] (2 * rs)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1200
using prime_rel_exec_eq[of "rec_mult" "[rs, 2]"  "2*rs"]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1201
apply(subgoal_tac "primerec rec_mult (Suc (Suc 0))", auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1202
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1203
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1204
declare start_of.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1205
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1206
lemma t_twice_correct: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1207
  "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1208
  (tm_of abc_twice @ shift (mopup (Suc 0)) ((length (tm_of abc_twice) div 2))) stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1209
  (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1210
proof(case_tac "rec_ci rec_twice")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1211
  fix a b c
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1212
  assume h: "rec_ci rec_twice = (a, b, c)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1213
  have "\<exists>stp m l. steps0 (Suc 0, Bk # Bk # ires, <[rs]> @ Bk\<up>(n)) (tm_of abc_twice @ shift (mopup 1) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1214
    (length (tm_of abc_twice) div 2)) stp = (0, Bk\<up>(m) @ Bk # Bk # ires, Oc\<up>(Suc (2*rs)) @ Bk\<up>(l))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1215
  proof(rule_tac recursive_compile_to_tm_correct)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1216
    show "rec_ci rec_twice = (a, b, c)" by (simp add: h)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1217
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1218
    show "rec_calc_rel rec_twice [rs] (2 * rs)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1219
      apply(simp add: rec_twice_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1220
      apply(rule_tac rs =  "[rs, 2]" in calc_cn, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1221
      apply(rule_tac allI, case_tac k, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1222
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1223
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1224
    show "length [rs] = 1" by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1225
  next	
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1226
    show "layout_of (a [+] dummy_abc 1) = layout_of (a [+] dummy_abc 1)" by simp
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1227
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1228
    show "tm_of abc_twice = tm_of (a [+] dummy_abc 1)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1229
      using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1230
      apply(simp add: abc_twice_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1231
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1232
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1233
  thus "?thesis"
133
ca7fb6848715 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 131
diff changeset
  1234
    apply(simp add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1235
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1236
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1237
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1238
declare adjust.simps[simp]
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1239
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1240
lemma adjust_fetch0: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1241
  "\<lbrakk>0 < a; a \<le> length ap div 2;  fetch ap a b = (aa, 0)\<rbrakk>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1242
  \<Longrightarrow> fetch (adjust ap) a b = (aa, Suc (length ap div 2))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1243
apply(case_tac b, auto simp: fetch.simps nth_of.simps nth_map
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1244
                       split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1245
apply(case_tac [!] a, auto simp: fetch.simps nth_of.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1246
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1247
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1248
lemma adjust_fetch_norm: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1249
  "\<lbrakk>st > 0;  st \<le> length tp div 2; fetch ap st b = (aa, ns); ns \<noteq> 0\<rbrakk>
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  1250
 \<Longrightarrow>  fetch (Turing.adjust ap) st b = (aa, ns)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1251
 apply(case_tac b, auto simp: fetch.simps nth_of.simps nth_map
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1252
                       split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1253
apply(case_tac [!] st, auto simp: fetch.simps nth_of.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1254
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1255
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1256
declare adjust.simps[simp del]
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1257
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1258
lemma adjust_step_eq: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1259
  assumes exec: "step0 (st,l,r) ap = (st', l', r')"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1260
  and wf_tm: "tm_wf (ap, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1261
  and notfinal: "st' > 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1262
  shows "step0 (st, l, r) (adjust ap) = (st', l', r')"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1263
  using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1264
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1265
  have "st > 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1266
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1267
    by(case_tac st, simp_all add: step.simps fetch.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1268
  moreover hence "st \<le> (length ap) div 2"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1269
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1270
    apply(case_tac "st \<le> (length ap) div 2", simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1271
    apply(case_tac st, auto simp: step.simps fetch.simps)
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1272
    apply(case_tac "read r", simp_all add: fetch.simps 
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1273
      nth_of.simps adjust.simps tm_wf.simps split: if_splits)
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1274
    apply(auto simp: mod_ex2)
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1275
    done    
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1276
  ultimately have "fetch (adjust ap) st (read r) = fetch ap st (read r)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1277
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1278
    apply(case_tac "fetch ap st (read r)")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1279
    apply(drule_tac adjust_fetch_norm, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1280
    apply(simp add: step.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1281
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1282
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1283
    using exec
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1284
    by(simp add: step.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1285
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1286
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1287
declare adjust.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1288
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1289
lemma adjust_steps_eq: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1290
  assumes exec: "steps0 (st,l,r) ap stp = (st', l', r')"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1291
  and wf_tm: "tm_wf (ap, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1292
  and notfinal: "st' > 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1293
  shows "steps0 (st, l, r) (adjust ap) stp = (st', l', r')"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1294
  using exec notfinal
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1295
proof(induct stp arbitrary: st' l' r')
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1296
  case 0
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1297
  thus "?case"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1298
    by(simp add: steps.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1299
next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1300
  case (Suc stp st' l' r')
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1301
  have ind: "\<And>st' l' r'. \<lbrakk>steps0 (st, l, r) ap stp = (st', l', r'); 0 < st'\<rbrakk> 
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  1302
    \<Longrightarrow> steps0 (st, l, r) (Turing.adjust ap) stp = (st', l', r')" by fact
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1303
  have h: "steps0 (st, l, r) ap (Suc stp) = (st', l', r')" by fact
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1304
  have g:   "0 < st'" by fact
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1305
  obtain st'' l'' r'' where a: "steps0 (st, l, r) ap stp = (st'', l'', r'')"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1306
    by (metis prod_cases3)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1307
  hence c:"0 < st''"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1308
    using h g
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1309
    apply(simp add: step_red)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1310
    apply(case_tac st'', auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1311
    done
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  1312
  hence b: "steps0 (st, l, r) (Turing.adjust ap) stp = (st'', l'', r'')"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1313
    using a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1314
    by(rule_tac ind, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1315
  thus "?case"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1316
    using assms a b h g
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1317
    apply(simp add: step_red) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1318
    apply(rule_tac adjust_step_eq, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1319
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1320
qed 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1321
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1322
lemma adjust_halt_eq:
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1323
  assumes exec: "steps0 (1, l, r) ap stp = (0, l', r')"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1324
  and tm_wf: "tm_wf (ap, 0)" 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1325
  shows "\<exists> stp. steps0 (Suc 0, l, r) (adjust ap) stp = 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1326
        (Suc (length ap div 2), l', r')"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1327
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1328
  have "\<exists> stp. \<not> is_final (steps0 (1, l, r) ap stp) \<and> (steps0 (1, l, r) ap (Suc stp) = (0, l', r'))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1329
    thm before_final using exec
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1330
    by(erule_tac before_final)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1331
  then obtain stpa where a: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1332
    "\<not> is_final (steps0 (1, l, r) ap stpa) \<and> (steps0 (1, l, r) ap (Suc stpa) = (0, l', r'))" ..
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1333
  obtain sa la ra where b:"steps0 (1, l, r) ap stpa = (sa, la, ra)"  by (metis prod_cases3)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1334
  hence c: "steps0 (Suc 0, l, r) (adjust ap) stpa = (sa, la, ra)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1335
    using assms a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1336
    apply(rule_tac adjust_steps_eq, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1337
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1338
  have d: "sa \<le> length ap div 2"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1339
    using steps_in_range[of  "(l, r)" ap stpa] a tm_wf b
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1340
    by(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1341
  obtain ac ns where e: "fetch ap sa (read ra) = (ac, ns)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1342
    by (metis prod.exhaust)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1343
  hence f: "ns = 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1344
    using b a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1345
    apply(simp add: step_red step.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1346
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1347
  have k: "fetch (adjust ap) sa (read ra) = (ac, Suc (length ap div 2))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1348
    using a b c d e f
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1349
    apply(rule_tac adjust_fetch0, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1350
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1351
  from a b e f k and c show "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1352
    apply(rule_tac x = "Suc stpa" in exI)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1353
    apply(simp add: step_red, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1354
    apply(simp add: step.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1355
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1356
qed    
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1357
   
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1358
declare tm_wf.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1359
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1360
lemma [simp]: " tm_wf (t_twice_compile, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1361
apply(simp only: t_twice_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1362
apply(rule_tac t_compiled_correct)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1363
apply(simp_all add: abc_twice_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1364
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1365
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1366
lemma t_twice_change_term_state:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1367
  "\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_twice stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1368
     = (Suc t_twice_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1369
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1370
  have "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1371
    (tm_of abc_twice @ shift (mopup (Suc 0)) ((length (tm_of abc_twice) div 2))) stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1372
    (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1373
    by(rule_tac t_twice_correct)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1374
  then obtain stp ln rn where " steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1375
    (tm_of abc_twice @ shift (mopup (Suc 0)) ((length (tm_of abc_twice) div 2))) stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1376
    (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))" by blast
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1377
  hence "\<exists> stp. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1378
    (adjust t_twice_compile) stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1379
     = (Suc (length t_twice_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1380
    thm adjust_halt_eq
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1381
    apply(rule_tac stp = stp in adjust_halt_eq)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1382
    apply(simp add: t_twice_compile_def, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1383
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1384
  then obtain stpb where 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1385
    "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1386
    (adjust t_twice_compile) stpb
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1387
     = (Suc (length t_twice_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))" ..
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1388
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1389
    apply(simp add: t_twice_def t_twice_len_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1390
    by metis
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1391
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1392
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1393
lemma [intro]: "length t_wcode_main_first_part mod 2 = 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1394
apply(auto simp: t_wcode_main_first_part_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1395
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1396
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1397
lemma t_twice_append_pre:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1398
  "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_twice stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1399
  = (Suc t_twice_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1400
   \<Longrightarrow> steps0 (Suc 0 + length t_wcode_main_first_part div 2, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1401
     (t_wcode_main_first_part @ shift t_twice (length t_wcode_main_first_part div 2) @
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1402
      ([(L, 1), (L, 1)] @ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)])) stp 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1403
    = (Suc (t_twice_len) + length t_wcode_main_first_part div 2, 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1404
             Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1405
by(rule_tac tm_append_shift_append_steps, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1406
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1407
lemma t_twice_append:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1408
  "\<exists> stp ln rn. steps0 (Suc 0 + length t_wcode_main_first_part div 2, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1409
     (t_wcode_main_first_part @ shift t_twice (length t_wcode_main_first_part div 2) @
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1410
      ([(L, 1), (L, 1)] @ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)])) stp 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1411
    = (Suc (t_twice_len) + length t_wcode_main_first_part div 2, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1412
  using t_twice_change_term_state[of ires rs n]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1413
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1414
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1415
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1416
  apply(drule_tac t_twice_append_pre)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1417
  apply(rule_tac x = stp in exI, rule_tac x = ln in exI, rule_tac x = rn in exI)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1418
  apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1419
  done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1420
  
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1421
lemma mopup_mod2: "length (mopup k) mod 2  = 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1422
apply(auto simp: mopup.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1423
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1424
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1425
lemma [simp]: "fetch t_wcode_main (Suc (t_twice_len + length t_wcode_main_first_part div 2)) Oc
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1426
     = (L, Suc 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1427
apply(subgoal_tac "length (t_twice) mod 2 = 0")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1428
apply(simp add: t_wcode_main_def nth_append fetch.simps t_wcode_main_first_part_def 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1429
  nth_of.simps t_twice_len_def, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1430
apply(simp add: t_twice_def t_twice_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1431
using mopup_mod2[of 1]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1432
apply(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1433
by arith
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1434
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1435
lemma wcode_jump1: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1436
  "\<exists> stp ln rn. steps0 (Suc (t_twice_len) + length t_wcode_main_first_part div 2,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1437
                       Bk\<up>(m) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(n))
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1438
     t_wcode_main stp 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1439
    = (Suc 0, Bk\<up>(ln) @ Bk # ires, Bk # Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1440
apply(rule_tac x = "Suc 0" in exI, rule_tac x = "m" in exI, rule_tac x = n in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1441
apply(simp add: steps.simps step.simps exp_ind)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1442
apply(case_tac m, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1443
apply(simp add: exp_ind[THEN sym])
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1444
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1445
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1446
lemma wcode_main_first_part_len:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1447
  "length t_wcode_main_first_part = 24"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1448
  apply(simp add: t_wcode_main_first_part_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1449
  done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1450
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1451
lemma wcode_double_case: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1452
  shows "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1453
          (Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1454
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1455
  have "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1456
          (13,  Bk # Bk # Bk\<up>(ln) @ Oc # ires, Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1457
    using wcode_double_case_first_correctness[of ires rs m n]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1458
    apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1459
    apply(erule_tac exE)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1460
    apply(case_tac "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1461
           Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main na",
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1462
          auto simp: wcode_double_case_inv.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1463
                     wcode_before_double.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1464
    apply(rule_tac x = na in exI, rule_tac x = ln in exI, rule_tac x = rn in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1465
    apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1466
    done    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1467
  from this obtain stpa lna rna where stp1: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1468
    "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stpa = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1469
    (13, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rna))" by blast
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1470
  have "\<exists> stp ln rn. steps0 (13, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rna)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1471
    (13 + t_twice_len, Bk # Bk # Bk\<up>(ln) @ Oc # ires, Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1472
    using t_twice_append[of "Bk\<up>(lna) @ Oc # ires" "Suc rs" rna]
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1473
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1474
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1475
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1476
    apply(simp add: wcode_main_first_part_len)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1477
    apply(rule_tac x = stp in exI, rule_tac x = "ln + lna" in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1478
          rule_tac x = rn in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1479
    apply(simp add: t_wcode_main_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1480
    apply(simp add: replicate_Suc[THEN sym] exp_add[THEN sym] del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1481
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1482
  from this obtain stpb lnb rnb where stp2: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1483
    "steps0 (13, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rna)) t_wcode_main stpb =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1484
    (13 + t_twice_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires, Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rnb))" by blast
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1485
  have "\<exists>stp ln rn. steps0 (13 + t_twice_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1486
    Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rnb)) t_wcode_main stp = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1487
       (Suc 0,  Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1488
    using wcode_jump1[of lnb "Oc # ires" "Suc rs" rnb]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1489
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1490
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1491
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1492
    apply(rule_tac x = stp in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1493
          rule_tac x = ln in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1494
          rule_tac x = rn in exI, simp add:wcode_main_first_part_len t_wcode_main_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1495
    apply(subgoal_tac "Bk\<up>(lnb) @ Bk # Bk # Oc # ires = Bk # Bk # Bk\<up>(lnb) @ Oc # ires", simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1496
    apply(simp add: replicate_Suc[THEN sym] exp_ind[THEN sym] del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1497
    apply(simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1498
    apply(simp add: replicate_Suc[THEN sym] exp_ind del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1499
    done               
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1500
  from this obtain stpc lnc rnc where stp3: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1501
    "steps0 (13 + t_twice_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1502
    Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rnb)) t_wcode_main stpc = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1503
       (Suc 0,  Bk # Bk\<up>(lnc) @ Oc # ires, Bk # Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rnc))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1504
    by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1505
  from stp1 stp2 stp3 show "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1506
    apply(rule_tac x = "stpa + stpb + stpc" in exI, rule_tac x = lnc in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1507
         rule_tac x = rnc in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1508
    apply(simp add: steps_add)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1509
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1510
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1511
    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1512
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1513
(* Begin: fourtime_case*)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1514
fun wcode_on_left_moving_2_B :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1515
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1516
  "wcode_on_left_moving_2_B ires rs (l, r) =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1517
     (\<exists> ml mr rn. l = Bk\<up>(ml) @ Oc # Bk # Oc # ires \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1518
                 r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and> 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1519
                 ml + mr > Suc 0 \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1520
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1521
fun wcode_on_left_moving_2_O :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1522
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1523
  "wcode_on_left_moving_2_O ires rs (l, r) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1524
     (\<exists> ln rn. l = Bk # Oc # ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1525
               r = Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1526
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1527
fun wcode_on_left_moving_2 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1528
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1529
  "wcode_on_left_moving_2 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1530
      (wcode_on_left_moving_2_B ires rs (l, r) \<or> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1531
      wcode_on_left_moving_2_O ires rs (l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1532
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1533
fun wcode_on_checking_2 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1534
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1535
  "wcode_on_checking_2 ires rs (l, r) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1536
       (\<exists> ln rn. l = Oc#ires \<and> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1537
                 r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1538
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1539
fun wcode_goon_checking :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1540
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1541
  "wcode_goon_checking ires rs (l, r) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1542
       (\<exists> ln rn. l = ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1543
                 r = Oc # Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1544
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1545
fun wcode_right_move :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1546
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1547
  "wcode_right_move ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1548
     (\<exists> ln rn. l = Oc # ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1549
                 r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1550
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1551
fun wcode_erase2 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1552
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1553
  "wcode_erase2 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1554
        (\<exists> ln rn. l = Bk # Oc # ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1555
                 tl r = Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1556
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1557
fun wcode_on_right_moving_2 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1558
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1559
  "wcode_on_right_moving_2 ires rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1560
        (\<exists> ml mr rn. l = Bk\<up>(ml) @ Oc # ires \<and> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1561
                     r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and> ml + mr > Suc 0)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1562
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1563
fun wcode_goon_right_moving_2 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1564
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1565
  "wcode_goon_right_moving_2 ires rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1566
        (\<exists> ml mr ln rn. l = Oc\<up>(ml) @ Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1567
                        r = Oc\<up>(mr) @ Bk\<up>(rn) \<and> ml + mr = Suc rs)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1568
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1569
fun wcode_backto_standard_pos_2_B :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1570
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1571
  "wcode_backto_standard_pos_2_B ires rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1572
           (\<exists> ln rn. l = Bk # Bk\<up>(ln) @ Oc # ires \<and> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1573
                     r = Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1574
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1575
fun wcode_backto_standard_pos_2_O :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1576
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1577
  "wcode_backto_standard_pos_2_O ires rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1578
          (\<exists> ml mr ln rn. l = Oc\<up>(ml )@ Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1579
                          r = Oc\<up>(mr) @ Bk\<up>(rn) \<and> 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1580
                          ml + mr = (Suc (Suc rs)) \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1581
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1582
fun wcode_backto_standard_pos_2 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1583
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1584
  "wcode_backto_standard_pos_2 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1585
           (wcode_backto_standard_pos_2_O ires rs (l, r) \<or> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1586
           wcode_backto_standard_pos_2_B ires rs (l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1587
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1588
fun wcode_before_fourtimes :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1589
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1590
  "wcode_before_fourtimes ires rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1591
          (\<exists> ln rn. l = Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1592
                    r = Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1593
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1594
declare wcode_on_left_moving_2_B.simps[simp del] wcode_on_left_moving_2.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1595
        wcode_on_left_moving_2_O.simps[simp del] wcode_on_checking_2.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1596
        wcode_goon_checking.simps[simp del] wcode_right_move.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1597
        wcode_erase2.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1598
        wcode_on_right_moving_2.simps[simp del] wcode_goon_right_moving_2.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1599
        wcode_backto_standard_pos_2_B.simps[simp del] wcode_backto_standard_pos_2_O.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1600
        wcode_backto_standard_pos_2.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1601
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1602
lemmas wcode_fourtimes_invs = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1603
       wcode_on_left_moving_2_B.simps wcode_on_left_moving_2.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1604
        wcode_on_left_moving_2_O.simps wcode_on_checking_2.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1605
        wcode_goon_checking.simps wcode_right_move.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1606
        wcode_erase2.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1607
        wcode_on_right_moving_2.simps wcode_goon_right_moving_2.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1608
        wcode_backto_standard_pos_2_B.simps wcode_backto_standard_pos_2_O.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1609
        wcode_backto_standard_pos_2.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1610
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1611
fun wcode_fourtimes_case_inv :: "nat \<Rightarrow> bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1612
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1613
  "wcode_fourtimes_case_inv st ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1614
           (if st = Suc 0 then wcode_on_left_moving_2 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1615
            else if st = Suc (Suc 0) then wcode_on_checking_2 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1616
            else if st = 7 then wcode_goon_checking ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1617
            else if st = 8 then wcode_right_move ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1618
            else if st = 9 then wcode_erase2 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1619
            else if st = 10 then wcode_on_right_moving_2 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1620
            else if st = 11 then wcode_goon_right_moving_2 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1621
            else if st = 12 then wcode_backto_standard_pos_2 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1622
            else if st = t_twice_len + 14 then wcode_before_fourtimes ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1623
            else False)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1624
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1625
declare wcode_fourtimes_case_inv.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1626
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1627
fun wcode_fourtimes_case_state :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1628
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1629
  "wcode_fourtimes_case_state (st, l, r) = 13 - st"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1630
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1631
fun wcode_fourtimes_case_step :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1632
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1633
  "wcode_fourtimes_case_step (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1634
         (if st = Suc 0 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1635
          else if st = 9 then 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1636
           (if hd r = Oc then 1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1637
            else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1638
          else if st = 10 then length r
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1639
          else if st = 11 then length r
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1640
          else if st = 12 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1641
          else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1642
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1643
fun wcode_fourtimes_case_measure :: "config \<Rightarrow> nat \<times> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1644
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1645
  "wcode_fourtimes_case_measure (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1646
     (wcode_fourtimes_case_state (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1647
      wcode_fourtimes_case_step (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1648
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1649
definition wcode_fourtimes_case_le :: "(config \<times> config) set"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1650
  where "wcode_fourtimes_case_le \<equiv> (inv_image lex_pair wcode_fourtimes_case_measure)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1651
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1652
lemma wf_wcode_fourtimes_case_le[intro]: "wf wcode_fourtimes_case_le"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1653
by(auto intro:wf_inv_image simp: wcode_fourtimes_case_le_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1654
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1655
lemma [simp]: "fetch t_wcode_main (Suc (Suc 0)) Bk = (L, 7)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1656
apply(simp add: t_wcode_main_def fetch.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1657
  t_wcode_main_first_part_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1658
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1659
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1660
lemma [simp]: "fetch t_wcode_main 7 Oc = (R, 8)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1661
apply(subgoal_tac "7 = Suc 6")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1662
apply(simp only: t_wcode_main_def fetch.simps 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1663
  t_wcode_main_first_part_def nth_of.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1664
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1665
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1666
 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1667
lemma [simp]: "fetch t_wcode_main 8 Bk = (R, 9)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1668
apply(subgoal_tac "8 = Suc 7")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1669
apply(simp only: t_wcode_main_def fetch.simps 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1670
  t_wcode_main_first_part_def nth_of.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1671
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1672
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1673
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1674
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1675
lemma [simp]: "fetch t_wcode_main 9 Bk = (R, 10)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1676
apply(subgoal_tac "9 = Suc 8")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1677
apply(simp only: t_wcode_main_def fetch.simps 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1678
  t_wcode_main_first_part_def nth_of.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1679
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1680
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1681
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1682
lemma [simp]: "fetch t_wcode_main 9 Oc = (W0, 9)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1683
apply(subgoal_tac "9 = Suc 8")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1684
apply(simp only: t_wcode_main_def fetch.simps 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1685
  t_wcode_main_first_part_def nth_of.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1686
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1687
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1688
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1689
lemma [simp]: "fetch t_wcode_main 10 Bk = (R, 10)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1690
apply(subgoal_tac "10 = Suc 9")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1691
apply(simp only: t_wcode_main_def fetch.simps 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1692
  t_wcode_main_first_part_def nth_of.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1693
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1694
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1695
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1696
lemma [simp]: "fetch t_wcode_main 10 Oc = (R, 11)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1697
apply(subgoal_tac "10 = Suc 9")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1698
apply(simp only: t_wcode_main_def fetch.simps 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1699
  t_wcode_main_first_part_def nth_of.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1700
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1701
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1702
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1703
lemma [simp]: "fetch t_wcode_main 11 Bk = (W1, 12)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1704
apply(subgoal_tac "11 = Suc 10")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1705
apply(simp only: t_wcode_main_def fetch.simps 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1706
  t_wcode_main_first_part_def nth_of.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1707
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1708
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1709
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1710
lemma [simp]: "fetch t_wcode_main 11 Oc = (R, 11)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1711
apply(subgoal_tac "11 = Suc 10")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1712
apply(simp only: t_wcode_main_def fetch.simps 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1713
  t_wcode_main_first_part_def nth_of.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1714
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1715
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1716
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1717
lemma [simp]: "fetch t_wcode_main 12 Oc = (L, 12)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1718
apply(subgoal_tac "12 = Suc 11")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1719
apply(simp only: t_wcode_main_def fetch.simps 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1720
  t_wcode_main_first_part_def nth_of.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1721
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1722
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1723
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1724
lemma [simp]: "fetch t_wcode_main 12 Bk = (R, t_twice_len + 14)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1725
apply(subgoal_tac "12 = Suc 11")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1726
apply(simp only: t_wcode_main_def fetch.simps 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1727
  t_wcode_main_first_part_def nth_of.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1728
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1729
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1730
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1731
lemma [simp]: "wcode_on_left_moving_2 ires rs (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1732
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1733
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1734
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1735
lemma [simp]: "wcode_on_checking_2 ires rs (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1736
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1737
done          
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1738
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1739
lemma [simp]: "wcode_goon_checking ires rs (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1740
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1741
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1742
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1743
lemma [simp]: "wcode_right_move ires rs (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1744
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1745
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1746
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1747
lemma [simp]: "wcode_erase2 ires rs (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1748
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1749
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1750
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1751
lemma [simp]: "wcode_on_right_moving_2 ires rs (b, []) = False"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1752
apply(auto simp: wcode_fourtimes_invs)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1753
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1754
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1755
lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, []) = False"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1756
apply(auto simp: wcode_fourtimes_invs)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1757
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1758
    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1759
lemma [simp]: "wcode_on_left_moving_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1760
apply(simp add: wcode_fourtimes_invs, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1761
done     
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1762
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1763
lemma [simp]: "wcode_on_left_moving_2 ires rs (b, Bk # list) \<Longrightarrow>  wcode_on_left_moving_2 ires rs (tl b, hd b # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1764
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1765
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1766
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1767
apply(case_tac ml, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1768
apply(rule_tac x = "mr - (Suc (Suc 0))" in exI, rule_tac x = rn in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1769
apply(case_tac mr, simp, case_tac nat, simp, simp add: exp_ind del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1770
apply(rule_tac disjI1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1771
apply(rule_tac x = nat in exI, rule_tac x = "Suc mr" in exI, rule_tac x = rn in exI,
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1772
      simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1773
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1774
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1775
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1776
lemma [simp]: "wcode_on_checking_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1777
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1778
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1779
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1780
lemma  [simp]: "wcode_on_checking_2 ires rs (b, Bk # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1781
       \<Longrightarrow>   wcode_goon_checking ires rs (tl b, hd b # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1782
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1783
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1784
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1785
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1786
lemma [simp]: "wcode_goon_checking ires rs (b, Bk # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1787
apply(simp add: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1788
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1789
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1790
lemma [simp]: " wcode_right_move ires rs (b, Bk # list) \<Longrightarrow> b\<noteq> []" 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1791
apply(simp add: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1792
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1793
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1794
lemma [simp]: "wcode_right_move ires rs (b, Bk # list) \<Longrightarrow>  wcode_erase2 ires rs (Bk # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1795
apply(auto simp:wcode_fourtimes_invs )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1796
apply(rule_tac x = ln in exI, rule_tac x = rn in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1797
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1798
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1799
lemma [simp]: "wcode_erase2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1800
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1801
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1802
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1803
lemma [simp]: "wcode_erase2 ires rs (b, Bk # list) \<Longrightarrow> wcode_on_right_moving_2 ires rs (Bk # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1804
apply(auto simp:wcode_fourtimes_invs )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1805
apply(rule_tac x = "Suc (Suc 0)" in exI, simp add: exp_ind)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1806
apply(rule_tac x =  "Suc (Suc ln)" in exI, simp add: exp_ind del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1807
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1808
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1809
lemma [simp]: "wcode_on_right_moving_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1810
apply(auto simp:wcode_fourtimes_invs )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1811
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1812
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1813
lemma [simp]: "wcode_on_right_moving_2 ires rs (b, Bk # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1814
       \<Longrightarrow> wcode_on_right_moving_2 ires rs (Bk # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1815
apply(auto simp: wcode_fourtimes_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1816
apply(rule_tac x = "Suc ml" in exI, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1817
apply(rule_tac x = "mr - 1" in exI, case_tac mr,auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1818
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1819
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1820
lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1821
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1822
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1823
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1824
lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, Bk # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1825
                 wcode_backto_standard_pos_2 ires rs (b, Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1826
apply(simp add: wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1827
apply(rule_tac x = ml in exI, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1828
apply(rule_tac x = "Suc 0" in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1829
apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1830
apply(rule_tac x = "rn - 1" in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1831
apply(case_tac rn, simp, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1832
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1833
   
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1834
lemma  [simp]: "wcode_backto_standard_pos_2 ires rs (b, Bk # list) \<Longrightarrow>  b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1835
apply(simp add: wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1836
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1837
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1838
lemma [simp]: "wcode_on_left_moving_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1839
apply(simp add: wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1840
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1841
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1842
lemma [simp]: "wcode_on_left_moving_2 ires rs (b, Oc # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1843
                     wcode_on_checking_2 ires rs (tl b, hd b # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1844
apply(auto simp: wcode_fourtimes_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1845
apply(case_tac [!] mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1846
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1847
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1848
lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, []) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1849
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1850
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1851
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1852
lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, []) \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1853
              wcode_backto_standard_pos_2 ires rs (b, [Oc])"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1854
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1855
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1856
apply(rule_tac disjI1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1857
apply(rule_tac x = ml in exI, rule_tac x = "Suc 0" in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1858
      rule_tac x = ln in exI, rule_tac x = rn in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1859
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1860
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1861
lemma "wcode_backto_standard_pos_2 ires rs (b, Bk # list)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1862
       \<Longrightarrow> (\<exists>ln. b = Bk # Bk\<up>(ln) @ Oc # ires) \<and> (\<exists>rn. list = Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1863
apply(auto simp: wcode_fourtimes_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1864
apply(case_tac [!] mr, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1865
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1866
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1867
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1868
lemma [simp]: "wcode_on_checking_2 ires rs (b, Oc # list) \<Longrightarrow> False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1869
apply(simp add: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1870
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1871
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1872
lemma [simp]: "wcode_goon_checking ires rs (b, Oc # list) \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1873
  (b = [] \<longrightarrow> wcode_right_move ires rs ([Oc], list)) \<and>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1874
  (b \<noteq> [] \<longrightarrow> wcode_right_move ires rs (Oc # b, list))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1875
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1876
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1877
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1878
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1879
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1880
lemma [simp]: "wcode_right_move ires rs (b, Oc # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1881
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1882
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1883
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1884
lemma [simp]: " wcode_erase2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1885
apply(simp add: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1886
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1887
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1888
lemma [simp]: "wcode_erase2 ires rs (b, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1889
       \<Longrightarrow> wcode_erase2 ires rs (b, Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1890
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1891
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1892
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1893
lemma [simp]: "wcode_on_right_moving_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1894
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1895
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1896
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1897
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1898
lemma [simp]: "wcode_on_right_moving_2 ires rs (b, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1899
       \<Longrightarrow> wcode_goon_right_moving_2 ires rs (Oc # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1900
apply(auto simp: wcode_fourtimes_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1901
apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1902
apply(rule_tac x = "Suc 0" in exI, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1903
apply(rule_tac x = "ml - 2" in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1904
apply(case_tac ml, simp, case_tac nat, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1905
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1906
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1907
lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1908
apply(simp only:wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1909
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1910
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1911
lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, Bk # list)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1912
       \<Longrightarrow> (\<exists>ln. b = Bk # Bk\<up>(ln) @ Oc # ires) \<and> (\<exists>rn. list = Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1913
apply(simp add: wcode_fourtimes_invs, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1914
apply(case_tac [!] mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1915
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1916
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1917
lemma [simp]: "wcode_on_checking_2 ires rs (b, Oc # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1918
apply(simp add: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1919
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1920
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1921
lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, Oc # list) \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1922
       wcode_goon_right_moving_2 ires rs (Oc # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1923
apply(simp only:wcode_fourtimes_invs, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1924
apply(rule_tac x = "Suc ml" in exI, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1925
apply(rule_tac x = "mr - 1" in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1926
apply(case_tac mr, case_tac rn, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1927
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1928
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1929
lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1930
apply(simp only: wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1931
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1932
 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1933
lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, Oc # list)    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1934
            \<Longrightarrow> wcode_backto_standard_pos_2 ires rs (tl b, hd b # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1935
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1936
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1937
apply(erule_tac exE)+
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1938
apply(case_tac ml, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1939
apply(rule_tac x = nat in exI, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1940
apply(rule_tac x = "Suc mr" in exI, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1941
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1942
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1943
lemma wcode_fourtimes_case_first_correctness:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1944
 shows "let P = (\<lambda> (st, l, r). st = t_twice_len + 14) in 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1945
  let Q = (\<lambda> (st, l, r). wcode_fourtimes_case_inv st ires rs (l, r)) in 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1946
  let f = (\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp) in
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1947
  \<exists> n .P (f n) \<and> Q (f (n::nat))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1948
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1949
  let ?P = "(\<lambda> (st, l, r). st = t_twice_len + 14)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1950
  let ?Q = "(\<lambda> (st, l, r). wcode_fourtimes_case_inv st ires rs (l, r))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1951
  let ?f = "(\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1952
  have "\<exists> n . ?P (?f n) \<and> ?Q (?f (n::nat))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1953
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1954
    show "wf wcode_fourtimes_case_le"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1955
      by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1956
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1957
    show "\<forall> na. \<not> ?P (?f na) \<and> ?Q (?f na) \<longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1958
                  ?Q (?f (Suc na)) \<and> (?f (Suc na), ?f na) \<in> wcode_fourtimes_case_le"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1959
    apply(rule_tac allI,
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1960
     case_tac "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main na", simp,
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1961
     rule_tac impI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1962
    apply(simp add: step_red step.simps, case_tac c, simp, case_tac [2] aa, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1963
    apply(simp_all add: wcode_fourtimes_case_inv.simps
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1964
                        wcode_fourtimes_case_le_def lex_pair_def split: if_splits)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1965
    apply(auto simp: wcode_backto_standard_pos_2.simps wcode_backto_standard_pos_2_O.simps
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1966
      wcode_backto_standard_pos_2_B.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1967
    apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1968
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1969
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1970
    show "?Q (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1971
      apply(simp add: steps.simps wcode_fourtimes_case_inv.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1972
      apply(simp add: wcode_on_left_moving_2.simps wcode_on_left_moving_2_B.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1973
                      wcode_on_left_moving_2_O.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1974
      apply(rule_tac x = "Suc m" in exI, simp )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1975
      apply(rule_tac x ="Suc 0" in exI, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1976
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1977
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1978
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1979
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1980
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1981
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1982
  thus "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1983
    apply(erule_tac exE, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1984
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1985
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1986
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1987
definition t_fourtimes_len :: "nat"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1988
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1989
  "t_fourtimes_len = (length t_fourtimes div 2)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1990
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1991
lemma t_fourtimes_len_gr:  "t_fourtimes_len > 0"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1992
apply(simp add: t_fourtimes_len_def t_fourtimes_def mopup.simps t_fourtimes_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1993
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1994
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1995
lemma [intro]: "rec_calc_rel (constn 4) [rs] 4"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1996
using prime_rel_exec_eq[of "constn 4" "[rs]" 4]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1997
apply(subgoal_tac "primerec (constn 4) 1", auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1998
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1999
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2000
lemma [intro]: "rec_calc_rel rec_mult [rs, 4] (4 * rs)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2001
using prime_rel_exec_eq[of "rec_mult" "[rs, 4]"  "4*rs"]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2002
apply(subgoal_tac "primerec rec_mult 2", auto simp: numeral_2_eq_2)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2003
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2004
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2005
lemma t_fourtimes_correct: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2006
  "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2007
    (tm_of abc_fourtimes @ shift (mopup 1) (length (tm_of abc_fourtimes) div 2)) stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2008
       (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2009
proof(case_tac "rec_ci rec_fourtimes")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2010
  fix a b c
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2011
  assume h: "rec_ci rec_fourtimes = (a, b, c)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2012
  have "\<exists>stp m l. steps0 (Suc 0, Bk # Bk # ires, <[rs]> @ Bk\<up>(n)) (tm_of abc_fourtimes @ shift (mopup 1) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2013
    (length (tm_of abc_fourtimes) div 2)) stp = (0, Bk\<up>(m) @ Bk # Bk # ires, Oc\<up>(Suc (4*rs)) @ Bk\<up>(l))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2014
  proof(rule_tac recursive_compile_to_tm_correct)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2015
    show "rec_ci rec_fourtimes = (a, b, c)" by (simp add: h)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2016
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2017
    show "rec_calc_rel rec_fourtimes [rs] (4 * rs)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2018
      apply(simp add: rec_fourtimes_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2019
      apply(rule_tac rs =  "[rs, 4]" in calc_cn, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2020
      apply(rule_tac allI, case_tac k, auto simp: mult_lemma)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2021
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2022
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2023
    show "length [rs] = 1" by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2024
  next	
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2025
    show "layout_of (a [+] dummy_abc 1) = layout_of (a [+] dummy_abc 1)" by simp
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2026
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2027
    show "tm_of abc_fourtimes = tm_of (a [+] dummy_abc 1)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2028
      using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2029
      apply(simp add: abc_fourtimes_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2030
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2031
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2032
  thus "?thesis"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  2033
    apply(simp add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2034
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2035
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2036
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2037
lemma wf_fourtimes[intro]: "tm_wf (t_fourtimes_compile, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2038
apply(simp only: t_fourtimes_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2039
apply(rule_tac t_compiled_correct)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2040
apply(simp_all add: abc_twice_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2041
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2042
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2043
lemma t_fourtimes_change_term_state:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2044
  "\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_fourtimes stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2045
     = (Suc t_fourtimes_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2046
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2047
  have "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2048
    (tm_of abc_fourtimes @ shift (mopup 1) ((length (tm_of abc_fourtimes) div 2))) stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2049
    (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2050
    by(rule_tac t_fourtimes_correct)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2051
  then obtain stp ln rn where 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2052
    "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2053
    (tm_of abc_fourtimes @ shift (mopup 1) ((length (tm_of abc_fourtimes) div 2))) stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2054
    (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))" by blast
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2055
  hence "\<exists> stp. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2056
    (adjust t_fourtimes_compile) stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2057
     = (Suc (length t_fourtimes_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2058
    apply(rule_tac stp = stp in adjust_halt_eq)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2059
    apply(simp add: t_fourtimes_compile_def, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2060
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2061
  then obtain stpb where 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2062
    "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2063
    (adjust t_fourtimes_compile) stpb
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2064
     = (Suc (length t_fourtimes_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))" ..
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2065
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2066
    apply(simp add: t_fourtimes_def t_fourtimes_len_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2067
    by metis
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2068
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2069
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2070
lemma [intro]: "length t_twice mod 2 = 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2071
apply(auto simp: t_twice_def t_twice_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2072
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2073
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2074
lemma t_fourtimes_append_pre:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2075
  "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_fourtimes stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2076
  = (Suc t_fourtimes_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2077
   \<Longrightarrow> steps0 (Suc 0 + length (t_wcode_main_first_part @ 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2078
              shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2079
       Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2080
     ((t_wcode_main_first_part @ 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2081
  shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) @ 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2082
  shift t_fourtimes (length (t_wcode_main_first_part @ 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2083
  shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2) @ ([(L, 1), (L, 1)])) stp 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2084
  = ((Suc t_fourtimes_len) + length (t_wcode_main_first_part @ 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2085
  shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2086
  Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2087
apply(rule_tac tm_append_shift_append_steps, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2088
apply(auto simp: t_wcode_main_first_part_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2089
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2090
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2091
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2092
lemma [simp]: "length t_wcode_main_first_part = 24"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2093
apply(simp add: t_wcode_main_first_part_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2094
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2095
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2096
lemma [simp]: "(26 + length t_twice) div 2 = (length t_twice) div 2 + 13"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2097
apply(simp add: t_twice_def t_twice_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2098
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2099
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2100
lemma [simp]: "((26 + length (shift t_twice 12)) div 2)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2101
             = (length (shift t_twice 12) div 2 + 13)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2102
apply(simp add: t_twice_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2103
done 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2104
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2105
lemma [simp]: "t_twice_len + 14 =  14 + length (shift t_twice 12) div 2"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2106
apply(simp add: t_twice_def t_twice_len_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2107
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2108
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2109
lemma t_fourtimes_append:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2110
  "\<exists> stp ln rn. 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2111
  steps0 (Suc 0 + length (t_wcode_main_first_part @ shift t_twice
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2112
  (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2, 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2113
  Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2114
  ((t_wcode_main_first_part @ shift t_twice (length t_wcode_main_first_part div 2) @
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2115
  [(L, 1), (L, 1)]) @ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)]) stp 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2116
  = (Suc t_fourtimes_len + length (t_wcode_main_first_part @ shift t_twice
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2117
  (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2, Bk\<up>(ln) @ Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2118
                                                                 Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2119
  using t_fourtimes_change_term_state[of ires rs n]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2120
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2121
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2122
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2123
  apply(drule_tac t_fourtimes_append_pre)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2124
  apply(rule_tac x = stp in exI, rule_tac x = ln in exI, rule_tac x = rn in exI)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2125
  apply(simp add: t_twice_len_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2126
  done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2127
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2128
lemma t_wcode_main_len: "length t_wcode_main = length t_twice + length t_fourtimes + 28"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2129
apply(simp add: t_wcode_main_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2130
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2132
lemma even_twice_len: "length t_twice mod 2 = 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2133
apply(auto simp: t_twice_def t_twice_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2134
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2135
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2136
lemma even_fourtimes_len: "length t_fourtimes mod 2 = 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2137
apply(auto simp: t_fourtimes_def t_fourtimes_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2138
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2139
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2140
lemma [simp]: "2 * (length t_twice div 2) = length t_twice"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2141
using even_twice_len
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2142
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2143
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2144
lemma [simp]: "2 * (length t_fourtimes div 2) = length t_fourtimes"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2145
using even_fourtimes_len
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2146
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2147
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2148
lemma [simp]: "fetch t_wcode_main (14 + length t_twice div 2 + t_fourtimes_len) Oc
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2149
             = (L, Suc 0)" 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2150
apply(subgoal_tac "14 = Suc 13")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2151
apply(simp only: fetch.simps add_Suc nth_of.simps t_wcode_main_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2152
apply(simp add:length_append length_shift Parity.two_times_even_div_two even_twice_len t_fourtimes_len_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2153
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2154
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2155
lemma [simp]: "fetch t_wcode_main (14 + length t_twice div 2 + t_fourtimes_len) Bk
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2156
             = (L, Suc 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2157
apply(subgoal_tac "14 = Suc 13")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2158
apply(simp only: fetch.simps add_Suc nth_of.simps t_wcode_main_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2159
apply(simp add:length_append length_shift Parity.two_times_even_div_two even_twice_len t_fourtimes_len_def nth_append)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2160
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2161
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2162
lemma [simp]: "fetch t_wcode_main (14 + length t_twice div 2 + t_fourtimes_len) b
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2163
             = (L, Suc 0)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2164
apply(case_tac b, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2165
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2166
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2167
lemma wcode_jump2: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2168
  "\<exists> stp ln rn. steps0 (t_twice_len + 14 + t_fourtimes_len
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2169
  , Bk # Bk # Bk\<up>(lnb) @ Oc # ires, Oc\<up>(Suc (4 * rs + 4)) @ Bk\<up>(rnb)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2170
  (Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (4 * rs + 4)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2171
apply(rule_tac x = "Suc 0" in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2172
apply(simp add: steps.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2173
apply(rule_tac x = lnb in exI, rule_tac x = rnb in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2174
apply(simp add: step.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2175
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2176
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2177
lemma wcode_fourtimes_case:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2178
  shows "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2179
  steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2180
  (Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2181
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2182
  have "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2183
  steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2184
  (t_twice_len + 14, Bk # Bk # Bk\<up>(ln) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2185
    using wcode_fourtimes_case_first_correctness[of ires rs m n]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2186
    apply(simp add: wcode_fourtimes_case_inv.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2187
    apply(rule_tac x = na in exI, rule_tac x = ln in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2188
          rule_tac x = rn in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2189
    apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2190
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2191
  from this obtain stpa lna rna where stp1:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2192
    "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stpa =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2193
  (t_twice_len + 14, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rna))" by blast
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2194
  have "\<exists>stp ln rn. steps0 (t_twice_len + 14, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rna))
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2195
                     t_wcode_main stp =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2196
          (t_twice_len + 14 + t_fourtimes_len, Bk # Bk # Bk\<up>(ln) @ Oc # ires,  Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2197
    using t_fourtimes_append[of " Bk\<up>(lna) @ Oc # ires" "rs + 1" rna]
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2198
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2199
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2200
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2201
    apply(simp add: t_wcode_main_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2202
    apply(rule_tac x = stp in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2203
          rule_tac x = "ln + lna" in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2204
          rule_tac x = rn in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2205
    apply(simp add: replicate_Suc[THEN sym] exp_add[THEN sym] del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2206
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2207
  from this obtain stpb lnb rnb where stp2:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2208
    "steps0 (t_twice_len + 14, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rna))
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2209
                     t_wcode_main stpb =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2210
       (t_twice_len + 14 + t_fourtimes_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires,  Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnb))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2211
    by blast
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2212
  have "\<exists>stp ln rn. steps0 (t_twice_len + 14 + t_fourtimes_len,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2213
    Bk # Bk # Bk\<up>(lnb) @ Oc # ires,  Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnb))
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2214
    t_wcode_main stp =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2215
    (Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2216
    apply(rule wcode_jump2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2217
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2218
  from this obtain stpc lnc rnc where stp3: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2219
    "steps0 (t_twice_len + 14 + t_fourtimes_len,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2220
    Bk # Bk # Bk\<up>(lnb) @ Oc # ires,  Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnb))
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2221
    t_wcode_main stpc =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2222
    (Suc 0, Bk # Bk\<up>(lnc) @ Oc # ires, Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnc))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2223
    by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2224
  from stp1 stp2 stp3 show "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2225
    apply(rule_tac x = "stpa + stpb + stpc" in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2226
          rule_tac x = lnc in exI, rule_tac x = rnc in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2227
    apply(simp add: steps_add)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2228
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2229
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2230
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2231
(**********************************************************)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2232
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2233
fun wcode_on_left_moving_3_B :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2234
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2235
  "wcode_on_left_moving_3_B ires rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2236
       (\<exists> ml mr rn. l = Bk\<up>(ml) @ Oc # Bk # Bk # ires \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2237
                    r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and> 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2238
                    ml + mr > Suc 0 \<and> mr > 0 )"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2239
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2240
fun wcode_on_left_moving_3_O :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2241
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2242
  "wcode_on_left_moving_3_O ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2243
         (\<exists> ln rn. l = Bk # Bk # ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2244
                   r = Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2245
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2246
fun wcode_on_left_moving_3 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2247
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2248
  "wcode_on_left_moving_3 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2249
       (wcode_on_left_moving_3_B ires rs (l, r) \<or>  
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2250
        wcode_on_left_moving_3_O ires rs (l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2251
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2252
fun wcode_on_checking_3 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2253
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2254
  "wcode_on_checking_3 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2255
         (\<exists> ln rn. l = Bk # ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2256
             r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2257
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2258
fun wcode_goon_checking_3 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2259
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2260
  "wcode_goon_checking_3 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2261
         (\<exists> ln rn. l = ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2262
             r = Bk # Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2263
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2264
fun wcode_stop :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2265
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2266
  "wcode_stop ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2267
          (\<exists> ln rn. l = Bk # ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2268
             r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2269
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2270
fun wcode_halt_case_inv :: "nat \<Rightarrow> bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2271
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2272
  "wcode_halt_case_inv st ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2273
          (if st = 0 then wcode_stop ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2274
           else if st = Suc 0 then wcode_on_left_moving_3 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2275
           else if st = Suc (Suc 0) then wcode_on_checking_3 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2276
           else if st = 7 then wcode_goon_checking_3 ires rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2277
           else False)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2278
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2279
fun wcode_halt_case_state :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2280
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2281
  "wcode_halt_case_state (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2282
           (if st = 1 then 5
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2283
            else if st = Suc (Suc 0) then 4
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2284
            else if st = 7 then 3
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2285
            else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2286
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2287
fun wcode_halt_case_step :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2288
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2289
  "wcode_halt_case_step (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2290
         (if st = 1 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2291
         else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2292
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2293
fun wcode_halt_case_measure :: "config \<Rightarrow> nat \<times> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2294
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2295
  "wcode_halt_case_measure (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2296
     (wcode_halt_case_state (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2297
      wcode_halt_case_step (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2298
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2299
definition wcode_halt_case_le :: "(config \<times> config) set"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2300
  where "wcode_halt_case_le \<equiv> (inv_image lex_pair wcode_halt_case_measure)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2301
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2302
lemma wf_wcode_halt_case_le[intro]: "wf wcode_halt_case_le"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2303
by(auto intro:wf_inv_image simp: wcode_halt_case_le_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2304
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2305
declare wcode_on_left_moving_3_B.simps[simp del] wcode_on_left_moving_3_O.simps[simp del]  
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2306
        wcode_on_checking_3.simps[simp del] wcode_goon_checking_3.simps[simp del] 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2307
        wcode_on_left_moving_3.simps[simp del] wcode_stop.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2308
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2309
lemmas wcode_halt_invs = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2310
  wcode_on_left_moving_3_B.simps wcode_on_left_moving_3_O.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2311
  wcode_on_checking_3.simps wcode_goon_checking_3.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2312
  wcode_on_left_moving_3.simps wcode_stop.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2313
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2314
lemma [simp]: "fetch t_wcode_main 7 Bk = (R, 0)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2315
apply(subgoal_tac "7 = Suc 6")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2316
apply(simp only: fetch.simps t_wcode_main_def nth_append nth_of.simps
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2317
                t_wcode_main_first_part_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2318
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2319
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2320
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2321
lemma [simp]: "wcode_on_left_moving_3 ires rs (b, [])  = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2322
apply(simp only: wcode_halt_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2323
apply(simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2324
done    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2325
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2326
lemma [simp]: "wcode_on_checking_3 ires rs (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2327
apply(simp add: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2328
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2329
              
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2330
lemma [simp]: "wcode_goon_checking_3 ires rs (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2331
apply(simp add: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2332
done 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2333
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2334
lemma [simp]: "wcode_on_left_moving_3 ires rs (b, Bk # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2335
 \<Longrightarrow> wcode_on_left_moving_3 ires rs (tl b, hd b # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2336
apply(simp only: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2337
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2338
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2339
apply(case_tac ml, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2340
apply(rule_tac x = "mr - 2" in exI, rule_tac x = rn in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2341
apply(case_tac mr, simp, simp add: exp_ind del: replicate_Suc)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2342
apply(case_tac nat, simp, simp add: exp_ind del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2343
apply(rule_tac disjI1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2344
apply(rule_tac x = nat in exI, rule_tac x = "Suc mr" in exI, 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2345
      rule_tac x = rn in exI, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2346
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2347
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2348
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2349
lemma [simp]: "wcode_goon_checking_3 ires rs (b, Bk # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2350
  (b = [] \<longrightarrow> wcode_stop ires rs ([Bk], list)) \<and>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2351
  (b \<noteq> [] \<longrightarrow> wcode_stop ires rs (Bk # b, list))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2352
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2353
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2354
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2355
lemma [simp]: "wcode_on_left_moving_3 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2356
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2357
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2358
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2359
lemma [simp]: "wcode_on_left_moving_3 ires rs (b, Oc # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2360
               wcode_on_checking_3 ires rs (tl b, hd b # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2361
apply(simp add:wcode_halt_invs, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2362
apply(case_tac [!] mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2363
done     
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2364
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2365
lemma [simp]: "wcode_on_checking_3 ires rs (b, Oc # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2366
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2367
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2368
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2369
lemma [simp]: "wcode_on_left_moving_3 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2370
apply(simp add: wcode_halt_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2371
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2372
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2373
lemma [simp]: "wcode_on_checking_3 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2374
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2375
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2376
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2377
lemma [simp]: "wcode_on_checking_3 ires rs (b, Bk # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2378
  wcode_goon_checking_3 ires rs (tl b, hd b # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2379
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2380
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2381
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2382
lemma [simp]: "wcode_goon_checking_3 ires rs (b, Oc # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2383
apply(simp add: wcode_goon_checking_3.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2384
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2385
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2386
lemma t_halt_case_correctness: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2387
shows "let P = (\<lambda> (st, l, r). st = 0) in 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2388
       let Q = (\<lambda> (st, l, r). wcode_halt_case_inv st ires rs (l, r)) in 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2389
       let f = (\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp) in
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2390
       \<exists> n .P (f n) \<and> Q (f (n::nat))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2391
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2392
  let ?P = "(\<lambda> (st, l, r). st = 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2393
  let ?Q = "(\<lambda> (st, l, r). wcode_halt_case_inv st ires rs (l, r))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2394
  let ?f = "(\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2395
  have "\<exists> n. ?P (?f n) \<and> ?Q (?f (n::nat))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2396
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2397
    show "wf wcode_halt_case_le" by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2398
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2399
    show "\<forall> na. \<not> ?P (?f na) \<and> ?Q (?f na) \<longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2400
                    ?Q (?f (Suc na)) \<and> (?f (Suc na), ?f na) \<in> wcode_halt_case_le"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2401
      apply(rule_tac allI, rule_tac impI, case_tac "?f na")
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2402
      apply(simp add: step_red step.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2403
      apply(case_tac c, simp, case_tac [2] aa)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2404
      apply(simp_all split: if_splits add: wcode_halt_case_le_def lex_pair_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2405
      done      
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2406
  next 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2407
    show "?Q (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2408
      apply(simp add: steps.simps wcode_halt_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2409
      apply(rule_tac x = "Suc m" in exI, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2410
      apply(rule_tac x = "Suc 0" in exI, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2411
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2412
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2413
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2414
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2415
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2416
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2417
  thus "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2418
    apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2419
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2420
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2421
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2422
declare wcode_halt_case_inv.simps[simp del]
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2423
lemma [intro]: "\<exists> xs. (<rev list @ [aa::nat]> :: cell list) = Oc # xs"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2424
apply(case_tac "rev list", simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2425
apply(simp add: tape_of_nl_cons)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2426
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2427
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2428
lemma wcode_halt_case:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2429
  "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n))
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2430
  t_wcode_main stp  = (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2431
  using t_halt_case_correctness[of ires rs m n]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2432
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2433
apply(erule_tac exE)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2434
apply(case_tac "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2435
                Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main na")
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2436
apply(auto simp: wcode_halt_case_inv.simps wcode_stop.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2437
apply(rule_tac x = na in exI, rule_tac x = ln in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2438
      rule_tac x = rn in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2439
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2440
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2441
lemma bl_bin_one: "bl_bin [Oc] =  Suc 0"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2442
apply(simp add: bl_bin.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2443
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2444
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2445
lemma [simp]: "bl_bin [Oc] = 1"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2446
apply(simp add: bl_bin.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2447
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2448
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2449
lemma [intro]: "2 * 2 ^ a = Suc (Suc (2 * bl_bin (Oc \<up> a)))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2450
apply(induct a, auto simp: bl_bin.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2451
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2452
declare replicate_Suc[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2453
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2454
lemma t_wcode_main_lemma_pre:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2455
  "\<lbrakk>args \<noteq> []; lm = <args::nat list>\<rbrakk> \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2456
       \<exists> stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ rev lm @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2457
                    stp
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2458
      = (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin lm + rs * 2^(length lm - 1) ) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2459
proof(induct "length args" arbitrary: args lm rs m n, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2460
  fix x args lm rs m n
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2461
  assume ind:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2462
    "\<And>args lm rs m n.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2463
    \<lbrakk>x = length args; (args::nat list) \<noteq> []; lm = <args>\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2464
    \<Longrightarrow> \<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2465
    steps0 (Suc 0, Bk # Bk\<up>(m) @ rev lm @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2466
    (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin lm + rs * 2 ^ (length lm - 1)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2467
    and h: "Suc x = length args" "(args::nat list) \<noteq> []" "lm = <args>"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2468
  from h have "\<exists> (a::nat) xs. args = xs @ [a]"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2469
    apply(rule_tac x = "last args" in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2470
    apply(rule_tac x = "butlast args" in exI, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2471
    done    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2472
  from this obtain a xs where "args = xs @ [a]" by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2473
  from h and this show
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2474
    "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2475
    steps0 (Suc 0, Bk # Bk\<up>(m) @ rev lm @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2476
    (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin lm + rs * 2 ^ (length lm - 1)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2477
  proof(case_tac "xs::nat list", simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2478
    show "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2479
          steps0 (Suc 0, Bk # Bk \<up> m @ Oc \<up> Suc a @ Bk # Bk # ires, Bk # Oc \<up> Suc rs @ Bk \<up> n) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2480
          (0, Bk # ires, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> (bl_bin (Oc \<up> Suc a) + rs * 2 ^ a) @ Bk \<up> rn)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2481
    proof(induct "a" arbitrary: m n rs ires, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2482
      fix m n rs ires
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2483
      show "\<exists>stp ln rn.
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2484
          steps0 (Suc 0, Bk # Bk \<up> m @ Oc # Bk # Bk # ires, Bk # Oc \<up> Suc rs @ Bk \<up> n) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2485
          (0, Bk # ires, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> Suc rs @ Bk \<up> rn)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2486
          apply(rule_tac wcode_halt_case)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2487
        done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2488
    next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2489
      fix a m n rs ires
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2490
      assume ind2:
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2491
        "\<And>m n rs ires.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2492
           \<exists>stp ln rn.
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2493
              steps0 (Suc 0, Bk # Bk \<up> m @ Oc \<up> Suc a @ Bk # Bk # ires, Bk # Oc \<up> Suc rs @ Bk \<up> n) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2494
              (0, Bk # ires, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> (bl_bin (Oc \<up> Suc a) + rs * 2 ^ a) @ Bk \<up> rn)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2495
      show " \<exists>stp ln rn.
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2496
          steps0 (Suc 0, Bk # Bk \<up> m @ Oc \<up> Suc (Suc a) @ Bk # Bk # ires, Bk # Oc \<up> Suc rs @ Bk \<up> n) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2497
          (0, Bk # ires, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> (bl_bin (Oc \<up> Suc (Suc a)) + rs * 2 ^ Suc a) @ Bk \<up> rn)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2498
      proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2499
        have "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2500
          steps0 (Suc 0, Bk # Bk\<up>(m) @ rev (<Suc a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2501
          (Suc 0, Bk # Bk\<up>(ln) @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2502
          apply(simp add: tape_of_nat)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2503
          using wcode_double_case[of m "Oc\<up>(a) @ Bk # Bk # ires" rs n]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2504
          apply(simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2505
          done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2506
        from this obtain stpa lna rna where stp1:  
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2507
          "steps0 (Suc 0, Bk # Bk\<up>(m) @ rev (<Suc a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stpa =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2508
          (Suc 0, Bk # Bk\<up>(lna) @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rna))" by blast
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2509
        moreover have 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2510
          "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2511
          steps0 (Suc 0,  Bk # Bk\<up>(lna) @ rev (<a::nat>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rna)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2512
          (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<a>) + (2*rs + 2)  * 2 ^ a) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2513
          using ind2[of lna ires "2*rs + 2" rna] by(simp add: tape_of_nl_abv tape_of_nat_abv)   
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2514
        from this obtain stpb lnb rnb where stp2:  
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2515
          "steps0 (Suc 0,  Bk # Bk\<up>(lna) @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rna)) t_wcode_main stpb =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2516
          (0, Bk # ires, Bk # Oc # Bk\<up>(lnb) @ Bk # Bk # Oc\<up>(bl_bin (<a>) + (2*rs + 2)  * 2 ^ a) @ Bk\<up>(rnb))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2517
          by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2518
        from stp1 and stp2 show "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2519
          apply(rule_tac x = "stpa + stpb" in exI,
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2520
            rule_tac x = lnb in exI, rule_tac x = rnb in exI, simp add: tape_of_nat_abv)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2521
          apply(simp add:  bl_bin.simps replicate_Suc)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2522
          apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2523
          done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2524
      qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2525
    qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2526
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2527
    fix aa list
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2528
    assume g: "Suc x = length args" "args \<noteq> []" "lm = <args>" "args = xs @ [a::nat]" "xs = (aa::nat) # list"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2529
    thus "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ rev lm @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2530
      (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin lm + rs * 2 ^ (length lm - 1)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2531
    proof(induct a arbitrary: m n rs args lm, simp_all add: tape_of_nl_rev, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2532
        simp only: tape_of_nl_cons_app1, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2533
      fix m n rs args lm
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2534
      have "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2535
        steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # rev (<(aa::nat) # list>) @ Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2536
        Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2537
        (Suc 0, Bk # Bk\<up>(ln) @ rev (<aa # list>) @ Bk # Bk # ires, 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2538
        Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2539
        proof(simp add: tape_of_nl_rev)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2540
          have "\<exists> xs. (<rev list @ [aa]>) = Oc # xs" by auto           
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2541
          from this obtain xs where "(<rev list @ [aa]>) = Oc # xs" ..
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2542
          thus "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2543
            steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # <rev list @ [aa]> @ Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2544
            Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2545
            (Suc 0, Bk # Bk\<up>(ln) @ <rev list @ [aa]> @ Bk # Bk # ires, Bk # Oc\<up>(5 + 4 * rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2546
            apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2547
            using wcode_fourtimes_case[of m "xs @ Bk # Bk # ires" rs n]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2548
            apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2549
            done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2550
        qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2551
      from this obtain stpa lna rna where stp1:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2552
        "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # rev (<aa # list>) @ Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2553
        Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stpa =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2554
        (Suc 0, Bk # Bk\<up>(lna) @ rev (<aa # list>) @ Bk # Bk # ires, 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2555
        Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rna))" by blast
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2556
      from g have 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2557
        "\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(lna) @ rev (<(aa::nat) # list>) @ Bk # Bk # ires, 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2558
        Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rna)) t_wcode_main stp = (0, Bk # ires, 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2559
        Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<aa#list>)+ (4*rs + 4) * 2^(length (<aa#list>) - 1) ) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2560
         apply(rule_tac args = "(aa::nat)#list" in ind, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2561
         done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2562
       from this obtain stpb lnb rnb where stp2:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2563
         "steps0 (Suc 0, Bk # Bk\<up>(lna) @ rev (<(aa::nat) # list>) @ Bk # Bk # ires, 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2564
         Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rna)) t_wcode_main stpb = (0, Bk # ires, 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2565
         Bk # Oc # Bk\<up>(lnb) @ Bk # Bk # Oc\<up>(bl_bin (<aa#list>)+ (4*rs + 4) * 2^(length (<aa#list>) - 1) ) @ Bk\<up>(rnb))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2566
         by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2567
       from stp1 and stp2 and h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2568
       show "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2569
         steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # <rev list @ [aa]> @ Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2570
         Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2571
         (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk #
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2572
         Bk # Oc\<up>(bl_bin (Oc\<up>(Suc aa) @ Bk # <list @ [0]>) + rs * (2 * 2 ^ (aa + length (<list @ [0]>)))) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2573
         apply(rule_tac x = "stpa + stpb" in exI, rule_tac x = lnb in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2574
           rule_tac x = rnb in exI, simp add: steps_add tape_of_nl_rev)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2575
         done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2576
     next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2577
       fix ab m n rs args lm
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2578
       assume ind2:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2579
         "\<And> m n rs args lm.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2580
         \<lbrakk>lm = <aa # list @ [ab]>; args = aa # list @ [ab]\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2581
         \<Longrightarrow> \<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2582
         steps0 (Suc 0, Bk # Bk\<up>(m) @ <ab # rev list @ [aa]> @ Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2583
         Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2584
         (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk #
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2585
         Bk # Oc\<up>(bl_bin (<aa # list @ [ab]>) + rs * 2 ^ (length (<aa # list @ [ab]>) - Suc 0)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2586
         and k: "args = aa # list @ [Suc ab]" "lm = <aa # list @ [Suc ab]>"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2587
       show "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2588
         steps0 (Suc 0, Bk # Bk\<up>(m) @ <Suc ab # rev list @ [aa]> @ Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2589
         Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2590
         (0, Bk # ires,Bk # Oc # Bk\<up>(ln) @ Bk # 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2591
         Bk # Oc\<up>(bl_bin (<aa # list @ [Suc ab]>) + rs * 2 ^ (length (<aa # list @ [Suc ab]>) - Suc 0)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2592
       proof(simp add: tape_of_nl_cons_app1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2593
         have "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2594
           steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc\<up>(Suc (Suc ab)) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires, 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2595
           Bk # Oc # Oc\<up>(rs) @ Bk\<up>(n)) t_wcode_main stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2596
           = (Suc 0, Bk # Bk\<up>(ln) @ Oc\<up>(Suc ab) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2597
           Bk # Oc\<up>(Suc (2*rs + 2)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2598
           using wcode_double_case[of m "Oc\<up>(ab) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2599
                                      rs n]
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2600
           apply(simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2601
           done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2602
         from this obtain stpa lna rna where stp1:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2603
           "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc\<up>(Suc (Suc ab)) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires, 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2604
           Bk # Oc # Oc\<up>(rs) @ Bk\<up>(n)) t_wcode_main stpa
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2605
           = (Suc 0, Bk # Bk\<up>(lna) @ Oc\<up>(Suc ab) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2606
           Bk # Oc\<up>(Suc (2*rs + 2)) @ Bk\<up>(rna))" by blast
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2607
         from k have 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2608
           "\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(lna) @ <ab # rev list @ [aa]> @ Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2609
           Bk # Oc\<up>(Suc (2*rs + 2)) @ Bk\<up>(rna)) t_wcode_main stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2610
           = (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk #
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2611
           Bk # Oc\<up>(bl_bin (<aa # list @ [ab]> ) +  (2*rs + 2)* 2^(length (<aa # list @ [ab]>) - Suc 0)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2612
           apply(rule_tac ind2, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2613
           done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2614
         from this obtain stpb lnb rnb where stp2: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2615
           "steps0 (Suc 0, Bk # Bk\<up>(lna) @  <ab # rev list @ [aa]> @ Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2616
           Bk # Oc\<up>(Suc (2*rs + 2)) @ Bk\<up>(rna)) t_wcode_main stpb
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2617
           = (0, Bk # ires, Bk # Oc # Bk\<up>(lnb) @ Bk #
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2618
           Bk # Oc\<up>(bl_bin (<aa # list @ [ab]> ) +  (2*rs + 2)* 2^(length (<aa # list @ [ab]>) - Suc 0)) @ Bk\<up>(rnb))" 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2619
           by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2620
         from stp1 and stp2 show 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2621
           "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2622
           steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc\<up>(Suc (Suc ab)) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2623
           Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2624
           (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2625
           Oc\<up>(bl_bin (Oc\<up>(Suc aa) @ Bk # <list @ [Suc ab]>) + rs * (2 * 2 ^ (aa + length (<list @ [Suc ab]>)))) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2626
           @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2627
           apply(rule_tac x = "stpa + stpb" in exI, rule_tac x = lnb in exI,
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2628
             rule_tac x = rnb in exI, simp add: steps_add tape_of_nl_cons_app1 replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2629
           done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2630
       qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2631
     qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2632
   qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2633
 qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2634
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2635
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2636
definition t_wcode_prepare :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2637
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2638
  "t_wcode_prepare \<equiv> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2639
         [(W1, 2), (L, 1), (L, 3), (R, 2), (R, 4), (W0, 3),
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2640
          (R, 4), (R, 5), (R, 6), (R, 5), (R, 7), (R, 5),
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2641
          (W1, 7), (L, 0)]"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2642
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2643
fun wprepare_add_one :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2644
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2645
  "wprepare_add_one m lm (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2646
      (\<exists> rn. l = [] \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2647
               (r = <m # lm> @ Bk\<up>(rn) \<or> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2648
                r = Bk # <m # lm> @ Bk\<up>(rn)))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2649
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2650
fun wprepare_goto_first_end :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2651
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2652
  "wprepare_goto_first_end m lm (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2653
      (\<exists> ml mr rn. l = Oc\<up>(ml) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2654
                      r = Oc\<up>(mr) @ Bk # <lm> @ Bk\<up>(rn) \<and>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2655
                      ml + mr = Suc (Suc m))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2656
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2657
fun wprepare_erase :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow>  bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2658
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2659
  "wprepare_erase m lm (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2660
     (\<exists> rn. l = Oc\<up>(Suc m) \<and> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2661
               tl r = Bk # <lm> @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2662
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2663
fun wprepare_goto_start_pos_B :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2664
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2665
  "wprepare_goto_start_pos_B m lm (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2666
     (\<exists> rn. l = Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2667
               r = Bk # <lm> @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2668
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2669
fun wprepare_goto_start_pos_O :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2670
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2671
  "wprepare_goto_start_pos_O m lm (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2672
     (\<exists> rn. l = Bk # Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2673
               r = <lm> @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2674
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2675
fun wprepare_goto_start_pos :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2676
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2677
  "wprepare_goto_start_pos m lm (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2678
       (wprepare_goto_start_pos_B m lm (l, r) \<or>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2679
        wprepare_goto_start_pos_O m lm (l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2680
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2681
fun wprepare_loop_start_on_rightmost :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2682
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2683
  "wprepare_loop_start_on_rightmost m lm (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2684
     (\<exists> rn mr. rev l @ r = Oc\<up>(Suc m) @ Bk # Bk # <lm> @ Bk\<up>(rn) \<and> l \<noteq> [] \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2685
                       r = Oc\<up>(mr) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2686
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2687
fun wprepare_loop_start_in_middle :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2688
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2689
  "wprepare_loop_start_in_middle m lm (l, r) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2690
     (\<exists> rn (mr:: nat) (lm1::nat list). 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2691
  rev l @ r = Oc\<up>(Suc m) @ Bk # Bk # <lm> @ Bk\<up>(rn) \<and> l \<noteq> [] \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2692
  r = Oc\<up>(mr) @ Bk # <lm1> @ Bk\<up>(rn) \<and> lm1 \<noteq> [])"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2693
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2694
fun wprepare_loop_start :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2695
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2696
  "wprepare_loop_start m lm (l, r) = (wprepare_loop_start_on_rightmost m lm (l, r) \<or> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2697
                                      wprepare_loop_start_in_middle m lm (l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2698
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2699
fun wprepare_loop_goon_on_rightmost :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2700
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2701
  "wprepare_loop_goon_on_rightmost m lm (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2702
     (\<exists> rn. l = Bk # <rev lm> @ Bk # Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2703
               r = Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2704
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2705
fun wprepare_loop_goon_in_middle :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2706
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2707
  "wprepare_loop_goon_in_middle m lm (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2708
     (\<exists> rn (mr:: nat) (lm1::nat list). 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2709
  rev l @ r = Oc\<up>(Suc m) @ Bk # Bk # <lm> @ Bk\<up>(rn) \<and> l \<noteq> [] \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2710
                     (if lm1 = [] then r = Oc\<up>(mr) @ Bk\<up>(rn) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2711
                     else r = Oc\<up>(mr) @ Bk # <lm1> @ Bk\<up>(rn)) \<and> mr > 0)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2712
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2713
fun wprepare_loop_goon :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2714
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2715
  "wprepare_loop_goon m lm (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2716
              (wprepare_loop_goon_in_middle m lm (l, r) \<or> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2717
               wprepare_loop_goon_on_rightmost m lm (l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2718
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2719
fun wprepare_add_one2 :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2720
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2721
  "wprepare_add_one2 m lm (l, r) =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2722
          (\<exists> rn. l = Bk # Bk # <rev lm> @ Bk # Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2723
               (r = [] \<or> tl r = Bk\<up>(rn)))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2724
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2725
fun wprepare_stop :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2726
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2727
  "wprepare_stop m lm (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2728
         (\<exists> rn. l = Bk # <rev lm> @ Bk # Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2729
               r = Bk # Oc # Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2730
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2731
fun wprepare_inv :: "nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2732
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2733
  "wprepare_inv st m lm (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2734
        (if st = 0 then wprepare_stop m lm (l, r) 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2735
         else if st = Suc 0 then wprepare_add_one m lm (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2736
         else if st = Suc (Suc 0) then wprepare_goto_first_end m lm (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2737
         else if st = Suc (Suc (Suc 0)) then wprepare_erase m lm (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2738
         else if st = 4 then wprepare_goto_start_pos m lm (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2739
         else if st = 5 then wprepare_loop_start m lm (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2740
         else if st = 6 then wprepare_loop_goon m lm (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2741
         else if st = 7 then wprepare_add_one2 m lm (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2742
         else False)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2743
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2744
fun wprepare_stage :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2745
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2746
  "wprepare_stage (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2747
      (if st \<ge> 1 \<and> st \<le> 4 then 3
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2748
       else if st = 5 \<or> st = 6 then 2
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2749
       else 1)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2750
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2751
fun wprepare_state :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2752
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2753
  "wprepare_state (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2754
       (if st = 1 then 4
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2755
        else if st = Suc (Suc 0) then 3
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2756
        else if st = Suc (Suc (Suc 0)) then 2
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2757
        else if st = 4 then 1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2758
        else if st = 7 then 2
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2759
        else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2760
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2761
fun wprepare_step :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2762
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2763
  "wprepare_step (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2764
      (if st = 1 then (if hd r = Oc then Suc (length l)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2765
                       else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2766
       else if st = Suc (Suc 0) then length r
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2767
       else if st = Suc (Suc (Suc 0)) then (if hd r = Oc then 1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2768
                            else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2769
       else if st = 4 then length r
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2770
       else if st = 5 then Suc (length r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2771
       else if st = 6 then (if r = [] then 0 else Suc (length r))
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2772
       else if st = 7 then (if (r \<noteq> [] \<and> hd r = Oc) then 0
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2773
                            else 1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2774
       else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2775
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2776
fun wcode_prepare_measure :: "config \<Rightarrow> nat \<times> nat \<times> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2777
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2778
  "wcode_prepare_measure (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2779
     (wprepare_stage (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2780
      wprepare_state (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2781
      wprepare_step (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2782
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2783
definition wcode_prepare_le :: "(config \<times> config) set"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2784
  where "wcode_prepare_le \<equiv> (inv_image lex_triple wcode_prepare_measure)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2785
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2786
lemma [intro]: "wf lex_pair"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2787
by(auto intro:wf_lex_prod simp:lex_pair_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2788
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2789
lemma wf_wcode_prepare_le[intro]: "wf wcode_prepare_le"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2790
by(auto intro:wf_inv_image simp: wcode_prepare_le_def 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2791
           lex_triple_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2792
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2793
declare wprepare_add_one.simps[simp del] wprepare_goto_first_end.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2794
        wprepare_erase.simps[simp del] wprepare_goto_start_pos.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2795
        wprepare_loop_start.simps[simp del] wprepare_loop_goon.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2796
        wprepare_add_one2.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2797
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2798
lemmas wprepare_invs = wprepare_add_one.simps wprepare_goto_first_end.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2799
        wprepare_erase.simps wprepare_goto_start_pos.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2800
        wprepare_loop_start.simps wprepare_loop_goon.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2801
        wprepare_add_one2.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2802
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2803
declare wprepare_inv.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2804
lemma [simp]: "fetch t_wcode_prepare (Suc 0) Bk = (W1, 2)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2805
apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2806
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2807
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2808
lemma [simp]: "fetch t_wcode_prepare (Suc 0) Oc = (L, 1)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2809
apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2810
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2811
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2812
lemma [simp]: "fetch t_wcode_prepare (Suc (Suc 0)) Bk = (L, 3)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2813
apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2814
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2815
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2816
lemma [simp]: "fetch t_wcode_prepare (Suc (Suc 0)) Oc = (R, 2)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2817
apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2818
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2819
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2820
lemma [simp]: "fetch t_wcode_prepare (Suc (Suc (Suc 0))) Bk = (R, 4)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2821
apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2822
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2823
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2824
lemma [simp]: "fetch t_wcode_prepare (Suc (Suc (Suc 0))) Oc = (W0, 3)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2825
apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2826
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2827
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2828
lemma [simp]: "fetch t_wcode_prepare 4 Bk = (R, 4)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2829
apply(subgoal_tac "4 = Suc 3")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2830
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2831
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2832
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2833
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2834
lemma [simp]: "fetch t_wcode_prepare 4 Oc = (R, 5)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2835
apply(subgoal_tac "4 = Suc 3")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2836
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2837
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2838
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2839
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2840
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2841
lemma [simp]: "fetch t_wcode_prepare 5 Oc = (R, 5)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2842
apply(subgoal_tac "5 = Suc 4")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2843
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2844
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2845
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2846
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2847
lemma [simp]: "fetch t_wcode_prepare 5 Bk = (R, 6)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2848
apply(subgoal_tac "5 = Suc 4")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2849
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2850
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2851
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2852
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2853
lemma [simp]: "fetch t_wcode_prepare 6 Oc = (R, 5)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2854
apply(subgoal_tac "6 = Suc 5")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2855
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2856
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2857
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2858
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2859
lemma [simp]: "fetch t_wcode_prepare 6 Bk = (R, 7)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2860
apply(subgoal_tac "6 = Suc 5")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2861
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2862
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2863
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2864
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2865
lemma [simp]: "fetch t_wcode_prepare 7 Oc = (L, 0)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2866
apply(subgoal_tac "7 = Suc 6")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2867
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2868
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2869
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2870
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2871
lemma [simp]: "fetch t_wcode_prepare 7 Bk = (W1, 7)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2872
apply(subgoal_tac "7 = Suc 6")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2873
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2874
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2875
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2876
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2877
lemma [simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_add_one m lm (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2878
apply(simp add: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2879
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2880
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2881
lemma [simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_goto_first_end m lm (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2882
apply(simp add: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2883
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2884
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2885
lemma [simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_erase m lm (b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2886
apply(simp add: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2887
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2888
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2889
lemma [simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_goto_start_pos m lm (b, []) = False"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2890
apply(simp add: wprepare_invs)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2891
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2892
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2893
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, [])\<rbrakk> \<Longrightarrow> b \<noteq> []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2894
apply(simp add: wprepare_invs)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2895
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2896
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2897
lemma rev_eq: "rev xs = rev ys \<Longrightarrow> xs = ys"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2898
by auto
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2899
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2900
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, [])\<rbrakk> \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2901
                                  wprepare_loop_goon m lm (Bk # b, [])"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2902
apply(simp only: wprepare_invs)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2903
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2904
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2905
apply(simp add: wprepare_loop_start_on_rightmost.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2906
                wprepare_loop_goon_on_rightmost.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2907
apply(rule_tac rev_eq, simp add: tape_of_nl_rev)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2908
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2909
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2910
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, [])\<rbrakk> \<Longrightarrow> b \<noteq> []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2911
apply(simp only: wprepare_invs, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2912
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2913
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2914
lemma [simp]:"\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, [])\<rbrakk> \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2915
  wprepare_add_one2 m lm (Bk # b, [])"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2916
apply(simp only: wprepare_invs, auto split: if_splits)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2917
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2918
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2919
lemma [simp]: "wprepare_add_one2 m lm (b, []) \<Longrightarrow> b \<noteq> []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2920
apply(simp only: wprepare_invs, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2921
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2922
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2923
lemma [simp]: "wprepare_add_one2 m lm (b, []) \<Longrightarrow> wprepare_add_one2 m lm (b, [Oc])"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2924
apply(simp only: wprepare_invs, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2925
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2926
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2927
lemma [simp]: "Bk # list = <(m::nat) # lm> @ ys = False"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2928
apply(case_tac lm, auto simp: tape_of_nl_cons replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2929
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2930
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2931
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_add_one m lm (b, Bk # list)\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2932
       \<Longrightarrow> (b = [] \<longrightarrow> wprepare_goto_first_end m lm ([], Oc # list)) \<and> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2933
           (b \<noteq> [] \<longrightarrow> wprepare_goto_first_end m lm (b, Oc # list))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2934
apply(simp only: wprepare_invs)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2935
apply(auto simp: tape_of_nl_cons split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2936
apply(rule_tac x = 0 in exI, simp add: replicate_Suc)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2937
apply(case_tac lm, simp, simp add: tape_of_nl_abv tape_of_nat_list.simps replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2938
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2939
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2940
lemma [simp]: "wprepare_goto_first_end m lm (b, Bk # list) \<Longrightarrow> b \<noteq> []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2941
apply(simp only: wprepare_invs , auto simp: replicate_Suc)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2942
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2943
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2944
declare replicate_Suc[simp]
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2945
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2946
lemma [simp]: "wprepare_goto_first_end m lm (b, Bk # list) \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2947
                          wprepare_erase m lm (tl b, hd b # Bk # list)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2948
apply(simp only: wprepare_invs, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2949
apply(case_tac mr, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2950
apply(case_tac mr, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2951
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2952
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2953
lemma [simp]: "wprepare_erase m lm (b, Bk # list) \<Longrightarrow> b \<noteq> []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2954
apply(simp only: wprepare_invs, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2955
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2956
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2957
lemma [simp]: "wprepare_erase m lm (b, Bk # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2958
                           wprepare_goto_start_pos m lm (Bk # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2959
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2960
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2961
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2962
lemma [simp]: "\<lbrakk>wprepare_add_one m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2963
apply(simp only: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2964
apply(case_tac lm, simp_all add: tape_of_nl_abv 
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  2965
                         tape_of_nat_list.simps tape_of_nat_abv, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2966
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2967
    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2968
lemma [simp]: "\<lbrakk>lm \<noteq> [];  wprepare_goto_first_end m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2969
apply(simp only: wprepare_invs, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2970
apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2971
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2972
     
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2973
lemma [simp]: "\<lbrakk>lm \<noteq> [];  wprepare_goto_first_end m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2974
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2975
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2976
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2977
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_erase m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2978
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2979
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2980
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2981
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_erase m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2982
apply(simp only: wprepare_invs, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2983
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2984
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2985
lemma [simp]: "\<lbrakk>lm \<noteq> [];  wprepare_goto_start_pos m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2986
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2987
apply(case_tac lm, simp, case_tac list)
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  2988
apply(simp_all add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2989
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2990
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2991
lemma [simp]: "\<lbrakk>lm \<noteq> [];  wprepare_goto_start_pos m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2992
apply(simp only: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2993
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2994
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2995
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2996
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2997
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2998
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2999
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3000
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3001
  (list = [] \<longrightarrow> wprepare_add_one2 m lm (Bk # b, [])) \<and> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3002
  (list \<noteq> [] \<longrightarrow> wprepare_add_one2 m lm (Bk # b, list))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3003
apply(simp only: wprepare_invs, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3004
apply(case_tac list, simp_all split: if_splits, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3005
apply(case_tac [1-3] mr, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3006
apply(case_tac mr, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3007
apply(case_tac [1-2] mr, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3008
apply(case_tac rn, simp, case_tac nat, auto simp: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3009
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3010
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3011
lemma [simp]: "wprepare_add_one2 m lm (b, Bk # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3012
apply(simp only: wprepare_invs, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3013
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3014
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3015
lemma [simp]: "wprepare_add_one2 m lm (b, Bk # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3016
      (list = [] \<longrightarrow> wprepare_add_one2 m lm (b, [Oc])) \<and> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3017
      (list \<noteq> [] \<longrightarrow> wprepare_add_one2 m lm (b, Oc # list))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3018
apply(simp only:  wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3019
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3020
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3021
lemma [simp]: "wprepare_goto_first_end m lm (b, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3022
       \<Longrightarrow> (b = [] \<longrightarrow> wprepare_goto_first_end m lm ([Oc], list)) \<and> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3023
           (b \<noteq> [] \<longrightarrow> wprepare_goto_first_end m lm (Oc # b, list))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3024
apply(simp only:  wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3025
apply(rule_tac x = 1 in exI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3026
apply(case_tac mr, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3027
apply(case_tac ml, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3028
apply(rule_tac x = "Suc ml" in exI, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3029
apply(rule_tac x = "mr - 1" in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3030
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3031
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3032
lemma [simp]: "wprepare_erase m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3033
apply(simp only: wprepare_invs, auto simp: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3034
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3035
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3036
lemma [simp]: "wprepare_erase m lm (b, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3037
  \<Longrightarrow> wprepare_erase m lm (b, Bk # list)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3038
apply(simp  only:wprepare_invs, auto simp: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3039
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3040
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3041
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_start_pos m lm (b, Bk # list)\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3042
       \<Longrightarrow> wprepare_goto_start_pos m lm (Bk # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3043
apply(simp only:wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3044
apply(case_tac [!] lm, simp, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3045
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3046
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3047
lemma [simp]: "wprepare_loop_start m lm (b, aa) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3048
apply(simp only:wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3049
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3050
lemma [elim]: "Bk # list = Oc\<up>(mr) @ Bk\<up>(rn)  \<Longrightarrow> \<exists>rn. list = Bk\<up>(rn)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3051
apply(case_tac mr, simp_all)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3052
apply(case_tac rn, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3053
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3054
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3055
lemma rev_equal_iff: "x = y \<Longrightarrow> rev x = rev y"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3056
by simp
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3057
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3058
lemma tape_of_nl_false1:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3059
  "lm \<noteq> [] \<Longrightarrow> rev b @ [Bk] \<noteq> Bk\<up>(ln) @ Oc # Oc\<up>(m) @ Bk # Bk # <lm::nat list>"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3060
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3061
apply(drule_tac rev_equal_iff, simp add: tape_of_nl_rev)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3062
apply(case_tac "rev lm")
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3063
apply(case_tac [2] list, auto simp: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3064
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3065
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3066
lemma [simp]: "wprepare_loop_start_in_middle m lm (b, [Bk]) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3067
apply(simp add: wprepare_loop_start_in_middle.simps, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3068
apply(case_tac mr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3069
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3070
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3071
declare wprepare_loop_start_in_middle.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3072
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3073
declare wprepare_loop_start_on_rightmost.simps[simp del] 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3074
        wprepare_loop_goon_in_middle.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3075
        wprepare_loop_goon_on_rightmost.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3076
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3077
lemma [simp]: "wprepare_loop_goon_in_middle m lm (Bk # b, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3078
apply(simp add: wprepare_loop_goon_in_middle.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3079
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3080
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3081
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, [Bk])\<rbrakk> \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3082
  wprepare_loop_goon m lm (Bk # b, [])"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3083
apply(simp only: wprepare_invs, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3084
apply(simp add: wprepare_loop_goon_on_rightmost.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3085
  wprepare_loop_start_on_rightmost.simps, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3086
apply(case_tac mr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3087
apply(rule_tac rev_eq)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3088
apply(simp add: tape_of_nl_rev)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3089
apply(simp add: exp_ind replicate_Suc[THEN sym] del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3090
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3091
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3092
lemma [simp]: "wprepare_loop_start_on_rightmost m lm (b, Bk # a # lista)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3093
 \<Longrightarrow> wprepare_loop_goon_in_middle m lm (Bk # b, a # lista) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3094
apply(auto simp: wprepare_loop_start_on_rightmost.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3095
                 wprepare_loop_goon_in_middle.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3096
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3097
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3098
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start_on_rightmost m lm (b, Bk # a # lista)\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3099
    \<Longrightarrow> wprepare_loop_goon_on_rightmost m lm (Bk # b, a # lista)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3100
apply(simp only: wprepare_loop_start_on_rightmost.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3101
                 wprepare_loop_goon_on_rightmost.simps, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3102
apply(case_tac mr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3103
apply(simp add: tape_of_nl_rev)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3104
apply(simp add: replicate_Suc[THEN sym] exp_ind del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3105
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3106
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3107
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start_in_middle m lm (b, Bk # a # lista)\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3108
  \<Longrightarrow> wprepare_loop_goon_on_rightmost m lm (Bk # b, a # lista) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3109
apply(simp add: wprepare_loop_start_in_middle.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3110
                wprepare_loop_goon_on_rightmost.simps, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3111
apply(case_tac mr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3112
apply(case_tac  "lm1::nat list", simp_all, case_tac  list, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3113
apply(simp add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3114
apply(case_tac [!] rna, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3115
apply(case_tac mr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3116
apply(case_tac lm1, simp, case_tac list, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3117
apply(simp_all add: tape_of_nl_abv tape_of_nat_list.simps  tape_of_nat_abv)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3118
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3119
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3120
lemma [simp]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3121
  "\<lbrakk>lm \<noteq> []; wprepare_loop_start_in_middle m lm (b, Bk # a # lista)\<rbrakk> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3122
  \<Longrightarrow> wprepare_loop_goon_in_middle m lm (Bk # b, a # lista)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3123
apply(simp add: wprepare_loop_start_in_middle.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3124
               wprepare_loop_goon_in_middle.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3125
apply(rule_tac x = rn in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3126
apply(case_tac mr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3127
apply(case_tac lm1, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3128
apply(rule_tac x = "Suc aa" in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3129
apply(rule_tac x = list in exI)
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3130
apply(case_tac list, simp_all add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3131
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3132
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3133
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, Bk # a # lista)\<rbrakk> \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3134
  wprepare_loop_goon m lm (Bk # b, a # lista)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3135
apply(simp add: wprepare_loop_start.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3136
                wprepare_loop_goon.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3137
apply(erule_tac disjE, simp, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3138
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3139
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3140
lemma start_2_goon:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3141
  "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, Bk # list)\<rbrakk> \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3142
   (list = [] \<longrightarrow> wprepare_loop_goon m lm (Bk # b, [])) \<and>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3143
  (list \<noteq> [] \<longrightarrow> wprepare_loop_goon m lm (Bk # b, list))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3144
apply(case_tac list, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3145
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3146
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3147
lemma add_one_2_add_one: "wprepare_add_one m lm (b, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3148
  \<Longrightarrow> (hd b = Oc \<longrightarrow> (b = [] \<longrightarrow> wprepare_add_one m lm ([], Bk # Oc # list)) \<and>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3149
                     (b \<noteq> [] \<longrightarrow> wprepare_add_one m lm (tl b, Oc # Oc # list))) \<and>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3150
  (hd b \<noteq> Oc \<longrightarrow> (b = [] \<longrightarrow> wprepare_add_one m lm ([], Bk # Oc # list)) \<and>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3151
                 (b \<noteq> [] \<longrightarrow> wprepare_add_one m lm (tl b, hd b # Oc # list)))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3152
apply(simp only: wprepare_add_one.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3153
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3154
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3155
lemma [simp]: "wprepare_loop_start m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3156
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3157
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3158
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3159
lemma [simp]: "wprepare_loop_start_on_rightmost m lm (b, Oc # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3160
  wprepare_loop_start_on_rightmost m lm (Oc # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3161
apply(simp add: wprepare_loop_start_on_rightmost.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3162
apply(rule_tac x = rn in exI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3163
apply(case_tac mr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3164
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3165
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3166
lemma [simp]: "wprepare_loop_start_in_middle m lm (b, Oc # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3167
                wprepare_loop_start_in_middle m lm (Oc # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3168
apply(simp add: wprepare_loop_start_in_middle.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3169
apply(rule_tac x = rn in exI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3170
apply(case_tac mr, simp, simp add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3171
apply(rule_tac x = nat in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3172
apply(rule_tac x = lm1 in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3173
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3174
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3175
lemma start_2_start: "wprepare_loop_start m lm (b, Oc # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3176
       wprepare_loop_start m lm (Oc # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3177
apply(simp add: wprepare_loop_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3178
apply(erule_tac disjE, simp_all )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3179
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3180
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3181
lemma [simp]: "wprepare_loop_goon m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3182
apply(simp add: wprepare_loop_goon.simps     
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3183
                wprepare_loop_goon_in_middle.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3184
                wprepare_loop_goon_on_rightmost.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3185
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3186
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3187
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3188
lemma [simp]: "wprepare_goto_start_pos m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3189
apply(simp add: wprepare_goto_start_pos.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3190
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3191
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3192
lemma [simp]: "wprepare_loop_goon_on_rightmost m lm (b, Oc # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3193
apply(simp add: wprepare_loop_goon_on_rightmost.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3194
done
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3195
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3196
lemma wprepare_loop1: "\<lbrakk>rev b @ Oc\<up>(mr) =  Oc\<up>(Suc m) @ Bk # Bk # <lm>; 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3197
         b \<noteq> []; 0 < mr; Oc # list = Oc\<up>(mr) @ Bk\<up>(rn)\<rbrakk>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3198
       \<Longrightarrow> wprepare_loop_start_on_rightmost m lm (Oc # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3199
apply(simp add: wprepare_loop_start_on_rightmost.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3200
apply(rule_tac x = rn in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3201
apply(case_tac mr, simp, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3202
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3203
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3204
lemma wprepare_loop2: "\<lbrakk>rev b @ Oc\<up>(mr) @ Bk # <a # lista> = Oc\<up>(Suc m) @ Bk # Bk # <lm>;
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3205
                b \<noteq> []; Oc # list = Oc\<up>(mr) @ Bk # <(a::nat) # lista> @ Bk\<up>(rn)\<rbrakk>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3206
       \<Longrightarrow>  wprepare_loop_start_in_middle m lm (Oc # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3207
apply(simp add: wprepare_loop_start_in_middle.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3208
apply(rule_tac x = rn in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3209
apply(case_tac mr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3210
apply(rule_tac x = nat in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3211
apply(rule_tac x = "a#lista" in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3212
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3213
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3214
lemma [simp]: "wprepare_loop_goon_in_middle m lm (b, Oc # list) \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3215
                wprepare_loop_start_on_rightmost m lm (Oc # b, list) \<or>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3216
                wprepare_loop_start_in_middle m lm (Oc # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3217
apply(simp add: wprepare_loop_goon_in_middle.simps split: if_splits)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3218
apply(case_tac lm1, simp_all add: wprepare_loop1 wprepare_loop2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3219
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3220
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3221
lemma [simp]: "wprepare_loop_goon m lm (b, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3222
  \<Longrightarrow>  wprepare_loop_start m lm (Oc # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3223
apply(simp add: wprepare_loop_goon.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3224
                wprepare_loop_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3225
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3226
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3227
lemma [simp]: "wprepare_add_one m lm (b, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3228
       \<Longrightarrow> b = [] \<longrightarrow> wprepare_add_one m lm ([], Bk # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3229
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3230
apply(simp add: wprepare_add_one.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3231
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3232
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3233
lemma [simp]: "wprepare_goto_start_pos m [a] (b, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3234
              \<Longrightarrow> wprepare_loop_start_on_rightmost m [a] (Oc # b, list) "
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3235
apply(auto simp: wprepare_goto_start_pos.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3236
                 wprepare_loop_start_on_rightmost.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3237
apply(rule_tac x = rn in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3238
apply(simp add: replicate_Suc[THEN sym] exp_ind del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3239
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3240
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3241
lemma [simp]:  "wprepare_goto_start_pos m (a # aa # listaa) (b, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3242
       \<Longrightarrow>wprepare_loop_start_in_middle m (a # aa # listaa) (Oc # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3243
apply(auto simp: wprepare_goto_start_pos.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3244
                 wprepare_loop_start_in_middle.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3245
apply(rule_tac x = rn in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3246
apply(simp add: exp_ind[THEN sym])
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3247
apply(rule_tac x = a in exI, rule_tac x = "aa#listaa" in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3248
apply(simp add: tape_of_nl_cons)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3249
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3250
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3251
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_start_pos m lm (b, Oc # list)\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3252
       \<Longrightarrow> wprepare_loop_start m lm (Oc # b, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3253
apply(case_tac lm, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3254
apply(case_tac lista, simp_all add: wprepare_loop_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3255
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3256
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3257
lemma [simp]: "wprepare_add_one2 m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3258
apply(auto simp: wprepare_add_one2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3259
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3260
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3261
lemma add_one_2_stop:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3262
  "wprepare_add_one2 m lm (b, Oc # list)      
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3263
  \<Longrightarrow>  wprepare_stop m lm (tl b, hd b # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3264
apply(simp add: wprepare_stop.simps wprepare_add_one2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3265
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3266
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3267
declare wprepare_stop.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3268
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3269
lemma wprepare_correctness:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3270
  assumes h: "lm \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3271
  shows "let P = (\<lambda> (st, l, r). st = 0) in 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3272
  let Q = (\<lambda> (st, l, r). wprepare_inv st m lm (l, r)) in 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3273
  let f = (\<lambda> stp. steps0 (Suc 0, [], (<m # lm>)) t_wcode_prepare stp) in
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3274
    \<exists> n .P (f n) \<and> Q (f n)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3275
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3276
  let ?P = "(\<lambda> (st, l, r). st = 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3277
  let ?Q = "(\<lambda> (st, l, r). wprepare_inv st m lm (l, r))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3278
  let ?f = "(\<lambda> stp. steps0 (Suc 0, [], (<m # lm>)) t_wcode_prepare stp)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3279
  have "\<exists> n. ?P (?f n) \<and> ?Q (?f n)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3280
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3281
    show "wf wcode_prepare_le" by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3282
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3283
    show "\<forall> n. \<not> ?P (?f n) \<and> ?Q (?f n) \<longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3284
                 ?Q (?f (Suc n)) \<and> (?f (Suc n), ?f n) \<in> wcode_prepare_le"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3285
      using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3286
      apply(rule_tac allI, rule_tac impI, case_tac "?f n", 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3287
            simp add: step_red step.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3288
      apply(case_tac c, simp, case_tac [2] aa)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3289
      apply(simp_all add: wprepare_inv.simps wcode_prepare_le_def lex_triple_def lex_pair_def
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3290
                 split: if_splits)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3291
      apply(simp_all add: start_2_goon  start_2_start
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3292
                           add_one_2_add_one add_one_2_stop)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3293
      apply(auto simp: wprepare_add_one2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3294
      done   
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3295
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3296
    show "?Q (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3297
      apply(simp add: steps.simps wprepare_inv.simps wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3298
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3299
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3300
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3301
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3302
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3303
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3304
  thus "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3305
    apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3306
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3307
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3308
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3309
lemma [intro]: "tm_wf (t_wcode_prepare, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3310
apply(simp add:tm_wf.simps t_wcode_prepare_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3311
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3312
   
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3313
(* 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3314
lemma t_correct_termi: "t_correct tp \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3315
      list_all (\<lambda>(acn, st). (st \<le> Suc (length tp div 2))) (change_termi_state tp)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3316
apply(auto simp: t_correct.simps List.list_all_length)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3317
apply(erule_tac x = n in allE, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3318
apply(case_tac "tp!n", auto simp: change_termi_state.simps split: if_splits)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3319
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3320
*)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3321
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3322
lemma t_correct_shift:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3323
         "list_all (\<lambda>(acn, st). (st \<le> y)) tp \<Longrightarrow>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3324
          list_all (\<lambda>(acn, st). (st \<le> y + off)) (shift tp off) "
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3325
apply(auto simp: List.list_all_length)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3326
apply(erule_tac x = n in allE, simp add: length_shift)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3327
apply(case_tac "tp!n", auto simp: shift.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3328
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3329
(*
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3330
lemma [intro]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3331
  "t_correct (tm_of abc_twice @ tMp (Suc 0) 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3332
        (start_of twice_ly (length abc_twice) - Suc 0))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3333
apply(rule_tac t_compiled_correct, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3334
apply(simp add: twice_ly_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3335
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3336
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3337
lemma [intro]: "t_correct (tm_of abc_fourtimes @ tMp (Suc 0) 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3338
   (start_of fourtimes_ly (length abc_fourtimes) - Suc 0))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3339
apply(rule_tac t_compiled_correct, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3340
apply(simp add: fourtimes_ly_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3341
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3342
*)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3343
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3344
lemma [intro]: "(28 + (length t_twice_compile + length t_fourtimes_compile)) mod 2 = 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3345
apply(auto simp: t_twice_compile_def t_fourtimes_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3346
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3347
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3348
lemma [elim]: "(a, b) \<in> set t_wcode_main_first_part \<Longrightarrow>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3349
  b \<le> (28 + (length t_twice_compile + length t_fourtimes_compile)) div 2"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3350
apply(auto simp: t_wcode_main_first_part_def t_twice_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3351
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3352
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3353
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3354
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3355
lemma tm_wf_change_termi: "tm_wf (tp, 0) \<Longrightarrow> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3356
      list_all (\<lambda>(acn, st). (st \<le> Suc (length tp div 2))) (adjust tp)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3357
apply(auto simp: tm_wf.simps List.list_all_length)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3358
apply(case_tac "tp!n", auto simp: adjust.simps split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3359
apply(erule_tac x = "(a, b)" in ballE, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3360
by (metis in_set_conv_nth)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3361
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3362
lemma tm_wf_shift:
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3363
         "list_all (\<lambda>(acn, st). (st \<le> y)) tp \<Longrightarrow>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3364
          list_all (\<lambda>(acn, st). (st \<le> y + off)) (shift tp off) "
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3365
apply(auto simp: tm_wf.simps List.list_all_length)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3366
apply(erule_tac x = n in allE, simp add: length_shift)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3367
apply(case_tac "tp!n", auto simp: shift.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3368
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3369
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3370
declare length_tp'[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3371
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3372
lemma [simp]: "length (mopup (Suc 0)) = 16"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3373
apply(auto simp: mopup.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3374
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3375
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3376
lemma [elim]: "(a, b) \<in> set (shift (Turing.adjust t_twice_compile) 12) \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3377
  b \<le> (28 + (length t_twice_compile + length t_fourtimes_compile)) div 2"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3378
apply(simp add: t_twice_compile_def t_fourtimes_compile_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3379
proof -
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3380
  assume g: "(a, b) \<in> set (shift (Turing.adjust (tm_of abc_twice @ shift (mopup (Suc 0)) (length (tm_of abc_twice) div 2))) 12)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3381
  moreover have "length (tm_of abc_twice) mod 2 = 0" by auto
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3382
  moreover have "length (tm_of abc_fourtimes) mod 2 = 0" by auto
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3383
  ultimately have "list_all (\<lambda>(acn, st). (st \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2)) 
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3384
    (shift (Turing.adjust t_twice_compile) 12)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3385
  proof(auto simp: mod_ex1)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3386
    fix q qa
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3387
    assume h: "length (tm_of abc_twice) = 2 * q" "length (tm_of abc_fourtimes) = 2 * qa"
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3388
    hence "list_all (\<lambda>(acn, st). st \<le> (18 + (q + qa)) + 12) (shift (Turing.adjust t_twice_compile) 12)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3389
    proof(rule_tac tm_wf_shift t_twice_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3390
      have "list_all (\<lambda>(acn, st). st \<le> Suc (length t_twice_compile div 2)) (adjust t_twice_compile)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3391
        by(rule_tac tm_wf_change_termi, auto)
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3392
      thus "list_all (\<lambda>(acn, st). st \<le> 18 + (q + qa)) (Turing.adjust t_twice_compile)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3393
        using h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3394
        apply(simp add: t_twice_compile_def, auto simp: List.list_all_length)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3395
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3396
    qed
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3397
    thus "list_all (\<lambda>(acn, st). st \<le> 30 + (q + qa)) (shift (Turing.adjust t_twice_compile) 12)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3398
      by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3399
  qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3400
  thus "b \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3401
    using g
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3402
    apply(auto simp:t_twice_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3403
    apply(simp add: Ball_set[THEN sym])
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3404
    apply(erule_tac x = "(a, b)" in ballE, simp, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3405
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3406
qed 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3407
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3408
lemma [elim]: "(a, b) \<in> set (shift (Turing.adjust t_fourtimes_compile) (t_twice_len + 13)) 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3409
  \<Longrightarrow> b \<le> (28 + (length t_twice_compile + length t_fourtimes_compile)) div 2"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3410
apply(simp add: t_twice_compile_def t_fourtimes_compile_def t_twice_len_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3411
proof -
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3412
  assume g: "(a, b) \<in> set (shift (Turing.adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0))
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3413
    (length (tm_of abc_fourtimes) div 2))) (length t_twice div 2 + 13))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3414
  moreover have "length (tm_of abc_twice) mod 2 = 0" by auto
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3415
  moreover have "length (tm_of abc_fourtimes) mod 2 = 0" by auto
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3416
  ultimately have "list_all (\<lambda>(acn, st). (st \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2)) 
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3417
    (shift (Turing.adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0))
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3418
    (length (tm_of abc_fourtimes) div 2))) (length t_twice div 2 + 13))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3419
  proof(auto simp: mod_ex1 t_twice_def t_twice_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3420
    fix q qa
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3421
    assume h: "length (tm_of abc_twice) = 2 * q" "length (tm_of abc_fourtimes) = 2 * qa"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3422
    hence "list_all (\<lambda>(acn, st). st \<le> (9 + qa + (21 + q)))
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3423
      (shift (Turing.adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa)) (21 + q))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3424
    proof(rule_tac tm_wf_shift t_twice_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3425
      have "list_all (\<lambda>(acn, st). st \<le> Suc (length (tm_of abc_fourtimes @ shift 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3426
        (mopup (Suc 0)) qa) div 2)) (adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3427
        apply(rule_tac tm_wf_change_termi)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3428
        using wf_fourtimes h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3429
        apply(simp add: t_fourtimes_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3430
        done        
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3431
      thus "list_all (\<lambda>(acn, st). st \<le> 9 + qa) ((Turing.adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa)))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3432
        using h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3433
        apply(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3434
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3435
    qed
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3436
    thus "list_all (\<lambda>(acn, st). st \<le> 30 + (q + qa)) (shift (Turing.adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa)) (21 + q))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3437
      apply(subgoal_tac "qa + q = q + qa")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3438
      apply(simp, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3439
      done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3440
  qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3441
  thus "b \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3442
    using g
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3443
    apply(simp add: Ball_set[THEN sym])
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3444
    apply(erule_tac x = "(a, b)" in ballE, simp, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3445
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3446
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3447
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3448
lemma [intro]: "tm_wf (t_wcode_main, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3449
apply(auto simp: t_wcode_main_def tm_wf.simps
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3450
                 t_twice_def t_fourtimes_def del: List.list_all_iff)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3451
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3452
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3453
declare tm_comp.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3454
lemma tm_wf_comp: "\<lbrakk>tm_wf (A, 0); tm_wf (B, 0)\<rbrakk> \<Longrightarrow> tm_wf (A |+| B, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3455
apply(auto simp: tm_wf.simps shift.simps adjust.simps tm_comp_length
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3456
                 tm_comp.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3457
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3458
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3459
lemma [intro]: "tm_wf (t_wcode_prepare |+| t_wcode_main, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3460
apply(rule_tac tm_wf_comp, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3461
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3462
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3463
lemma prepare_mainpart_lemma:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3464
  "args \<noteq> [] \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3465
  \<exists> stp ln rn. steps0 (Suc 0, [], <m # args>) (t_wcode_prepare |+| t_wcode_main) stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3466
              = (0,  Bk # Oc\<up>(Suc m), Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<args>)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3467
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3468
  let ?P1 = "(\<lambda> (l, r). (l::cell list) = [] \<and> r = <m # args>)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3469
  let ?Q1 = "(\<lambda> (l, r). wprepare_stop m args (l, r))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3470
  let ?P2 = ?Q1
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3471
  let ?Q2 = "(\<lambda> (l, r). (\<exists> ln rn. l = Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3472
                           r =  Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<args>)) @ Bk\<up>(rn)))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3473
  let ?P3 = "\<lambda> tp. False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3474
  assume h: "args \<noteq> []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3475
  have "{?P1} t_wcode_prepare |+| t_wcode_main {?Q2}"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3476
  proof(rule_tac Hoare_plus_halt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3477
    show "{?P1} t_wcode_prepare {?Q1}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3478
    proof(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3479
      show "\<exists>n. is_final (steps0 (Suc 0, [], <m # args>) t_wcode_prepare n) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3480
        wprepare_stop m args holds_for steps0 (Suc 0, [], <m # args>) t_wcode_prepare n"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3481
        using wprepare_correctness[of args m] h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3482
        apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3483
        apply(rule_tac x = n in exI, simp add: wprepare_inv.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3484
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3485
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3486
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3487
    show "{?P2} t_wcode_main {?Q2}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3488
    proof(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3489
      fix l r
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3490
      assume "wprepare_stop m args (l, r)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3491
      thus "\<exists>n. is_final (steps0 (Suc 0, l, r) t_wcode_main n) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3492
              (\<lambda>(l, r). l = Bk # Oc # Oc \<up> m \<and> (\<exists>ln rn. r = Bk # Oc # Bk \<up> ln @ 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3493
        Bk # Bk # Oc \<up> bl_bin (<args>) @ Bk \<up> rn)) holds_for steps0 (Suc 0, l, r) t_wcode_main n"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3494
      proof(auto simp: wprepare_stop.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3495
        fix rn
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3496
        show " \<exists>n. is_final (steps0 (Suc 0, Bk # <rev args> @ Bk # Bk # Oc # Oc \<up> m, Bk # Oc # Bk \<up> rn) t_wcode_main n) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3497
          (\<lambda>(l, r). l = Bk # Oc # Oc \<up> m \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3498
          (\<exists>ln rn. r = Bk # Oc # Bk \<up> ln @
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3499
          Bk # Bk # Oc \<up> bl_bin (<args>) @
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3500
          Bk \<up> rn)) holds_for steps0 (Suc 0, Bk # <rev args> @ Bk # Bk # Oc # Oc \<up> m, Bk # Oc # Bk \<up> rn) t_wcode_main n"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3501
          using t_wcode_main_lemma_pre[of "args" "<args>" 0 "Oc\<up>(Suc m)" 0 rn] h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3502
          apply(auto simp: tape_of_nl_rev)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3503
          apply(rule_tac x = stp in exI, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3504
          done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3505
      qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3506
    qed
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3507
  next
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3508
    show "tm_wf0 t_wcode_prepare"
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3509
      by auto
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3510
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3511
  thus "?thesis"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3512
    apply(auto simp: Hoare_halt_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3513
    apply(rule_tac x = n in exI)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3514
    apply(case_tac "(steps0 (Suc 0, [], <m # args>)
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3515
      (Turing.adjust t_wcode_prepare @ shift t_wcode_main (length t_wcode_prepare div 2)) n)")
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3516
    apply(auto simp: tm_comp.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3517
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3518
qed
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3519
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3520
definition tinres :: "cell list \<Rightarrow> cell list \<Rightarrow> bool"
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3521
  where
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3522
  "tinres xs ys = (\<exists>n. xs = ys @ Bk \<up> n \<or> ys = xs @ Bk \<up> n)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3523
   
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3524
lemma [simp]:  "tinres r r' \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3525
  fetch t ss (read r) = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3526
  fetch t ss (read r')"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3527
apply(simp add: fetch.simps, auto split: if_splits simp: tinres_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3528
apply(case_tac [!] n, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3529
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3530
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3531
lemma [intro]: "\<exists> n. (a::cell)\<up>(n) = []"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3532
by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3533
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3534
lemma [simp]: "\<lbrakk>tinres r r'; r \<noteq> []; r' \<noteq> []\<rbrakk> \<Longrightarrow> hd r = hd r'"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3535
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3536
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3537
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3538
lemma [intro]: "hd (Bk\<up>(Suc n)) = Bk"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3539
apply(simp add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3540
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3541
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3542
lemma [simp]: "\<lbrakk>tinres r []; r \<noteq> []\<rbrakk> \<Longrightarrow> hd r = Bk"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3543
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3544
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3545
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3546
lemma [simp]: "\<lbrakk>tinres [] r'; r' \<noteq> []\<rbrakk> \<Longrightarrow> hd r' = Bk"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3547
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3548
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3549
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3550
lemma [intro]: "\<exists>na. tl r = tl (r @ Bk\<up>(n)) @ Bk\<up>(na) \<or> tl (r @ Bk\<up>(n)) = tl r @ Bk\<up>(na)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3551
apply(case_tac r, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3552
apply(case_tac n, simp, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3553
apply(rule_tac x = nat in exI, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3554
apply(rule_tac x = n in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3555
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3556
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3557
lemma [simp]: "tinres r r' \<Longrightarrow> tinres (tl r) (tl r')"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3558
apply(auto simp: tinres_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3559
apply(case_tac r', simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3560
apply(case_tac n, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3561
apply(rule_tac x = nat in exI, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3562
apply(rule_tac x = n in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3563
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3564
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3565
lemma [simp]: "\<lbrakk>tinres r [];  r \<noteq> []\<rbrakk> \<Longrightarrow> tinres (tl r) []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3566
apply(case_tac r, auto simp: tinres_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3567
apply(case_tac n, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3568
apply(rule_tac x = nat in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3569
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3570
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3571
lemma [simp]: "\<lbrakk>tinres [] r'\<rbrakk> \<Longrightarrow> tinres [] (tl r')"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3572
apply(case_tac r', auto simp: tinres_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3573
apply(case_tac n, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3574
apply(rule_tac x = nat in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3575
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3576
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3577
lemma [simp]: "tinres r r' \<Longrightarrow> tinres (b # r) (b # r')"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3578
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3579
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3580
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3581
lemma [simp]: "tinres r [] \<Longrightarrow> tinres (Bk # tl r) [Bk]"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3582
apply(auto simp: tinres_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3583
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3584
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3585
lemma [simp]: "tinres r [] \<Longrightarrow> tinres (Oc # tl r) [Oc]"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3586
apply(auto simp: tinres_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3587
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3588
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3589
lemma tinres_step2: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3590
  "\<lbrakk>tinres r r'; step0 (ss, l, r) t = (sa, la, ra); step0 (ss, l, r') t = (sb, lb, rb)\<rbrakk>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3591
    \<Longrightarrow> la = lb \<and> tinres ra rb \<and> sa = sb"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3592
apply(case_tac "ss = 0", simp add: step_0)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3593
apply(simp add: step.simps [simp del], auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3594
apply(case_tac [!] "fetch t ss (read r')", simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3595
apply(auto simp: update.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3596
apply(case_tac [!] a, auto split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3597
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3598
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3599
lemma tinres_steps2: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3600
  "\<lbrakk>tinres r r'; steps0 (ss, l, r) t stp = (sa, la, ra); steps0 (ss, l, r') t stp = (sb, lb, rb)\<rbrakk>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3601
    \<Longrightarrow> la = lb \<and> tinres ra rb \<and> sa = sb"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3602
apply(induct stp arbitrary: sa la ra sb lb rb, simp add: steps.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3603
apply(simp add: step_red)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3604
apply(case_tac "(steps0 (ss, l, r) t stp)")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3605
apply(case_tac "(steps0 (ss, l, r') t stp)")
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3606
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3607
  fix stp sa la ra sb lb rb a b c aa ba ca
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3608
  assume ind: "\<And>sa la ra sb lb rb. \<lbrakk>steps0 (ss, l, r) t stp = (sa, la, ra); 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3609
    steps0 (ss, l, r') t stp = (sb, lb, rb)\<rbrakk> \<Longrightarrow> la = lb \<and> tinres ra rb \<and> sa = sb"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3610
  and h: " tinres r r'" "step0 (steps0 (ss, l, r) t stp) t = (sa, la, ra)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3611
         "step0 (steps0 (ss, l, r') t stp) t = (sb, lb, rb)" "steps0 (ss, l, r) t stp = (a, b, c)" 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3612
         "steps0 (ss, l, r') t stp = (aa, ba, ca)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3613
  have "b = ba \<and> tinres c ca \<and> a = aa"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3614
    apply(rule_tac ind, simp_all add: h)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3615
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3616
  thus "la = lb \<and> tinres ra rb \<and> sa = sb"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3617
    apply(rule_tac l = b  and r = c  and ss = a and r' = ca   
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3618
            and t = t in tinres_step2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3619
    using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3620
    apply(simp, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3621
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3622
qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3623
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3624
definition t_wcode_adjust :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3625
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3626
  "t_wcode_adjust = [(W1, 1), (R, 2), (Nop, 2), (R, 3), (R, 3), (R, 4), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3627
                   (L, 8), (L, 5), (L, 6), (W0, 5), (L, 6), (R, 7), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3628
                   (W1, 2), (Nop, 7), (L, 9), (W0, 8), (L, 9), (L, 10), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3629
                    (L, 11), (L, 10), (R, 0), (L, 11)]"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3630
                 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3631
lemma [simp]: "fetch t_wcode_adjust (Suc 0) Bk = (W1, 1)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3632
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3633
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3634
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3635
lemma [simp]: "fetch t_wcode_adjust (Suc 0) Oc = (R, 2)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3636
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3637
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3638
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3639
lemma [simp]: "fetch t_wcode_adjust (Suc (Suc 0)) Oc = (R, 3)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3640
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3641
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3642
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3643
lemma [simp]: "fetch t_wcode_adjust (Suc (Suc (Suc 0))) Oc = (R, 4)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3644
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3645
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3646
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3647
lemma [simp]: "fetch t_wcode_adjust  (Suc (Suc (Suc 0))) Bk = (R, 3)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3648
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3649
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3650
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  3651
lemma [simp]: "fetch t_wcode_adjust 4 Bk = (L, 8)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3652
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_4_eq_4)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3653
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3654
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  3655
lemma [simp]: "fetch t_wcode_adjust 4 Oc = (L, 5)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3656
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_4_eq_4)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3657
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3658
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3659
lemma [simp]: "fetch t_wcode_adjust 5 Oc = (W0, 5)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3660
apply(simp only: fetch.simps t_wcode_adjust_def nth_of.simps numeral_5_eq_5, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3661
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3662
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3663
lemma [simp]: "fetch t_wcode_adjust 5 Bk = (L, 6)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3664
apply(simp only: fetch.simps t_wcode_adjust_def nth_of.simps numeral_5_eq_5, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3665
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3666
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3667
thm numeral_6_eq_6
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3668
lemma [simp]: "fetch t_wcode_adjust 6 Oc = (R, 7)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3669
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_6_eq_6)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3670
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3671
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3672
lemma [simp]: "fetch t_wcode_adjust 6 Bk = (L, 6)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3673
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_6_eq_6)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3674
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3675
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3676
lemma [simp]: "fetch t_wcode_adjust 7 Bk = (W1, 2)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3677
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_7_eq_7)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3678
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3679
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3680
lemma [simp]: "fetch t_wcode_adjust 8 Bk = (L, 9)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3681
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_8_eq_8)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3682
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3683
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3684
lemma [simp]: "fetch t_wcode_adjust 8 Oc = (W0, 8)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3685
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_8_eq_8)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3686
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3687
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3688
lemma [simp]: "fetch t_wcode_adjust 9 Oc = (L, 10)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3689
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_9_eq_9)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3690
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3691
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3692
lemma [simp]: "fetch t_wcode_adjust 9 Bk = (L, 9)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3693
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_9_eq_9)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3694
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3695
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3696
lemma [simp]: "fetch t_wcode_adjust 10 Bk = (L, 11)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3697
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps  numeral_10_eq_10)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3698
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3699
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3700
lemma [simp]: "fetch t_wcode_adjust 10 Oc = (L, 10)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3701
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps eval_nat_numeral)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3702
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3703
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3704
lemma [simp]: "fetch t_wcode_adjust 11 Oc = (L, 11)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3705
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps eval_nat_numeral)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3706
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3707
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3708
lemma [simp]: "fetch t_wcode_adjust 11 Bk = (R, 0)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3709
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps eval_nat_numeral)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3710
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3711
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3712
fun wadjust_start :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3713
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3714
  "wadjust_start m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3715
         (\<exists> ln rn. l = Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3716
                   tl r = Oc # Bk\<up>(ln) @ Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3717
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3718
fun wadjust_loop_start :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3719
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3720
  "wadjust_loop_start m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3721
          (\<exists> ln rn ml mr. l = Oc\<up>(ml) @ Bk # Oc\<up>(Suc m)  \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3722
                          r = Oc # Bk\<up>(ln) @ Bk # Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3723
                          ml + mr = Suc (Suc rs) \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3724
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3725
fun wadjust_loop_right_move :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3726
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3727
  "wadjust_loop_right_move m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3728
   (\<exists> ml mr nl nr rn. l = Bk\<up>(nl) @ Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3729
                      r = Bk\<up>(nr) @ Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3730
                      ml + mr = Suc (Suc rs) \<and> mr > 0 \<and>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3731
                      nl + nr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3732
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3733
fun wadjust_loop_check :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3734
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3735
  "wadjust_loop_check m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3736
  (\<exists> ml mr ln rn. l = Oc # Bk\<up>(ln) @ Bk # Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3737
                  r = Oc\<up>(mr) @ Bk\<up>(rn) \<and> ml + mr = (Suc rs))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3738
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3739
fun wadjust_loop_erase :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3740
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3741
  "wadjust_loop_erase m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3742
    (\<exists> ml mr ln rn. l = Bk\<up>(ln) @ Bk # Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3743
                    tl r = Oc\<up>(mr) @ Bk\<up>(rn) \<and> ml + mr = (Suc rs) \<and> mr > 0)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3744
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3745
fun wadjust_loop_on_left_moving_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3746
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3747
  "wadjust_loop_on_left_moving_O m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3748
      (\<exists> ml mr ln rn. l = Oc\<up>(ml) @ Bk # Oc\<up>(Suc m )\<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3749
                      r = Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3750
                      ml + mr = Suc rs \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3751
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3752
fun wadjust_loop_on_left_moving_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3753
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3754
  "wadjust_loop_on_left_moving_B m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3755
      (\<exists> ml mr nl nr rn. l = Bk\<up>(nl) @ Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3756
                         r = Bk\<up>(nr) @ Bk # Bk # Oc\<up>(mr) @ Bk\<up>(rn) \<and> 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3757
                         ml + mr = Suc rs \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3758
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3759
fun wadjust_loop_on_left_moving :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3760
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3761
  "wadjust_loop_on_left_moving m rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3762
       (wadjust_loop_on_left_moving_O m rs (l, r) \<or>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3763
       wadjust_loop_on_left_moving_B m rs (l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3764
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3765
fun wadjust_loop_right_move2 :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3766
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3767
  "wadjust_loop_right_move2 m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3768
        (\<exists> ml mr ln rn. l = Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3769
                        r = Bk\<up>(ln) @ Bk # Bk # Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3770
                        ml + mr = Suc rs \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3771
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3772
fun wadjust_erase2 :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3773
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3774
  "wadjust_erase2 m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3775
     (\<exists> ln rn. l = Bk\<up>(ln) @ Bk # Oc # Oc\<up>(Suc rs) @ Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3776
                     tl r = Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3777
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3778
fun wadjust_on_left_moving_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3779
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3780
  "wadjust_on_left_moving_O m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3781
        (\<exists> rn. l = Oc\<up>(Suc rs) @ Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3782
                  r = Oc # Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3783
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3784
fun wadjust_on_left_moving_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3785
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3786
  "wadjust_on_left_moving_B m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3787
         (\<exists> ln rn. l = Bk\<up>(ln) @ Oc # Oc\<up>(Suc rs) @ Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3788
                   r = Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3789
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3790
fun wadjust_on_left_moving :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3791
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3792
  "wadjust_on_left_moving m rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3793
      (wadjust_on_left_moving_O m rs (l, r) \<or>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3794
       wadjust_on_left_moving_B m rs (l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3795
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3796
fun wadjust_goon_left_moving_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3797
  where 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3798
  "wadjust_goon_left_moving_B m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3799
        (\<exists> rn. l = Oc\<up>(Suc m) \<and> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3800
               r = Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3801
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3802
fun wadjust_goon_left_moving_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3803
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3804
  "wadjust_goon_left_moving_O m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3805
      (\<exists> ml mr rn. l = Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3806
                      r = Oc\<up>(mr) @ Bk\<up>(rn) \<and> 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3807
                      ml + mr = Suc (Suc rs) \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3808
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3809
fun wadjust_goon_left_moving :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3810
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3811
  "wadjust_goon_left_moving m rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3812
            (wadjust_goon_left_moving_B m rs (l, r) \<or>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3813
             wadjust_goon_left_moving_O m rs (l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3814
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3815
fun wadjust_backto_standard_pos_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3816
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3817
  "wadjust_backto_standard_pos_B m rs (l, r) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3818
        (\<exists> rn. l = [] \<and> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3819
               r = Bk # Oc\<up>(Suc m )@ Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3820
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3821
fun wadjust_backto_standard_pos_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3822
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3823
  "wadjust_backto_standard_pos_O m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3824
      (\<exists> ml mr rn. l = Oc\<up>(ml) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3825
                      r = Oc\<up>(mr) @ Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn) \<and> 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3826
                      ml + mr = Suc m \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3827
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3828
fun wadjust_backto_standard_pos :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3829
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3830
  "wadjust_backto_standard_pos m rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3831
        (wadjust_backto_standard_pos_B m rs (l, r) \<or> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3832
        wadjust_backto_standard_pos_O m rs (l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3833
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3834
fun wadjust_stop :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3835
where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3836
  "wadjust_stop m rs (l, r) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3837
        (\<exists> rn. l = [Bk] \<and> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3838
               r = Oc\<up>(Suc m )@ Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3839
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3840
declare wadjust_start.simps[simp del]  wadjust_loop_start.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3841
        wadjust_loop_right_move.simps[simp del]  wadjust_loop_check.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3842
        wadjust_loop_erase.simps[simp del] wadjust_loop_on_left_moving.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3843
        wadjust_loop_right_move2.simps[simp del] wadjust_erase2.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3844
        wadjust_on_left_moving_O.simps[simp del] wadjust_on_left_moving_B.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3845
        wadjust_on_left_moving.simps[simp del] wadjust_goon_left_moving_B.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3846
        wadjust_goon_left_moving_O.simps[simp del] wadjust_goon_left_moving.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3847
        wadjust_backto_standard_pos.simps[simp del] wadjust_backto_standard_pos_B.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3848
        wadjust_backto_standard_pos_O.simps[simp del] wadjust_stop.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3849
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3850
fun wadjust_inv :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3851
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3852
  "wadjust_inv st m rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3853
       (if st = Suc 0 then wadjust_start m rs (l, r) 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3854
        else if st = Suc (Suc 0) then wadjust_loop_start m rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3855
        else if st = Suc (Suc (Suc 0)) then wadjust_loop_right_move m rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3856
        else if st = 4 then wadjust_loop_check m rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3857
        else if st = 5 then wadjust_loop_erase m rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3858
        else if st = 6 then wadjust_loop_on_left_moving m rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3859
        else if st = 7 then wadjust_loop_right_move2 m rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3860
        else if st = 8 then wadjust_erase2 m rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3861
        else if st = 9 then wadjust_on_left_moving m rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3862
        else if st = 10 then wadjust_goon_left_moving m rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3863
        else if st = 11 then wadjust_backto_standard_pos m rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3864
        else if st = 0 then wadjust_stop m rs (l, r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3865
        else False
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3866
)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3867
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3868
declare wadjust_inv.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3869
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3870
fun wadjust_phase :: "nat \<Rightarrow> config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3871
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3872
  "wadjust_phase rs (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3873
         (if st = 1 then 3 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3874
          else if st \<ge> 2 \<and> st \<le> 7 then 2
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3875
          else if st \<ge> 8 \<and> st \<le> 11 then 1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3876
          else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3877
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3878
fun wadjust_stage :: "nat \<Rightarrow> config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3879
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3880
  "wadjust_stage rs (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3881
           (if st \<ge> 2 \<and> st \<le> 7 then 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3882
                  rs - length (takeWhile (\<lambda> a. a = Oc) 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3883
                          (tl (dropWhile (\<lambda> a. a = Oc) (rev l @ r))))
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3884
            else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3885
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3886
fun wadjust_state :: "nat \<Rightarrow> config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3887
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3888
  "wadjust_state rs (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3889
       (if st \<ge> 2 \<and> st \<le> 7 then 8 - st
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3890
        else if st \<ge> 8 \<and> st \<le> 11 then 12 - st
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3891
        else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3892
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3893
fun wadjust_step :: "nat \<Rightarrow> config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3894
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3895
  "wadjust_step rs (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3896
       (if st = 1 then (if hd r = Bk then 1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3897
                        else 0) 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3898
        else if st = 3 then length r
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3899
        else if st = 5 then (if hd r = Oc then 1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3900
                             else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3901
        else if st = 6 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3902
        else if st = 8 then (if hd r = Oc then 1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3903
                             else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3904
        else if st = 9 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3905
        else if st = 10 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3906
        else if st = 11 then (if hd r = Bk then 0
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3907
                              else Suc (length l))
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3908
        else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3909
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3910
fun wadjust_measure :: "(nat \<times> config) \<Rightarrow> nat \<times> nat \<times> nat \<times> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3911
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3912
  "wadjust_measure (rs, (st, l, r)) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3913
     (wadjust_phase rs (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3914
      wadjust_stage rs (st, l, r),
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3915
      wadjust_state rs (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3916
      wadjust_step rs (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3917
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3918
definition wadjust_le :: "((nat \<times> config) \<times> nat \<times> config) set"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3919
  where "wadjust_le \<equiv> (inv_image lex_square wadjust_measure)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3920
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3921
lemma [intro]: "wf lex_square"
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3922
by(auto intro:wf_lex_prod simp: Abacus.lex_pair_def lex_square_def 
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3923
  Abacus.lex_triple_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3924
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3925
lemma wf_wadjust_le[intro]: "wf wadjust_le"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3926
by(auto intro:wf_inv_image simp: wadjust_le_def
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3927
           Abacus.lex_triple_def Abacus.lex_pair_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3928
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3929
lemma [simp]: "wadjust_start m rs (c, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3930
apply(auto simp: wadjust_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3931
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3932
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3933
lemma [simp]: "wadjust_loop_right_move m rs (c, []) \<Longrightarrow> c \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3934
apply(auto simp: wadjust_loop_right_move.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3935
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3936
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3937
lemma [simp]: "wadjust_loop_right_move m rs (c, [])
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3938
        \<Longrightarrow>  wadjust_loop_check m rs (Bk # c, [])"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3939
apply(simp only: wadjust_loop_right_move.simps wadjust_loop_check.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3940
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3941
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3942
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3943
lemma [simp]: "wadjust_loop_check m rs (c, []) \<Longrightarrow> c \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3944
apply(simp only: wadjust_loop_check.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3945
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3946
 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3947
lemma [simp]: "wadjust_loop_start m rs (c, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3948
apply(simp add: wadjust_loop_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3949
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3950
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3951
lemma [simp]: "wadjust_loop_right_move m rs (c, []) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3952
  wadjust_loop_right_move m rs (Bk # c, [])"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3953
apply(simp only: wadjust_loop_right_move.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3954
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3955
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3956
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3957
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3958
lemma [simp]: "wadjust_loop_check m rs (c, []) \<Longrightarrow> wadjust_erase2 m rs (tl c, [hd c])"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3959
apply(simp only: wadjust_loop_check.simps wadjust_erase2.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3960
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3961
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3962
lemma [simp]: " wadjust_loop_erase m rs (c, [])
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3963
    \<Longrightarrow> (c = [] \<longrightarrow> wadjust_loop_on_left_moving m rs ([], [Bk])) \<and>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3964
        (c \<noteq> [] \<longrightarrow> wadjust_loop_on_left_moving m rs (tl c, [hd c]))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3965
apply(simp add: wadjust_loop_erase.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3966
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3967
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3968
lemma [simp]: "wadjust_loop_on_left_moving m rs (c, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3969
apply(auto simp: wadjust_loop_on_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3970
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3971
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3972
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3973
lemma [simp]: "wadjust_loop_right_move2 m rs (c, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3974
apply(auto simp: wadjust_loop_right_move2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3975
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3976
   
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3977
lemma [simp]: "wadjust_erase2 m rs ([], []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3978
apply(auto simp: wadjust_erase2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3979
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3980
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3981
lemma [simp]: "wadjust_on_left_moving_B m rs 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3982
                 (Oc # Oc # Oc\<up>(rs) @ Bk # Oc # Oc\<up>(m), [Bk])"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3983
apply(simp add: wadjust_on_left_moving_B.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3984
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3985
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3986
lemma [simp]: "wadjust_on_left_moving_B m rs 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3987
                 (Bk\<up>(n) @ Bk # Oc # Oc # Oc\<up>(rs) @ Bk # Oc # Oc\<up>(m), [Bk])"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3988
apply(simp add: wadjust_on_left_moving_B.simps , auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3989
apply(rule_tac x = "Suc n" in exI, simp add: exp_ind del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3990
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3991
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3992
lemma [simp]: "\<lbrakk>wadjust_erase2 m rs (c, []); c \<noteq> []\<rbrakk> \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3993
            wadjust_on_left_moving m rs (tl c, [hd c])"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3994
apply(simp only: wadjust_erase2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3995
apply(erule_tac exE)+
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3996
apply(case_tac ln, simp_all add:  wadjust_on_left_moving.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3997
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3998
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3999
lemma [simp]: "wadjust_erase2 m rs (c, [])
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4000
    \<Longrightarrow> (c = [] \<longrightarrow> wadjust_on_left_moving m rs ([], [Bk])) \<and> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4001
       (c \<noteq> [] \<longrightarrow> wadjust_on_left_moving m rs (tl c, [hd c]))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4002
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4003
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4004
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4005
lemma [simp]: "wadjust_on_left_moving m rs ([], []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4006
apply(simp add: wadjust_on_left_moving.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4007
  wadjust_on_left_moving_O.simps wadjust_on_left_moving_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4008
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4009
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4010
lemma [simp]: "wadjust_on_left_moving_O m rs (c, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4011
apply(simp add: wadjust_on_left_moving_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4012
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4013
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4014
lemma [simp]: " \<lbrakk>wadjust_on_left_moving_B m rs (c, []); c \<noteq> []; hd c = Bk\<rbrakk> \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4015
                                      wadjust_on_left_moving_B m rs (tl c, [Bk])"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4016
apply(simp add: wadjust_on_left_moving_B.simps, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4017
apply(case_tac [!] ln, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4018
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4019
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4020
lemma [simp]: "\<lbrakk>wadjust_on_left_moving_B m rs (c, []); c \<noteq> []; hd c = Oc\<rbrakk> \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4021
                                  wadjust_on_left_moving_O m rs (tl c, [Oc])"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4022
apply(simp add: wadjust_on_left_moving_B.simps wadjust_on_left_moving_O.simps, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4023
apply(case_tac [!] ln, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4024
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4025
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4026
lemma [simp]: "\<lbrakk>wadjust_on_left_moving m rs (c, []); c \<noteq> []\<rbrakk> \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4027
  wadjust_on_left_moving m rs (tl c, [hd c])"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4028
apply(simp add: wadjust_on_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4029
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4030
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4031
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4032
lemma [simp]: "wadjust_on_left_moving m rs (c, [])
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4033
    \<Longrightarrow> (c = [] \<longrightarrow> wadjust_on_left_moving m rs ([], [Bk])) \<and> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4034
       (c \<noteq> [] \<longrightarrow> wadjust_on_left_moving m rs (tl c, [hd c]))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4035
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4036
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4037
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4038
lemma [simp]: "wadjust_goon_left_moving m rs (c, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4039
apply(auto simp: wadjust_goon_left_moving.simps wadjust_goon_left_moving_B.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4040
                 wadjust_goon_left_moving_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4041
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4042
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4043
lemma [simp]: "wadjust_backto_standard_pos m rs (c, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4044
apply(auto simp: wadjust_backto_standard_pos.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4045
 wadjust_backto_standard_pos_B.simps wadjust_backto_standard_pos_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4046
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4047
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4048
lemma [simp]:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4049
  "wadjust_start m rs (c, Bk # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4050
  (c = [] \<longrightarrow> wadjust_start m rs ([], Oc # list)) \<and> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4051
  (c \<noteq> [] \<longrightarrow> wadjust_start m rs (c, Oc # list))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4052
apply(auto simp: wadjust_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4053
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4054
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4055
lemma [simp]: "wadjust_loop_start m rs (c, Bk # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4056
apply(auto simp: wadjust_loop_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4057
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4058
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4059
lemma [simp]: "wadjust_loop_right_move m rs (c, b) \<Longrightarrow> c \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4060
apply(simp only: wadjust_loop_right_move.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4061
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4062
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4063
lemma [simp]: "wadjust_loop_right_move m rs (c, Bk # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4064
    \<Longrightarrow> wadjust_loop_right_move m rs (Bk # c, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4065
apply(simp only: wadjust_loop_right_move.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4066
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4067
apply(rule_tac x = ml in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4068
apply(rule_tac x = mr in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4069
apply(rule_tac x = "Suc nl" in exI, simp add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4070
apply(case_tac nr, simp, case_tac mr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4071
apply(rule_tac x = nat in exI, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4072
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4073
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4074
lemma [simp]: "wadjust_loop_check m rs (c, b) \<Longrightarrow> c \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4075
apply(simp only: wadjust_loop_check.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4076
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4077
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4078
lemma [simp]: "wadjust_loop_check m rs (c, Bk # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4079
              \<Longrightarrow>  wadjust_erase2 m rs (tl c, hd c # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4080
apply(auto simp: wadjust_loop_check.simps wadjust_erase2.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4081
apply(case_tac [!] mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4082
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4083
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4084
lemma [simp]: "wadjust_loop_erase m rs (c, b) \<Longrightarrow> c \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4085
apply(simp only: wadjust_loop_erase.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4086
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4087
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4088
declare wadjust_loop_on_left_moving_O.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4089
        wadjust_loop_on_left_moving_B.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4090
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4091
lemma [simp]: "\<lbrakk>wadjust_loop_erase m rs (c, Bk # list); hd c = Bk\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4092
    \<Longrightarrow> wadjust_loop_on_left_moving_B m rs (tl c, Bk # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4093
apply(simp only: wadjust_loop_erase.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4094
  wadjust_loop_on_left_moving_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4095
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4096
apply(rule_tac x = ml in exI, rule_tac x = mr in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4097
      rule_tac x = ln in exI, rule_tac x = 0 in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4098
apply(case_tac ln, simp_all add: , auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4099
apply(simp add: exp_ind [THEN sym])
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4100
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4101
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4102
lemma [simp]: "\<lbrakk>wadjust_loop_erase m rs (c, Bk # list); c \<noteq> []; hd c = Oc\<rbrakk> \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4103
             wadjust_loop_on_left_moving_O m rs (tl c, Oc # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4104
apply(simp only: wadjust_loop_erase.simps wadjust_loop_on_left_moving_O.simps,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4105
       auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4106
apply(case_tac [!] ln, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4107
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4108
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4109
lemma [simp]: "\<lbrakk>wadjust_loop_erase m rs (c, Bk # list); c \<noteq> []\<rbrakk> \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4110
                wadjust_loop_on_left_moving m rs (tl c, hd c # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4111
apply(case_tac "hd c", simp_all add:wadjust_loop_on_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4112
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4113
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4114
lemma [simp]: "wadjust_loop_on_left_moving m rs (c, b) \<Longrightarrow> c \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4115
apply(simp add: wadjust_loop_on_left_moving.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4116
wadjust_loop_on_left_moving_O.simps wadjust_loop_on_left_moving_B.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4117
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4118
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4119
lemma [simp]: "wadjust_loop_on_left_moving_O m rs (c, Bk # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4120
apply(simp add: wadjust_loop_on_left_moving_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4121
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4122
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4123
lemma [simp]: "\<lbrakk>wadjust_loop_on_left_moving_B m rs (c, Bk # list); hd c = Bk\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4124
    \<Longrightarrow>  wadjust_loop_on_left_moving_B m rs (tl c, Bk # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4125
apply(simp only: wadjust_loop_on_left_moving_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4126
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4127
apply(rule_tac x = ml in exI, rule_tac x = mr in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4128
apply(case_tac nl, simp_all add: , auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4129
apply(rule_tac x = "Suc nr" in exI, auto simp: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4130
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4131
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4132
lemma [simp]: "\<lbrakk>wadjust_loop_on_left_moving_B m rs (c, Bk # list); hd c = Oc\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4133
    \<Longrightarrow> wadjust_loop_on_left_moving_O m rs (tl c, Oc # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4134
apply(simp only: wadjust_loop_on_left_moving_O.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4135
                 wadjust_loop_on_left_moving_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4136
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4137
apply(rule_tac x = ml in exI, rule_tac x = mr in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4138
apply(case_tac nl, simp_all add: , auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4139
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4140
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4141
lemma [simp]: "wadjust_loop_on_left_moving m rs (c, Bk # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4142
            \<Longrightarrow> wadjust_loop_on_left_moving m rs (tl c, hd c # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4143
apply(simp add: wadjust_loop_on_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4144
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4145
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4146
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4147
lemma [simp]: "wadjust_loop_right_move2 m rs (c, b) \<Longrightarrow> c \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4148
apply(simp only: wadjust_loop_right_move2.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4149
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4150
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4151
lemma [simp]: "wadjust_loop_right_move2 m rs (c, Bk # list) \<Longrightarrow>  wadjust_loop_start m rs (c, Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4152
apply(auto simp: wadjust_loop_right_move2.simps wadjust_loop_start.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4153
apply(case_tac ln, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4154
apply(rule_tac x = 0 in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4155
apply(rule_tac x = rn in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4156
apply(rule_tac x = "Suc ml" in exI, simp add: , auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4157
apply(rule_tac x = "Suc nat" in exI, simp add: exp_ind del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4158
apply(rule_tac x = rn in exI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4159
apply(rule_tac x = "Suc ml" in exI, auto )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4160
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4161
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4162
lemma [simp]: "wadjust_erase2 m rs (c, Bk # list) \<Longrightarrow> c \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4163
apply(auto simp:wadjust_erase2.simps )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4164
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4165
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4166
lemma [simp]: "wadjust_erase2 m rs (c, Bk # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4167
                 wadjust_on_left_moving m rs (tl c, hd c # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4168
apply(auto simp: wadjust_erase2.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4169
apply(case_tac ln, simp_all add:  wadjust_on_left_moving.simps 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4170
        wadjust_on_left_moving_O.simps wadjust_on_left_moving_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4171
apply(auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4172
apply(rule_tac x = "(Suc (Suc rn))" in exI, simp add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4173
apply(rule_tac x = "Suc nat" in exI, simp add: exp_ind del: replicate_Suc)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4174
apply(rule_tac x = "(Suc (Suc rn))" in exI, simp add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4175
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4176
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4177
lemma [simp]: "wadjust_on_left_moving m rs (c,b) \<Longrightarrow> c \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4178
apply(simp only:wadjust_on_left_moving.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4179
                wadjust_on_left_moving_O.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4180
                wadjust_on_left_moving_B.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4181
             , auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4182
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4183
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4184
lemma [simp]: "wadjust_on_left_moving_O m rs (c, Bk # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4185
apply(simp add: wadjust_on_left_moving_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4186
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4187
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4188
lemma [simp]: "\<lbrakk>wadjust_on_left_moving_B m rs (c, Bk # list); hd c = Bk\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4189
    \<Longrightarrow> wadjust_on_left_moving_B m rs (tl c, Bk # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4190
apply(auto simp: wadjust_on_left_moving_B.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4191
apply(case_tac ln, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4192
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4193
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4194
lemma [simp]: "\<lbrakk>wadjust_on_left_moving_B m rs (c, Bk # list); hd c = Oc\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4195
    \<Longrightarrow> wadjust_on_left_moving_O m rs (tl c, Oc # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4196
apply(auto simp: wadjust_on_left_moving_O.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4197
                 wadjust_on_left_moving_B.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4198
apply(case_tac ln, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4199
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4200
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4201
lemma [simp]: "wadjust_on_left_moving  m rs (c, Bk # list) \<Longrightarrow>  
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4202
                  wadjust_on_left_moving m rs (tl c, hd c # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4203
apply(simp add: wadjust_on_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4204
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4205
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4206
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4207
lemma [simp]: "wadjust_goon_left_moving m rs (c, b) \<Longrightarrow> c \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4208
apply(simp add: wadjust_goon_left_moving.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4209
                wadjust_goon_left_moving_B.simps
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4210
                wadjust_goon_left_moving_O.simps , auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4211
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4212
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4213
lemma [simp]: "wadjust_goon_left_moving_O m rs (c, Bk # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4214
apply(simp add: wadjust_goon_left_moving_O.simps, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4215
apply(case_tac mr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4216
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4217
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4218
lemma [simp]: "\<lbrakk>wadjust_goon_left_moving_B m rs (c, Bk # list); hd c = Bk\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4219
    \<Longrightarrow> wadjust_backto_standard_pos_B m rs (tl c, Bk # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4220
apply(auto simp: wadjust_goon_left_moving_B.simps 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4221
                 wadjust_backto_standard_pos_B.simps )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4222
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4223
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4224
lemma [simp]: "\<lbrakk>wadjust_goon_left_moving_B m rs (c, Bk # list); hd c = Oc\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4225
    \<Longrightarrow> wadjust_backto_standard_pos_O m rs (tl c, Oc # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4226
apply(auto simp: wadjust_goon_left_moving_B.simps 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4227
                 wadjust_backto_standard_pos_O.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4228
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4229
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4230
lemma [simp]: "wadjust_goon_left_moving m rs (c, Bk # list) \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4231
  wadjust_backto_standard_pos m rs (tl c, hd c # Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4232
apply(case_tac "hd c", simp_all add: wadjust_backto_standard_pos.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4233
                                     wadjust_goon_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4234
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4235
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4236
lemma [simp]: "wadjust_backto_standard_pos m rs (c, Bk # list) \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4237
  (c = [] \<longrightarrow> wadjust_stop m rs ([Bk], list)) \<and> (c \<noteq> [] \<longrightarrow> wadjust_stop m rs (Bk # c, list))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4238
apply(auto simp: wadjust_backto_standard_pos.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4239
                 wadjust_backto_standard_pos_B.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4240
                 wadjust_backto_standard_pos_O.simps wadjust_stop.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4241
apply(case_tac [!] mr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4242
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4243
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4244
lemma [simp]: "wadjust_start m rs (c, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4245
              \<Longrightarrow> (c = [] \<longrightarrow> wadjust_loop_start m rs ([Oc], list)) \<and>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4246
                (c \<noteq> [] \<longrightarrow> wadjust_loop_start m rs (Oc # c, list))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4247
apply(auto simp:wadjust_loop_start.simps wadjust_start.simps )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4248
apply(rule_tac x = ln in exI, rule_tac x = rn in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4249
      rule_tac x = "Suc 0" in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4250
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4251
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4252
lemma [simp]: "wadjust_loop_start m rs (c, b) \<Longrightarrow> c \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4253
apply(simp add: wadjust_loop_start.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4254
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4255
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4256
lemma [simp]: "wadjust_loop_start m rs (c, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4257
              \<Longrightarrow> wadjust_loop_right_move m rs (Oc # c, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4258
apply(simp add: wadjust_loop_start.simps wadjust_loop_right_move.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4259
apply(rule_tac x = ml in exI, rule_tac x = mr in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4260
      rule_tac x = 0 in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4261
apply(rule_tac x = "Suc ln" in exI, simp add: exp_ind del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4262
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4263
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4264
lemma [simp]: "wadjust_loop_right_move m rs (c, Oc # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4265
                       wadjust_loop_check m rs (Oc # c, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4266
apply(simp add: wadjust_loop_right_move.simps  
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4267
                 wadjust_loop_check.simps, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4268
apply(rule_tac [!] x = ml in exI, simp_all add: exp_ind del: replicate_Suc, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4269
apply(case_tac nl, simp_all add: exp_ind del: replicate_Suc)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4270
apply(rule_tac x = "mr - 1" in exI, case_tac mr, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4271
apply(case_tac [!] nr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4272
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4273
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4274
lemma [simp]: "wadjust_loop_check m rs (c, Oc # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4275
               wadjust_loop_erase m rs (tl c, hd c # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4276
apply(simp only: wadjust_loop_check.simps wadjust_loop_erase.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4277
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4278
apply(rule_tac x = ml in exI, rule_tac x = mr in exI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4279
apply(case_tac mr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4280
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4281
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4282
lemma [simp]: "wadjust_loop_erase m rs (c, Oc # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4283
                wadjust_loop_erase m rs (c, Bk # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4284
apply(auto simp: wadjust_loop_erase.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4285
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4286
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4287
lemma [simp]: "wadjust_loop_on_left_moving_B m rs (c, Oc # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4288
apply(auto simp: wadjust_loop_on_left_moving_B.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4289
apply(case_tac nr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4290
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4291
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4292
lemma [simp]: "wadjust_loop_on_left_moving m rs (c, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4293
           \<Longrightarrow> wadjust_loop_right_move2 m rs (Oc # c, list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4294
apply(simp add:wadjust_loop_on_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4295
apply(auto simp: wadjust_loop_on_left_moving_O.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4296
                 wadjust_loop_right_move2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4297
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4298
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4299
lemma [simp]: "wadjust_loop_right_move2 m rs (c, Oc # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4300
apply(auto simp: wadjust_loop_right_move2.simps )
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4301
apply(case_tac ln, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4302
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4303
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4304
lemma [simp]: "wadjust_erase2 m rs (c, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4305
              \<Longrightarrow> (c = [] \<longrightarrow> wadjust_erase2 m rs ([], Bk # list))
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4306
               \<and> (c \<noteq> [] \<longrightarrow> wadjust_erase2 m rs (c, Bk # list))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4307
apply(auto simp: wadjust_erase2.simps )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4308
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4309
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4310
lemma [simp]: "wadjust_on_left_moving_B m rs (c, Oc # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4311
apply(auto simp: wadjust_on_left_moving_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4312
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4313
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4314
lemma [simp]: "\<lbrakk>wadjust_on_left_moving_O m rs (c, Oc # list); hd c = Bk\<rbrakk> \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4315
         wadjust_goon_left_moving_B m rs (tl c, Bk # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4316
apply(auto simp: wadjust_on_left_moving_O.simps 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4317
     wadjust_goon_left_moving_B.simps )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4318
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4319
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4320
lemma [simp]: "\<lbrakk>wadjust_on_left_moving_O m rs (c, Oc # list); hd c = Oc\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4321
    \<Longrightarrow> wadjust_goon_left_moving_O m rs (tl c, Oc # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4322
apply(auto simp: wadjust_on_left_moving_O.simps 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4323
                 wadjust_goon_left_moving_O.simps )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4324
apply(auto simp:  numeral_2_eq_2)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4325
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4326
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4327
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4328
lemma [simp]: "wadjust_on_left_moving m rs (c, Oc # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4329
              wadjust_goon_left_moving m rs (tl c, hd c # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4330
apply(simp add: wadjust_on_left_moving.simps   
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4331
                 wadjust_goon_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4332
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4333
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4334
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4335
lemma [simp]: "wadjust_on_left_moving m rs (c, Oc # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4336
  wadjust_goon_left_moving m rs (tl c, hd c # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4337
apply(simp add: wadjust_on_left_moving.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4338
  wadjust_goon_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4339
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4340
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4341
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4342
lemma [simp]: "wadjust_goon_left_moving_B m rs (c, Oc # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4343
apply(auto simp: wadjust_goon_left_moving_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4344
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4345
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4346
lemma [simp]: "\<lbrakk>wadjust_goon_left_moving_O m rs (c, Oc # list); hd c = Bk\<rbrakk> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4347
               \<Longrightarrow> wadjust_goon_left_moving_B m rs (tl c, Bk # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4348
apply(auto simp: wadjust_goon_left_moving_O.simps wadjust_goon_left_moving_B.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4349
apply(case_tac [!] ml, auto simp: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4350
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4351
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4352
lemma  [simp]: "\<lbrakk>wadjust_goon_left_moving_O m rs (c, Oc # list); hd c = Oc\<rbrakk> \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4353
  wadjust_goon_left_moving_O m rs (tl c, Oc # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4354
apply(auto simp: wadjust_goon_left_moving_O.simps wadjust_goon_left_moving_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4355
apply(rule_tac x = "ml - 1" in exI, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4356
apply(case_tac ml, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4357
apply(rule_tac x = "Suc mr" in exI, auto simp: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4358
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4359
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4360
lemma [simp]: "wadjust_goon_left_moving m rs (c, Oc # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4361
  wadjust_goon_left_moving m rs (tl c, hd c # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4362
apply(simp add: wadjust_goon_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4363
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4364
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4365
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4366
lemma [simp]: "wadjust_backto_standard_pos_B m rs (c, Oc # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4367
apply(simp add: wadjust_backto_standard_pos_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4368
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4369
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4370
lemma [simp]: "wadjust_backto_standard_pos_O m rs (c, Bk # xs) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4371
apply(simp add: wadjust_backto_standard_pos_O.simps, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4372
apply(case_tac mr, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4373
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4374
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4375
lemma [simp]: "wadjust_backto_standard_pos_O m rs ([], Oc # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4376
  wadjust_backto_standard_pos_B m rs ([], Bk # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4377
apply(auto simp: wadjust_backto_standard_pos_O.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4378
                 wadjust_backto_standard_pos_B.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4379
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4380
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4381
lemma [simp]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4382
  "\<lbrakk>wadjust_backto_standard_pos_O m rs (c, Oc # list); c \<noteq> []; hd c = Bk\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4383
  \<Longrightarrow> wadjust_backto_standard_pos_B m rs (tl c, Bk # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4384
apply(simp add:wadjust_backto_standard_pos_O.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4385
        wadjust_backto_standard_pos_B.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4386
done 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4387
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4388
lemma [simp]: "\<lbrakk>wadjust_backto_standard_pos_O m rs (c, Oc # list); c \<noteq> []; hd c = Oc\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4389
          \<Longrightarrow>  wadjust_backto_standard_pos_O m rs (tl c, Oc # Oc # list)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4390
apply(simp add: wadjust_backto_standard_pos_O.simps, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4391
apply(case_tac ml, simp_all add: , auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4392
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4393
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4394
lemma [simp]: "wadjust_backto_standard_pos m rs (c, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4395
  \<Longrightarrow> (c = [] \<longrightarrow> wadjust_backto_standard_pos m rs ([], Bk # Oc # list)) \<and> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4396
 (c \<noteq> [] \<longrightarrow> wadjust_backto_standard_pos m rs (tl c, hd c # Oc # list))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4397
apply(auto simp: wadjust_backto_standard_pos.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4398
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4399
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4400
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4401
lemma [simp]: "wadjust_loop_right_move m rs (c, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4402
apply(simp only: wadjust_loop_right_move.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4403
apply(rule_tac iffI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4404
apply(erule_tac exE)+
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4405
apply(case_tac nr, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4406
apply(case_tac mr, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4407
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4408
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4409
lemma [simp]: "wadjust_loop_erase m rs (c, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4410
apply(simp only: wadjust_loop_erase.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4411
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4412
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4413
lemma [simp]: "\<lbrakk>Suc (Suc rs) = a;  wadjust_loop_erase m rs (c, Bk # list)\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4414
  \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list))))
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4415
  < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list)))) \<or>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4416
  a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list)))) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4417
  a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4418
apply(simp only: wadjust_loop_erase.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4419
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4420
apply(case_tac c, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4421
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4422
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4423
lemma [simp]:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4424
  "\<lbrakk>Suc (Suc rs) = a;  wadjust_loop_on_left_moving m rs (c, Bk # list)\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4425
  \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list))))
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4426
  < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list)))) \<or>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4427
  a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list)))) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4428
  a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4429
apply(subgoal_tac "c \<noteq> []")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4430
apply(case_tac c, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4431
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4432
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4433
lemma dropWhile_exp1: "dropWhile (\<lambda>a. a = Oc) (Oc\<up>(n) @ xs) = dropWhile (\<lambda>a. a = Oc) xs"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4434
apply(induct n, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4435
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4436
lemma takeWhile_exp1: "takeWhile (\<lambda>a. a = Oc) (Oc\<up>(n) @ xs) = Oc\<up>(n) @ takeWhile (\<lambda>a. a = Oc) xs"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4437
apply(induct n, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4438
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4439
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4440
lemma [simp]: "\<lbrakk>Suc (Suc rs) = a;  wadjust_loop_right_move2 m rs (c, Bk # list)\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4441
              \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list))))
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4442
                 < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4443
apply(simp add: wadjust_loop_right_move2.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4444
apply(simp add: dropWhile_exp1 takeWhile_exp1)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4445
apply(case_tac ln, simp, simp add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4446
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4447
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4448
lemma [simp]: "wadjust_loop_check m rs ([], b) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4449
apply(simp add: wadjust_loop_check.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4450
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4451
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4452
lemma [simp]: "\<lbrakk>Suc (Suc rs) = a;  wadjust_loop_check m rs (c, Oc # list)\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4453
  \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Oc # list))))
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4454
  < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list)))) \<or>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4455
  a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Oc # list)))) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4456
  a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list))))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4457
apply(case_tac "c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4458
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4459
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4460
lemma [simp]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4461
  "\<lbrakk>Suc (Suc rs) = a;  wadjust_loop_erase m rs (c, Oc # list)\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4462
  \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4463
  < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list)))) \<or>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4464
  a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list)))) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4465
  a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list))))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4466
apply(simp add: wadjust_loop_erase.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4467
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4468
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4469
apply(simp add: dropWhile_exp1 takeWhile_exp1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4470
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4471
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4472
declare numeral_2_eq_2[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4473
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4474
lemma [simp]: "wadjust_start m rs (c, Bk # list)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4475
       \<Longrightarrow> wadjust_start m rs (c, Oc # list)"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4476
apply(auto simp: wadjust_start.simps)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4477
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4478
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4479
lemma [simp]: "wadjust_backto_standard_pos m rs (c, Bk # list)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4480
       \<Longrightarrow> wadjust_stop m rs (Bk # c, list)"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4481
apply(auto simp: wadjust_backto_standard_pos.simps 
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4482
wadjust_stop.simps wadjust_backto_standard_pos_B.simps)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4483
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4484
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4485
lemma [simp]: "wadjust_start m rs (c, Oc # list)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4486
       \<Longrightarrow> wadjust_loop_start m rs (Oc # c, list)"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4487
apply(auto simp: wadjust_start.simps wadjust_loop_start.simps)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4488
apply(rule_tac x = ln in exI, simp)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4489
apply(rule_tac x = "rn" in exI, simp)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4490
apply(rule_tac x = 1 in exI, simp)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4491
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4492
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4493
lemma [simp]:" wadjust_erase2 m rs (c, Oc # list)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4494
       \<Longrightarrow> wadjust_erase2 m rs (c, Bk # list)"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4495
apply(auto simp: wadjust_erase2.simps)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4496
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4497
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4498
lemma wadjust_correctness:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4499
  shows "let P = (\<lambda> (len, st, l, r). st = 0) in 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4500
  let Q = (\<lambda> (len, st, l, r). wadjust_inv st m rs (l, r)) in 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4501
  let f = (\<lambda> stp. (Suc (Suc rs),  steps0 (Suc 0, Bk # Oc\<up>(Suc m), 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4502
                Bk # Oc # Bk\<up>(ln) @ Bk #  Oc\<up>(Suc rs) @ Bk\<up>(rn)) t_wcode_adjust stp)) in
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4503
    \<exists> n .P (f n) \<and> Q (f n)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4504
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4505
  let ?P = "(\<lambda> (len, st, l, r). st = 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4506
  let ?Q = "\<lambda> (len, st, l, r). wadjust_inv st m rs (l, r)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4507
  let ?f = "\<lambda> stp. (Suc (Suc rs),  steps0 (Suc 0, Bk # Oc\<up>(Suc m), 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4508
                Bk # Oc # Bk\<up>(ln) @ Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn)) t_wcode_adjust stp)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4509
  have "\<exists> n. ?P (?f n) \<and> ?Q (?f n)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4510
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4511
    show "wf wadjust_le" by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4512
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4513
    show "\<forall> n. \<not> ?P (?f n) \<and> ?Q (?f n) \<longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4514
                 ?Q (?f (Suc n)) \<and> (?f (Suc n), ?f n) \<in> wadjust_le"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4515
      apply(rule_tac allI, rule_tac impI, case_tac "?f n", simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4516
      apply(simp add: step.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4517
      apply(case_tac d, case_tac [2] aa, simp_all)
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4518
      apply(simp_all only: wadjust_inv.simps split: if_splits)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4519
      apply(simp_all)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4520
      apply(simp_all add: wadjust_inv.simps wadjust_le_def
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  4521
            Abacus.lex_triple_def Abacus.lex_pair_def lex_square_def  split: if_splits)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4522
      done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4523
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4524
    show "?Q (?f 0)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4525
      apply(simp add: steps.simps wadjust_inv.simps wadjust_start.simps, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4526
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4527
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4528
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4529
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4530
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4531
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4532
  thus"?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4533
    apply(simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4534
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4535
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4536
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4537
lemma [intro]: "tm_wf (t_wcode_adjust, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4538
apply(auto simp: t_wcode_adjust_def tm_wf.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4539
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4540
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4541
declare tm_comp.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4542
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4543
lemma [simp]: "args \<noteq> [] \<Longrightarrow> bl_bin (<args::nat list>) > 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4544
apply(case_tac args)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4545
apply(auto simp: tape_of_nl_cons bl_bin.simps split: if_splits)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4546
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4547
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4548
lemma wcode_lemma_pre':
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4549
  "args \<noteq> [] \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4550
  \<exists> stp rn. steps0 (Suc 0, [], <m # args>) 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4551
              ((t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust) stp
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4552
  = (0,  [Bk],  Oc\<up>(Suc m) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn))" 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4553
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4554
  let ?P1 = "\<lambda> (l, r). l = [] \<and> r = <m # args>"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4555
  let ?Q1 = "\<lambda>(l, r). l = Bk # Oc\<up>(Suc m) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4556
    (\<exists>ln rn. r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<args>)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4557
  let ?P2 = ?Q1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4558
  let ?Q2 = "\<lambda> (l, r). (wadjust_stop m (bl_bin (<args>) - 1) (l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4559
  let ?P3 = "\<lambda> tp. False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4560
  assume h: "args \<noteq> []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4561
  hence a: "bl_bin (<args>) > 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4562
    using h by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4563
  hence "{?P1} (t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust {?Q2}"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4564
  proof(rule_tac Hoare_plus_halt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4565
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4566
    show "tm_wf (t_wcode_prepare |+| t_wcode_main, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4567
      apply(rule_tac tm_wf_comp, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4568
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4569
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4570
    show "{?P1} t_wcode_prepare |+| t_wcode_main {?Q1}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4571
    proof(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4572
      show 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4573
        "\<exists>n. is_final (steps0 (Suc 0, [], <m # args>) (t_wcode_prepare |+| t_wcode_main) n) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4574
        (\<lambda>(l, r). l = Bk # Oc # Oc \<up> m \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4575
        (\<exists>ln rn. r = Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> bl_bin (<args>) @ Bk \<up> rn))
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4576
        holds_for steps0 (Suc 0, [], <m # args>) (t_wcode_prepare |+| t_wcode_main) n"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4577
        using h prepare_mainpart_lemma[of args m]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4578
        apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4579
        apply(rule_tac x = stp in exI, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4580
        apply(rule_tac x = ln in exI, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4581
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4582
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4583
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4584
    show "{?P2} t_wcode_adjust {?Q2}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4585
    proof(rule_tac Hoare_haltI, auto del: replicate_Suc)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4586
      fix ln rn
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4587
      show "\<exists>n. is_final (steps0 (Suc 0, Bk # Oc # Oc \<up> m, 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4588
        Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> bl_bin (<args>) @ Bk \<up> rn) t_wcode_adjust n) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4589
        wadjust_stop m (bl_bin (<args>) - Suc 0) holds_for steps0
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4590
        (Suc 0, Bk # Oc # Oc \<up> m, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> bl_bin (<args>) @ Bk \<up> rn) t_wcode_adjust n"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4591
        using wadjust_correctness[of m "bl_bin (<args>) - 1" "Suc ln" rn]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4592
        apply(simp del: replicate_Suc add: replicate_Suc[THEN sym] exp_ind, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4593
        apply(rule_tac x = n in exI)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4594
        using a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4595
        apply(case_tac "bl_bin (<args>)", simp, simp del: replicate_Suc add: exp_ind wadjust_inv.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4596
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4597
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4598
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4599
  thus "?thesis"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4600
    apply(simp add: Hoare_halt_def, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4601
    apply(case_tac "(steps0 (Suc 0, [], <(m::nat) # args>) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4602
      ((t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust) n)")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4603
    apply(rule_tac x = n in exI, auto simp: wadjust_stop.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4604
    using a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4605
    apply(case_tac "bl_bin (<args>)", simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4606
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4607
qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4608
    
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4609
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4610
  The initialization TM @{text "t_wcode"}.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4611
  *}
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4612
definition t_wcode :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4613
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4614
  "t_wcode = (t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4615
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4616
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4617
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4618
  The correctness of @{text "t_wcode"}.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4619
  *}
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4620
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4621
lemma wcode_lemma_1:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4622
  "args \<noteq> [] \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4623
  \<exists> stp ln rn. steps0 (Suc 0, [], <m # args>)  (t_wcode) stp = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4624
              (0,  [Bk],  Oc\<up>(Suc m) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4625
apply(simp add: wcode_lemma_pre' t_wcode_def del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4626
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4627
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4628
lemma wcode_lemma: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4629
  "args \<noteq> [] \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4630
  \<exists> stp ln rn. steps0 (Suc 0, [], <m # args>)  (t_wcode) stp = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4631
              (0,  [Bk],  <[m ,bl_bin (<args>)]> @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4632
using wcode_lemma_1[of args m]
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4633
apply(simp add: t_wcode_def tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4634
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4635
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4636
section {* The universal TM *}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4637
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4638
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4639
  This section gives the explicit construction of {\em Universal Turing Machine}, defined as @{text "UTM"} and proves its 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4640
  correctness. It is pretty easy by composing the partial results we have got so far.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4641
  *}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4642
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4643
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4644
definition UTM :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4645
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4646
  "UTM = (let (aprog, rs_pos, a_md) = rec_ci rec_F in 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4647
          let abc_F = aprog [+] dummy_abc (Suc (Suc 0)) in 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4648
          (t_wcode |+| (tm_of abc_F @ shift (mopup (Suc (Suc 0))) (length (tm_of abc_F) div 2))))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4649
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4650
definition F_aprog :: "abc_prog"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4651
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4652
  "F_aprog \<equiv> (let (aprog, rs_pos, a_md) = rec_ci rec_F in 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4653
                       aprog [+] dummy_abc (Suc (Suc 0)))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4654
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4655
definition F_tprog :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4656
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4657
  "F_tprog = tm_of (F_aprog)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4658
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4659
definition t_utm :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4660
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4661
  "t_utm \<equiv>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4662
     F_tprog @ shift (mopup (Suc (Suc 0))) (length F_tprog div 2)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4663
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4664
definition UTM_pre :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4665
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4666
  "UTM_pre = t_wcode |+| t_utm"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4667
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4668
(*
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4669
lemma F_abc_halt_eq:
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  4670
  "\<lbrakk>Turing.t_correct tp; 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4671
    length lm = k;
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4672
    steps (Suc 0, Bk\<up>(l), <lm>) tp stp = (0, Bk\<up>(m), Oc\<up>(rs)@Bk\<up>(n));
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4673
    rs > 0\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4674
    \<Longrightarrow> \<exists> stp m. abc_steps_l (0, [code tp, bl2wc (<lm>)]) (F_aprog) stp =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4675
                       (length (F_aprog), code tp # bl2wc (<lm>) # (rs - 1) # 0\<up>(m))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4676
apply(drule_tac  F_t_halt_eq, simp, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4677
apply(case_tac "rec_ci rec_F")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4678
apply(frule_tac abc_append_dummy_complie, simp, simp, erule_tac exE,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4679
      erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4680
apply(rule_tac x = stp in exI, rule_tac x = m in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4681
apply(simp add: F_aprog_def dummy_abc_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4682
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4683
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4684
lemma F_abc_utm_halt_eq: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4685
  "\<lbrakk>rs > 0; 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4686
  abc_steps_l (0, [code tp, bl2wc (<lm>)]) F_aprog stp =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4687
        (length F_aprog, code tp #  bl2wc (<lm>) # (rs - 1) # 0\<up>(m))\<rbrakk>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4688
  \<Longrightarrow> \<exists>stp m n.(steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4689
                                             (0, Bk\<up>(m), Oc\<up>(rs) @ Bk\<up>(n)))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4690
  thm abacus_turing_eq_halt
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4691
  using abacus_turing_eq_halt
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4692
  [of "layout_of F_aprog" "F_aprog" "F_tprog" "length (F_aprog)" 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4693
    "[code tp, bl2wc (<lm>)]" stp "code tp # bl2wc (<lm>) # (rs - 1) # 0\<up>(m)" "Suc (Suc 0)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4694
    "start_of (layout_of (F_aprog)) (length (F_aprog))" "[]" 0]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4695
apply(simp add: F_tprog_def t_utm_def abc_lm_v.simps nth_append)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4696
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4697
apply(rule_tac x = stpa in exI, rule_tac x = "Suc (Suc ma)" in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4698
       rule_tac x = l in exI, simp add: exp_ind)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4699
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4700
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4701
declare tape_of_nl_abv_cons[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4702
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4703
lemma t_utm_halt_eq': 
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  4704
  "\<lbrakk>Turing.t_correct tp;
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4705
   0 < rs;
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4706
  steps (Suc 0, Bk\<up>(l), <lm::nat list>) tp stp = (0, Bk\<up>(m), Oc\<up>(rs)@Bk\<up>(n))\<rbrakk>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4707
  \<Longrightarrow>  \<exists>stp m n. steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4708
                                                (0, Bk\<up>(m), Oc\<up>(rs) @ Bk\<up>(n))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4709
apply(drule_tac  l = l in F_abc_halt_eq, simp, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4710
apply(erule_tac exE, erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4711
apply(rule_tac F_abc_utm_halt_eq, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4712
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4713
*)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4714
(*
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4715
lemma [simp]: "tinres xs (xs @ Bk\<up>(i))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4716
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4717
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4718
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4719
lemma [elim]: "\<lbrakk>rs > 0; Oc\<up>(rs) @ Bk\<up>(na) = c @ Bk\<up>(n)\<rbrakk>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4720
        \<Longrightarrow> \<exists>n. c = Oc\<up>(rs) @ Bk\<up>(n)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4721
apply(case_tac "na > n")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4722
apply(subgoal_tac "\<exists> d. na = d + n", auto simp: exp_add)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4723
apply(rule_tac x = "na - n" in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4724
apply(subgoal_tac "\<exists> d. n = d + na", auto simp: exp_add)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4725
apply(case_tac rs, simp_all add: exp_ind, case_tac d, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4726
           simp_all add: exp_ind)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4727
apply(rule_tac x = "n - na" in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4728
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4729
*)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4730
(*
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4731
lemma t_utm_halt_eq'': 
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  4732
  "\<lbrakk>Turing.t_correct tp;
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4733
   0 < rs;
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4734
   steps (Suc 0, Bk\<up>(l), <lm::nat list>) tp stp = (0, Bk\<up>(m), Oc\<up>(rs)@Bk\<up>(n))\<rbrakk>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4735
  \<Longrightarrow>  \<exists>stp m n. steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>(i)) t_utm stp = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4736
                                                (0, Bk\<up>(m), Oc\<up>(rs) @ Bk\<up>(n))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4737
apply(drule_tac t_utm_halt_eq', simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4738
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4739
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4740
  fix stpa ma na
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4741
  assume "steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stpa = (0, Bk\<up>(ma), Oc\<up>(rs) @ Bk\<up>(na))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4742
  and gr: "rs > 0"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4743
  thus "\<exists>stp m n. steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>(i)) t_utm stp = (0, Bk\<up>(m), Oc\<up>(rs) @ Bk\<up>(n))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4744
    apply(rule_tac x = stpa in exI, rule_tac x = ma in exI,  simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4745
  proof(case_tac "steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>(i)) t_utm stpa", simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4746
    fix a b c
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4747
    assume "steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stpa = (0, Bk\<up>(ma), Oc\<up>(rs) @ Bk\<up>(na))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4748
            "steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>(i)) t_utm stpa = (a, b, c)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4749
    thus " a = 0 \<and> b = Bk\<up>(ma) \<and> (\<exists>n. c = Oc\<up>(rs) @ Bk\<up>(n))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4750
      using tinres_steps2[of "<[code tp, bl2wc (<lm>)]>" "<[code tp, bl2wc (<lm>)]> @ Bk\<up>(i)" 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4751
                           "Suc 0" " [Bk, Bk]" t_utm stpa 0 "Bk\<up>(ma)" "Oc\<up>(rs) @ Bk\<up>(na)" a b c]
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4752
      apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4753
      using gr
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4754
      apply(simp only: tinres_def, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4755
      apply(rule_tac x = "na + n" in exI, simp add: exp_add)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4756
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4757
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4758
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4759
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4760
lemma [simp]: "tinres [Bk, Bk] [Bk]"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4761
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4762
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4763
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4764
lemma [elim]: "Bk\<up>(ma) = b @ Bk\<up>(n)  \<Longrightarrow> \<exists>m. b = Bk\<up>(m)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4765
apply(subgoal_tac "ma = length b + n")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4766
apply(rule_tac x = "ma - n" in exI, simp add: exp_add)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4767
apply(drule_tac length_equal)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4768
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4769
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4770
*)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4771
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4772
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4773
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4774
lemma tinres_step1: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4775
  "\<lbrakk>tinres l l'; step (ss, l, r) (t, 0) = (sa, la, ra); 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4776
                 step (ss, l', r) (t, 0) = (sb, lb, rb)\<rbrakk>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4777
    \<Longrightarrow> tinres la lb \<and> ra = rb \<and> sa = sb"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4778
apply(case_tac ss, case_tac [!]r, case_tac [!] "a::cell")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4779
apply(auto simp: step.simps fetch.simps nth_of.simps
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4780
        split: if_splits )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4781
apply(case_tac [!] "t ! (2 * nat)", 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4782
     auto simp: tinres_def split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4783
apply(case_tac [1-8] a, auto split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4784
apply(case_tac [!] "t ! (2 * nat)", 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4785
     auto simp: tinres_def split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4786
apply(case_tac [1-4] a, auto split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4787
apply(case_tac [!] "t ! Suc (2 * nat)", 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4788
     auto simp: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4789
apply(case_tac [!] aa, auto split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4790
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4791
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4792
lemma tinres_steps1: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4793
  "\<lbrakk>tinres l l'; steps (ss, l, r) (t, 0) stp = (sa, la, ra); 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4794
                 steps (ss, l', r) (t, 0) stp = (sb, lb, rb)\<rbrakk>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4795
    \<Longrightarrow> tinres la lb \<and> ra = rb \<and> sa = sb"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4796
apply(induct stp arbitrary: sa la ra sb lb rb, simp add: steps.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4797
apply(simp add: step_red)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4798
apply(case_tac "(steps (ss, l, r) (t, 0) stp)")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4799
apply(case_tac "(steps (ss, l', r) (t, 0) stp)")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4800
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4801
  fix stp sa la ra sb lb rb a b c aa ba ca
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4802
  assume ind: "\<And>sa la ra sb lb rb. \<lbrakk>steps (ss, l, r) (t, 0) stp = (sa, (la::cell list), ra); 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4803
          steps (ss, l', r) (t, 0) stp = (sb, lb, rb)\<rbrakk> \<Longrightarrow> tinres la lb \<and> ra = rb \<and> sa = sb"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4804
  and h: " tinres l l'" "step (steps (ss, l, r) (t, 0) stp) (t, 0) = (sa, la, ra)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4805
         "step (steps (ss, l', r) (t, 0) stp) (t, 0) = (sb, lb, rb)" "steps (ss, l, r) (t, 0) stp = (a, b, c)" 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4806
         "steps (ss, l', r) (t, 0) stp = (aa, ba, ca)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4807
  have "tinres b ba \<and> c = ca \<and> a = aa"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4808
    apply(rule_tac ind, simp_all add: h)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4809
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4810
  thus "tinres la lb \<and> ra = rb \<and> sa = sb"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4811
    apply(rule_tac l = b and l' = ba and r = c  and ss = a   
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4812
            and t = t in tinres_step1)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4813
    using h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4814
    apply(simp, simp, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4815
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4816
qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4817
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4818
lemma [simp]: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4819
  "tinres (Bk \<up> m @ [Bk, Bk]) la \<Longrightarrow> \<exists>m. la = Bk \<up> m"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4820
apply(auto simp: tinres_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4821
apply(case_tac n, simp add: exp_ind)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4822
apply(rule_tac  x ="Suc (Suc m)" in exI, simp only: exp_ind, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4823
apply(simp add: exp_ind del: replicate_Suc)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4824
apply(case_tac nat, simp add: exp_ind)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4825
apply(rule_tac x = "Suc m" in exI, simp only: exp_ind)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4826
apply(simp only: exp_ind, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4827
apply(subgoal_tac "m = length la + nata")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4828
apply(rule_tac x = "m - nata" in exI, simp add: exp_add)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4829
apply(drule_tac length_equal, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4830
apply(simp only: exp_ind[THEN sym] replicate_Suc[THEN sym] replicate_add[THEN sym])
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4831
apply(rule_tac x = "m + Suc (Suc n)" in exI, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4832
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4833
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4834
lemma t_utm_halt_eq: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4835
  assumes tm_wf: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4836
  and exec: "steps0 (Suc 0, Bk\<up>(l), <lm::nat list>) tp stp = (0, Bk\<up>(m), Oc\<up>(rs)@Bk\<up>(n))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4837
  and resutl: "0 < rs"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4838
  shows "\<exists>stp m n. steps0 (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>(i)) t_utm stp = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4839
                                                (0, Bk\<up>(m), Oc\<up>(rs) @ Bk\<up>(n))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4840
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4841
  obtain ap arity fp where a: "rec_ci rec_F = (ap, arity, fp)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4842
    by (metis prod_cases3) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4843
  moreover have b: "rec_calc_rel  rec_F [code tp, (bl2wc (<lm>))] (rs - Suc 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4844
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4845
    apply(rule_tac F_correct, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4846
    done 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4847
  have "\<exists> stp m l. steps0 (Suc 0, Bk # Bk # [], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4848
    (F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4849
    = (0, Bk\<up>m @ Bk # Bk # [], Oc\<up>Suc (rs - 1) @ Bk\<up>l)"  
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4850
  proof(rule_tac recursive_compile_to_tm_correct)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4851
    show "rec_ci rec_F = (ap, arity, fp)" using a by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4852
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4853
    show "rec_calc_rel rec_F [code tp, bl2wc (<lm>)] (rs - 1)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4854
      using b by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4855
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4856
    show "length [code tp, bl2wc (<lm>)] = 2" by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4857
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4858
    show "layout_of (ap [+] dummy_abc 2) = layout_of (ap [+] dummy_abc 2)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4859
      by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4860
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4861
    show "F_tprog = tm_of (ap [+] dummy_abc 2)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4862
      using a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4863
      apply(simp add: F_tprog_def F_aprog_def numeral_2_eq_2)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4864
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4865
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4866
  then obtain stp m l where 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4867
    "steps0 (Suc 0, Bk # Bk # [], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4868
    (F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4869
    = (0, Bk\<up>m @ Bk # Bk # [], Oc\<up>Suc (rs - 1) @ Bk\<up>l)" by blast
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4870
  hence "\<exists> m. steps0 (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4871
    (F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4872
    = (0, Bk\<up>m, Oc\<up>Suc (rs - 1) @ Bk\<up>l)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4873
  proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4874
    assume g: "steps0 (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk \<up> i)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4875
      (F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4876
      (0, Bk \<up> m @ [Bk, Bk], Oc \<up> Suc (rs - 1) @ Bk \<up> l)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4877
   moreover have "tinres [Bk, Bk] [Bk]"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4878
     apply(auto simp: tinres_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4879
     done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4880
    moreover obtain sa la ra where "steps0 (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4881
    (F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp = (sa, la, ra)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4882
      apply(case_tac "steps0 (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4883
    (F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp", auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4884
      done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4885
    ultimately show "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4886
      apply(drule_tac tinres_steps1, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4887
      done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4888
  qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4889
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4890
    apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4891
    apply(rule_tac x = stp in exI, simp add: t_utm_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4892
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4893
    apply(case_tac rs, simp_all add: numeral_2_eq_2)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4894
    done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4895
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4896
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4897
lemma [intro]: "tm_wf (t_wcode, 0)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4898
apply(simp add: t_wcode_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4899
apply(rule_tac tm_wf_comp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4900
apply(rule_tac tm_wf_comp, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4901
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4902
      
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4903
lemma [intro]: "tm_wf (t_utm, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4904
apply(simp only: t_utm_def F_tprog_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4905
apply(rule_tac t_compiled_correct, auto)
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4906
done 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4907
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4908
lemma UTM_halt_lemma_pre: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4909
  assumes wf_tm: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4910
  and result: "0 < rs"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4911
  and args: "args \<noteq> []"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4912
  and exec: "steps0 (Suc 0, Bk\<up>(i), <args::nat list>) tp stp = (0, Bk\<up>(m), Oc\<up>(rs)@Bk\<up>(k))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4913
  shows "\<exists>stp m n. steps0 (Suc 0, [], <code tp # args>) UTM_pre stp = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4914
                                                (0, Bk\<up>(m), Oc\<up>(rs) @ Bk\<up>(n))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4915
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4916
  let ?Q2 = "\<lambda> (l, r). (\<exists> ln rn. l = Bk\<up>(ln) \<and> r = Oc\<up>(rs) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4917
  let ?P1 = "\<lambda> (l, r). l = [] \<and> r = <code tp # args>"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4918
  let ?Q1 = "\<lambda> (l, r). (l = [Bk] \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4919
    (\<exists> rn. r = Oc\<up>(Suc (code tp)) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn)))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4920
  let ?P2 = ?Q1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4921
  let ?P3 = "\<lambda> (l, r). False"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4922
  have "{?P1} (t_wcode |+| t_utm) {?Q2}"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4923
  proof(rule_tac Hoare_plus_halt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4924
    show "tm_wf (t_wcode, 0)" by auto
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4925
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4926
    show "{?P1} t_wcode {?Q1}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4927
      apply(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4928
      using wcode_lemma_1[of args "code tp"] args
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4929
      apply(auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4930
      apply(rule_tac x = stp in exI, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4931
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4932
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4933
    show "{?P2} t_utm {?Q2}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4934
    proof(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4935
      fix rn
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4936
      show "\<exists>n. is_final (steps0 (Suc 0, [Bk], Oc # Oc \<up> code tp @ Bk # Oc # Oc \<up> bl_bin (<args>) @ Bk \<up> rn) t_utm n) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4937
        (\<lambda>(l, r). (\<exists>ln. l = Bk \<up> ln) \<and>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4938
        (\<exists>rn. r = Oc \<up> rs @ Bk \<up> rn)) holds_for steps0 (Suc 0, [Bk],
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4939
        Oc # Oc \<up> code tp @ Bk # Oc # Oc \<up> bl_bin (<args>) @ Bk \<up> rn) t_utm n"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4940
        using t_utm_halt_eq[of tp i "args" stp m rs k rn] assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4941
      apply(auto simp: bin_wc_eq)
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4942
      apply(rule_tac x = stpa in exI, simp add: tape_of_nl_abv tape_of_nat_abv)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4943
      done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4944
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4945
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4946
  thus "?thesis"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4947
    apply(auto simp: Hoare_halt_def UTM_pre_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4948
    apply(case_tac "steps0 (Suc 0, [], <code tp # args>) (t_wcode |+| t_utm) n")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4949
    apply(rule_tac x = n in exI, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4950
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4951
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4952
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4953
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4954
  The correctness of @{text "UTM"}, the halt case.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4955
*}
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4956
lemma UTM_halt_lemma': 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4957
  assumes tm_wf: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4958
  and result: "0 < rs"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4959
  and args: "args \<noteq> []"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4960
  and exec: "steps0 (Suc 0, Bk\<up>(i), <args::nat list>) tp stp = (0, Bk\<up>(m), Oc\<up>(rs)@Bk\<up>(k))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4961
  shows "\<exists>stp m n. steps0 (Suc 0, [], <code tp # args>) UTM stp = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4962
                                                (0, Bk\<up>(m), Oc\<up>(rs) @ Bk\<up>(n))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4963
using UTM_halt_lemma_pre[of tp rs args i stp m k] assms
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4964
apply(simp add: UTM_pre_def t_utm_def UTM_def F_aprog_def F_tprog_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4965
apply(case_tac "rec_ci rec_F", simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4966
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4967
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4968
definition TSTD:: "config \<Rightarrow> bool"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4969
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4970
  "TSTD c = (let (st, l, r) = c in 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4971
             st = 0 \<and> (\<exists> m. l = Bk\<up>(m)) \<and> (\<exists> rs n. r = Oc\<up>(Suc rs) @ Bk\<up>(n)))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4972
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4973
lemma nstd_case1: "0 < a \<Longrightarrow> NSTD (trpl_code (a, b, c))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4974
apply(simp add: NSTD.simps trpl_code.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4975
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4976
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4977
lemma [simp]: "\<forall>m. b \<noteq> Bk\<up>(m) \<Longrightarrow> 0 < bl2wc b"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4978
apply(rule classical, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4979
apply(induct b, erule_tac x = 0 in allE, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4980
apply(simp add: bl2wc.simps, case_tac a, simp_all 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4981
  add: bl2nat.simps bl2nat_double)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4982
apply(case_tac "\<exists> m. b = Bk\<up>(m)",  erule exE)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4983
apply(erule_tac x = "Suc m" in allE, simp add: , simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4984
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4985
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4986
lemma nstd_case2: "\<forall>m. b \<noteq> Bk\<up>(m) \<Longrightarrow> NSTD (trpl_code (a, b, c))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4987
apply(simp add: NSTD.simps trpl_code.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4988
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4989
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4990
lemma [elim]: "Suc (2 * x) = 2 * y \<Longrightarrow> RR"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4991
apply(induct x arbitrary: y, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4992
apply(case_tac y, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4993
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4994
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4995
declare replicate_Suc[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4996
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4997
lemma bl2nat_zero_eq[simp]: "(bl2nat c 0 = 0) = (\<exists>n. c = Bk\<up>(n))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4998
apply(auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4999
apply(induct c, simp_all add: bl2nat.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5000
apply(case_tac a, auto simp: bl2nat.simps bl2nat_double)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5001
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5002
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5003
lemma bl2wc_exp_ex: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5004
  "\<lbrakk>Suc (bl2wc c) = 2 ^  m\<rbrakk> \<Longrightarrow> \<exists> rs n. c = Oc\<up>(rs) @ Bk\<up>(n)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5005
apply(induct c arbitrary: m, simp add: bl2wc.simps bl2nat.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5006
apply(case_tac a, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5007
apply(case_tac m, simp_all add: bl2wc.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5008
apply(rule_tac x = 0 in exI, rule_tac x = "Suc n" in exI, 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5009
  simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5010
apply(simp add: bl2wc.simps bl2nat.simps bl2nat_double)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5011
apply(case_tac m, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5012
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5013
  fix c m nat
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5014
  assume ind: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5015
    "\<And>m. Suc (bl2nat c 0) = 2 ^ m \<Longrightarrow> \<exists>rs n. c = Oc\<up>(rs) @ Bk\<up>(n)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5016
  and h: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5017
    "Suc (Suc (2 * bl2nat c 0)) = 2 * 2 ^ nat"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5018
  have "\<exists>rs n. c = Oc\<up>(rs) @ Bk\<up>(n)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5019
    apply(rule_tac m = nat in ind)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5020
    using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5021
    apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5022
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5023
  from this obtain rs n where " c = Oc\<up>(rs) @ Bk\<up>(n)" by blast 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5024
  thus "\<exists>rs n. Oc # c = Oc\<up>(rs) @ Bk\<up>(n)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5025
    apply(rule_tac x = "Suc rs" in exI, simp add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5026
    apply(rule_tac x = n in exI, simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5027
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5028
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5029
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5030
lemma lg_bin: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5031
  "\<lbrakk>\<forall>rs n. c \<noteq> Oc\<up>(Suc rs) @ Bk\<up>(n); 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5032
  bl2wc c = 2 ^ lg (Suc (bl2wc c)) 2 - Suc 0\<rbrakk> \<Longrightarrow> bl2wc c = 0"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5033
apply(subgoal_tac "\<exists> m. Suc (bl2wc c) = 2^m", erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5034
apply(drule_tac bl2wc_exp_ex, simp, erule_tac exE, erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5035
apply(case_tac rs, simp, simp, erule_tac x = nat in allE,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5036
  erule_tac x = n in allE, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5037
using bl2wc_exp_ex[of c "lg (Suc (bl2wc c)) 2"]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5038
apply(case_tac "(2::nat) ^ lg (Suc (bl2wc c)) 2", 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5039
  simp, simp, erule_tac exE, erule_tac exE, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5040
apply(simp add: bl2wc.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5041
apply(rule_tac x = rs in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5042
apply(case_tac "(2::nat)^rs", simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5043
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5044
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5045
lemma nstd_case3: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5046
  "\<forall>rs n. c \<noteq> Oc\<up>(Suc rs) @ Bk\<up>(n) \<Longrightarrow>  NSTD (trpl_code (a, b, c))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5047
apply(simp add: NSTD.simps trpl_code.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5048
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5049
apply(drule_tac lg_bin, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5050
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5051
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5052
lemma NSTD_1: "\<not> TSTD (a, b, c)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5053
    \<Longrightarrow> rec_exec rec_NSTD [trpl_code (a, b, c)] = Suc 0"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5054
  using NSTD_lemma1[of "trpl_code (a, b, c)"]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5055
       NSTD_lemma2[of "trpl_code (a, b, c)"]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5056
  apply(simp add: TSTD_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5057
  apply(erule_tac disjE, erule_tac nstd_case1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5058
  apply(erule_tac disjE, erule_tac nstd_case2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5059
  apply(erule_tac nstd_case3)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5060
  done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5061
 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5062
lemma nonstop_t_uhalt_eq:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5063
  "\<lbrakk>tm_wf (tp, 0);
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5064
  steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp = (a, b, c);
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5065
  \<not> TSTD (a, b, c)\<rbrakk>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5066
  \<Longrightarrow> rec_exec rec_nonstop [code tp, bl2wc (<lm>), stp] = Suc 0"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5067
apply(simp add: rec_nonstop_def rec_exec.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5068
apply(subgoal_tac 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5069
  "rec_exec rec_conf [code tp, bl2wc (<lm>), stp] =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5070
  trpl_code (a, b, c)", simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5071
apply(erule_tac NSTD_1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5072
using rec_t_eq_steps[of tp l lm stp]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5073
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5074
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5075
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5076
lemma nonstop_true:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5077
  "\<lbrakk>tm_wf (tp, 0);
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5078
  \<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp))\<rbrakk>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5079
  \<Longrightarrow> \<forall>y. rec_calc_rel rec_nonstop 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5080
  ([code tp, bl2wc (<lm>), y]) (Suc 0)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5081
apply(rule_tac allI, erule_tac x = y in allE)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5082
apply(case_tac "steps0 (Suc 0, Bk\<up>(l), <lm>) tp y", simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5083
apply(rule_tac nonstop_t_uhalt_eq, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5084
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5085
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5086
(*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5087
lemma [simp]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5088
  "\<forall>j<Suc k. Ex (rec_calc_rel (get_fstn_args (Suc k) (Suc k) ! j)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5089
                                                     (code tp # lm))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5090
apply(auto simp: get_fstn_args_nth)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5091
apply(rule_tac x = "(code tp # lm) ! j" in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5092
apply(rule_tac calc_id, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5093
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5094
*)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5095
declare ci_cn_para_eq[simp]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5096
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5097
lemma F_aprog_uhalt: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5098
  "\<lbrakk>tm_wf (tp,0); 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5099
    \<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp)); 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5100
    rec_ci rec_F = (F_ap, rs_pos, a_md)\<rbrakk>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5101
  \<Longrightarrow> \<forall> stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)] @ 0\<up>(a_md - rs_pos )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5102
               @ suflm) (F_ap) stp of (ss, e) \<Rightarrow> ss < length (F_ap)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5103
apply(case_tac "rec_ci (Cn (Suc (Suc 0)) rec_right [Cn (Suc (Suc 0)) rec_conf 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5104
               ([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])])")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5105
apply(simp only: rec_F_def, rule_tac i = 0  and ga = a and gb = b and 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5106
  gc = c in cn_gi_uhalt, simp, simp, simp, simp, simp, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5107
apply(simp add: ci_cn_para_eq)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5108
apply(case_tac "rec_ci (Cn (Suc (Suc 0)) rec_conf 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5109
  ([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt]))")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5110
apply(rule_tac rf = "(Cn (Suc (Suc 0)) rec_right [Cn (Suc (Suc 0)) rec_conf
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5111
              ([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])])" 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5112
           and n = "Suc (Suc 0)" and f = rec_right and 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5113
          gs = "[Cn (Suc (Suc 0)) rec_conf 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5114
           ([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])]"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5115
           and i = 0 and ga = aa and gb = ba and gc = ca in 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5116
          cn_gi_uhalt)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5117
apply(simp, simp, simp, simp, simp, simp, simp, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5118
     simp add: ci_cn_para_eq)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5119
apply(case_tac "rec_ci rec_halt")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5120
apply(rule_tac rf = "(Cn (Suc (Suc 0)) rec_conf 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5121
  ([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt]))" 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5122
  and n = "Suc (Suc 0)" and f = "rec_conf" and 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5123
  gs = "([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])"  and 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5124
  i = "Suc (Suc 0)" and gi = "rec_halt" and ga = ab and gb = bb and
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5125
  gc = cb in cn_gi_uhalt)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5126
apply(simp, simp, simp, simp, simp add: nth_append, simp, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5127
  simp add: nth_append, simp add: rec_halt_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5128
apply(simp only: rec_halt_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5129
apply(case_tac [!] "rec_ci ((rec_nonstop))")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5130
apply(rule_tac allI, rule_tac impI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5131
apply(case_tac j, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5132
apply(rule_tac x = "code tp" in exI, rule_tac calc_id, simp, simp, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5133
apply(rule_tac x = "bl2wc (<lm>)" in exI, rule_tac calc_id, simp, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5134
apply(rule_tac rf = "Mn (Suc (Suc 0)) (rec_nonstop)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5135
  and f = "(rec_nonstop)" and n = "Suc (Suc 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5136
  and  aprog' = ac and rs_pos' =  bc and a_md' = cc in Mn_unhalt)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5137
apply(simp, simp add: rec_halt_def , simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5138
apply(drule_tac  nonstop_true, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5139
apply(rule_tac allI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5140
apply(erule_tac x = y in allE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5141
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5142
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5143
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5144
lemma uabc_uhalt': 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5145
  "\<lbrakk>tm_wf (tp, 0);
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5146
  \<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp));
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5147
  rec_ci rec_F = (ap, pos, md)\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5148
  \<Longrightarrow> \<forall> stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)]) ap stp of (ss, e)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5149
           \<Rightarrow>  ss < length ap"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5150
proof(frule_tac F_ap = ap and rs_pos = pos and a_md = md
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5151
    and suflm = "[]" in F_aprog_uhalt, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5152
  fix stp a b
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5153
  assume h: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5154
    "\<forall>stp. case abc_steps_l (0, code tp # bl2wc (<lm>) # 0\<up>(md - pos)) ap stp of 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5155
    (ss, e) \<Rightarrow> ss < length ap"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5156
    "abc_steps_l (0, [code tp, bl2wc (<lm>)]) ap stp = (a, b)" 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5157
    "tm_wf (tp, 0)" 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5158
    "rec_ci rec_F = (ap, pos, md)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5159
  moreover have "ap \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5160
    using h apply(rule_tac rec_ci_not_null, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5161
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5162
  ultimately show "a < length ap"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5163
  proof(erule_tac x = stp in allE,
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5164
  case_tac "abc_steps_l (0, code tp # bl2wc (<lm>) # 0\<up>(md - pos)) ap stp", simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5165
    fix aa ba
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5166
    assume g: "aa < length ap" 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5167
      "abc_steps_l (0, code tp # bl2wc (<lm>) # 0\<up>(md - pos)) ap stp = (aa, ba)" 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5168
      "ap \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5169
    thus "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5170
      using abc_list_crsp_steps[of "[code tp, bl2wc (<lm>)]"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5171
                                   "md - pos" ap stp aa ba] h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5172
      apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5173
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5174
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5175
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5176
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5177
lemma uabc_uhalt: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5178
  "\<lbrakk>tm_wf (tp, 0); 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5179
  \<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp))\<rbrakk>
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5180
  \<Longrightarrow> \<forall> stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)]) F_aprog 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5181
       stp of (ss, e) \<Rightarrow> ss < length F_aprog"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5182
apply(case_tac "rec_ci rec_F", simp add: F_aprog_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5183
thm uabc_uhalt'
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5184
apply(drule_tac ap = a and pos = b and md = c in uabc_uhalt', simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5185
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5186
  fix a b c
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5187
  assume 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5188
    "\<forall>stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)]) a stp of (ss, e) 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5189
                                                   \<Rightarrow> ss < length a"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5190
    "rec_ci rec_F = (a, b, c)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5191
  thus 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5192
    "\<forall>stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)]) 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5193
    (a [+] dummy_abc (Suc (Suc 0))) stp of (ss, e) \<Rightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5194
           ss < Suc (Suc (Suc (length a)))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5195
    using abc_append_uhalt1[of a "[code tp, bl2wc (<lm>)]" 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5196
      "a [+] dummy_abc (Suc (Suc 0))" "[]" "dummy_abc (Suc (Suc 0))"]  
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5197
    apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5198
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5199
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5200
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5201
lemma tutm_uhalt': 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5202
assumes tm_wf:  "tm_wf (tp,0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5203
  and unhalt: "\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5204
  shows "\<forall> stp. \<not> is_final (steps0 (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5205
apply(simp add: t_utm_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5206
proof(rule_tac compile_correct_unhalt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5207
  show "layout_of F_aprog = layout_of F_aprog" by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5208
next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5209
  show "F_tprog = tm_of F_aprog"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5210
    by(simp add:  F_tprog_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5211
next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5212
  show "crsp (layout_of F_aprog) (0, [code tp, bl2wc (<lm>)]) (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>)  []"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5213
    by(auto simp: crsp.simps start_of.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5214
next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5215
  show "length F_tprog div 2 = length F_tprog div 2" by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5216
next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5217
  show "\<forall>stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)]) F_aprog stp of (as, am) \<Rightarrow> as < length F_aprog"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5218
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5219
    apply(erule_tac uabc_uhalt, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5220
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5221
qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5222
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5223
 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5224
lemma tinres_commute: "tinres r r' \<Longrightarrow> tinres r' r"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5225
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5226
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5227
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5228
lemma inres_tape:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5229
  "\<lbrakk>steps0 (st, l, r) tp stp = (a, b, c); steps0 (st, l', r') tp stp = (a', b', c'); 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5230
  tinres l l'; tinres r r'\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5231
  \<Longrightarrow> a = a' \<and> tinres b b' \<and> tinres c c'"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5232
proof(case_tac "steps0 (st, l', r) tp stp")
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5233
  fix aa ba ca
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5234
  assume h: "steps0 (st, l, r) tp stp = (a, b, c)" 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5235
            "steps0 (st, l', r') tp stp = (a', b', c')"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5236
            "tinres l l'" "tinres r r'"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5237
            "steps0 (st, l', r) tp stp = (aa, ba, ca)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5238
  have "tinres b ba \<and> c = ca \<and> a = aa"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5239
    using h
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5240
    apply(rule_tac tinres_steps1, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5241
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5242
  moreover have "b' = ba \<and> tinres c' ca \<and> a' =  aa"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5243
    using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5244
    apply(rule_tac tinres_steps2, auto intro: tinres_commute)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5245
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5246
  ultimately show "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5247
    apply(auto intro: tinres_commute)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5248
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5249
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5250
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5251
lemma tape_normalize: "\<forall> stp. \<not> is_final(steps0 (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5252
      \<Longrightarrow> \<forall> stp. \<not> is_final (steps0 (Suc 0, Bk\<up>(m), <[code tp, bl2wc (<lm>)]> @ Bk\<up>(n)) t_utm stp)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5253
apply(rule_tac allI, case_tac "(steps0 (Suc 0, Bk\<up>(m), 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5254
               <[code tp, bl2wc (<lm>)]> @ Bk\<up>(n)) t_utm stp)", simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5255
apply(erule_tac x = stp in allE)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5256
apply(case_tac "steps0 (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp", simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5257
apply(drule_tac inres_tape, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5258
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5259
apply(case_tac "m > Suc (Suc 0)")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5260
apply(rule_tac x = "m - Suc (Suc 0)" in exI) 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5261
apply(case_tac m, simp_all add: , case_tac nat, simp_all add: replicate_Suc)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5262
apply(rule_tac x = "2 - m" in exI, simp add: exp_add[THEN sym])
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5263
apply(simp only: numeral_2_eq_2, simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5264
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5265
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5266
lemma tutm_uhalt: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5267
  "\<lbrakk>tm_wf (tp,0);
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5268
    \<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <args>) tp stp))\<rbrakk>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5269
  \<Longrightarrow> \<forall> stp. \<not> is_final (steps0 (Suc 0, Bk\<up>(m), <[code tp, bl2wc (<args>)]> @ Bk\<up>(n)) t_utm stp)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5270
apply(rule_tac tape_normalize)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5271
apply(rule_tac tutm_uhalt', simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5272
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5273
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5274
lemma UTM_uhalt_lemma_pre:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5275
  assumes tm_wf: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5276
  and exec: "\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <args>) tp stp))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5277
  and args: "args \<noteq> []"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5278
  shows "\<forall> stp. \<not> is_final (steps0 (Suc 0, [], <code tp # args>)  UTM_pre stp)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5279
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5280
  let ?P1 = "\<lambda> (l, r). l = [] \<and> r = <code tp # args>"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5281
  let ?Q1 = "\<lambda> (l, r). (l = [Bk] \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5282
             (\<exists> rn. r = Oc\<up>(Suc (code tp)) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn)))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5283
  let ?P2 = ?Q1
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5284
  have "{?P1} (t_wcode |+| t_utm) \<up>"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5285
  proof(rule_tac Hoare_plus_unhalt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5286
    show "tm_wf (t_wcode, 0)" by auto
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5287
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5288
    show "{?P1} t_wcode {?Q1}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  5289
      apply(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5290
      using wcode_lemma_1[of args "code tp"] args
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5291
      apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5292
      apply(rule_tac x = stp in exI, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5293
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5294
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5295
    show "{?P2} t_utm \<up>"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  5296
    proof(rule_tac Hoare_unhaltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5297
      fix n rn
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5298
      assume h: "is_final (steps0 (Suc 0, [Bk], Oc \<up> Suc (code tp) @ Bk # Oc \<up> Suc (bl_bin (<args>)) @ Bk \<up> rn) t_utm n)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5299
      have "\<forall> stp. \<not> is_final (steps0 (Suc 0, Bk\<up>(Suc 0), <[code tp, bl2wc (<args>)]> @ Bk\<up>(rn)) t_utm stp)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5300
        using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5301
        apply(rule_tac tutm_uhalt, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5302
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5303
      thus "False"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5304
        using h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5305
        apply(erule_tac x = n in allE)
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  5306
        apply(simp add: tape_of_nl_abv bin_wc_eq tape_of_nat_abv)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5307
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5308
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5309
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5310
  thus "?thesis"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5311
    apply(simp add: Hoare_unhalt_def UTM_pre_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5312
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5313
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5314
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5315
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5316
  The correctness of @{text "UTM"}, the unhalt case.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5317
  *}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5318
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5319
lemma UTM_uhalt_lemma':
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5320
  assumes tm_wf: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5321
  and unhalt: "\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <args>) tp stp))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5322
  and args: "args \<noteq> []"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5323
  shows " \<forall> stp. \<not> is_final (steps0 (Suc 0, [], <code tp # args>)  UTM stp)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5324
  using UTM_uhalt_lemma_pre[of tp l args] assms
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5325
apply(simp add: UTM_pre_def t_utm_def UTM_def F_aprog_def F_tprog_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5326
apply(case_tac "rec_ci rec_F", simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5327
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5328
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5329
lemma UTM_halt_lemma:
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5330
  assumes tm_wf: "tm_wf (p, 0)"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5331
  and resut: "rs > 0"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5332
  and args: "(args::nat list) \<noteq> []"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5333
  and exec: "{(\<lambda>tp. tp = (Bk\<up>i, <args>))} p {(\<lambda>tp. tp = (Bk\<up>m, Oc\<up>rs @ Bk\<up>k))}" 
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5334
  shows "{(\<lambda>tp. tp = ([], <code p # args>))} UTM {(\<lambda>tp. (\<exists> m n. tp = (Bk\<up>m, Oc\<up>rs @ Bk\<up>n)))}"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5335
proof -
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5336
  have "{(\<lambda> (l, r). l = [] \<and> r = <code p # args>)} (t_wcode |+| t_utm)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5337
          {(\<lambda> (l, r). (\<exists> m. l = Bk\<up>m) \<and> (\<exists> n. r = Oc\<up>rs @ Bk\<up>n))}"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5338
  proof(rule_tac Hoare_plus_halt)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5339
    show "{\<lambda>(l, r). l = [] \<and> r = <code p # args>} t_wcode {\<lambda> (l, r). (l = [Bk] \<and>
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5340
    (\<exists> rn. r = Oc\<up>(Suc (code p)) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn)))}"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5341
      apply(rule_tac Hoare_haltI, auto)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5342
      using wcode_lemma_1[of args "code p"] args
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5343
      apply(auto)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5344
      apply(rule_tac x = stp in exI, simp)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5345
      done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5346
  next
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5347
    have "\<exists> stp. steps0 (Suc 0, Bk\<up>i, <args>) p stp = (0, Bk\<up>m, Oc\<up>rs @ Bk\<up>k)"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5348
      using exec
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5349
      apply(simp add: Hoare_halt_def, auto)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5350
      apply(case_tac "steps0 (Suc 0, Bk \<up> i, <args>) p n", simp)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5351
      apply(rule_tac x = n in exI, simp)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5352
      done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5353
    then obtain stp where k: "steps0 (Suc 0, Bk\<up>i, <args>) p stp = (0, Bk\<up>m, Oc\<up>rs @ Bk\<up>k)"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5354
      ..
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5355
    thus "{\<lambda>(l, r). l = [Bk] \<and> (\<exists>rn. r = Oc \<up> Suc (code p) @ Bk # Oc \<up> Suc (bl_bin (<args>)) @ Bk \<up> rn)}
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5356
      t_utm {\<lambda>(l, r). (\<exists>m. l = Bk \<up> m) \<and> (\<exists>n. r = Oc \<up> rs @ Bk \<up> n)}"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5357
    proof(rule_tac Hoare_haltI, auto)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5358
      fix rn
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5359
      show "\<exists>n. is_final (steps0 (Suc 0, [Bk], Oc \<up> Suc (code p) @ Bk # Oc \<up> Suc (bl_bin (<args>)) @ Bk \<up> rn) t_utm n) \<and>
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5360
             (\<lambda>(l, r). (\<exists>m. l = Bk \<up> m) \<and> (\<exists>n. r = Oc \<up> rs @ Bk \<up> n)) holds_for steps0 
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5361
         (Suc 0, [Bk], Oc \<up> Suc (code p) @ Bk # Oc \<up> Suc (bl_bin (<args>)) @ Bk \<up> rn) t_utm n"      
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5362
        using t_utm_halt_eq[of p i "args" stp m rs k rn] assms k
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5363
        apply(auto simp: bin_wc_eq, auto)        
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5364
        apply(rule_tac x = stpa in exI, simp add: tape_of_nl_abv tape_of_nat_abv)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5365
        done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5366
    qed
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5367
  next
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5368
    show "tm_wf0 t_wcode" by auto
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5369
  qed
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5370
  thus "?thesis"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5371
    apply(case_tac "rec_ci rec_F")
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5372
    apply(simp add: UTM_def t_utm_def F_aprog_def F_tprog_def)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5373
    apply(auto simp add: Hoare_halt_def)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5374
    apply(rule_tac x="n" in exI)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5375
    apply(auto)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5376
    apply(case_tac "(steps0 (Suc 0, [], <code p # args>)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5377
           (t_wcode |+| ((tm_of (a [+] dummy_abc (Suc (Suc 0)))) @
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5378
                        shift (mopup (Suc (Suc 0)))
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5379
                         (length (tm_of (a [+] dummy_abc (Suc (Suc 0)))) div
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5380
                          2))) n)")
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5381
    apply(simp)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5382
    done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5383
qed
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5384
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5385
lemma UTM_halt_lemma2:
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5386
  assumes tm_wf: "tm_wf (p, 0)"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5387
  and args: "(args::nat list) \<noteq> []"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5388
  and exec: "{(\<lambda>tp. tp = ([], <args>))} p {(\<lambda>tp. tp = (Bk\<up>m, <(n::nat)> @ Bk\<up>k))}" 
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5389
  shows "{(\<lambda>tp. tp = ([], <code p # args>))} UTM {(\<lambda>tp. (\<exists> m k. tp = (Bk\<up>m, <n> @ Bk\<up>k)))}"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5390
using UTM_halt_lemma[OF assms(1) _ assms(2), where i="0"]
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5391
using assms(3)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5392
apply(simp add: tape_of_nat_abv)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5393
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5394
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5395
    
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5396
lemma UTM_unhalt_lemma: 
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5397
  assumes tm_wf: "tm_wf (p, 0)"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5398
  and unhalt: "{(\<lambda>tp. tp = (Bk\<up>i, <args>))} p \<up>"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5399
  and args: "args \<noteq> []"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5400
  shows "{(\<lambda>tp. tp = ([], <code p # args>))} UTM \<up>"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5401
proof -
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5402
  have "\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(i), <args>) p stp))"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5403
    using unhalt
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5404
    apply(auto simp: Hoare_unhalt_def)    
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5405
    apply(case_tac "steps0 (Suc 0, Bk \<up> i, <args>) p stp", simp)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5406
    apply(erule_tac x = stp in allE, simp add: TSTD_def)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5407
    done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5408
  then have "\<forall> stp. \<not> is_final (steps0 (Suc 0, [], <code p # args>)  UTM stp)"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5409
    using assms
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5410
    apply(rule_tac  UTM_uhalt_lemma', simp_all)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5411
    done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5412
  thus "?thesis"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5413
    apply(simp add: Hoare_unhalt_def)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5414
    done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5415
qed
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5416
    
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5417
lemma UTM_unhalt_lemma2: 
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5418
  assumes tm_wf: "tm_wf (p, 0)"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5419
  and unhalt: "{(\<lambda>tp. tp = ([], <args>))} p \<up>"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5420
  and args: "args \<noteq> []"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5421
  shows "{(\<lambda>tp. tp = ([], <code p # args>))} UTM \<up>"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5422
using UTM_unhalt_lemma[OF assms(1), where i="0"]
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5423
using assms(2-3)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5424
apply(simp add: tape_of_nat_abv)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5425
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5426
end