thys/UTM.thy
author Christian Urban <christian dot urban at kcl dot ac dot uk>
Wed, 13 Feb 2013 20:08:14 +0000
changeset 169 6013ca0e6e22
parent 166 99a180fd4194
child 170 eccd79a974ae
permissions -rwxr-xr-x
tuned
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
169
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     1
(* Title: thys/UTM.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     2
   Author: Jian Xu, Xingyuan Zhang, and Christian Urban
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     3
*)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     4
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     5
header {* Construction of a Universal Turing Machine *}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     6
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     7
theory UTM
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
     8
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
     9
begin
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    10
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    11
section {* Wang coding of input arguments *}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    12
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    13
text {*
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    14
  The direct compilation of the universal function @{text "rec_F"} can
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    15
  not give us UTM, because @{text "rec_F"} is of arity 2, where the
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    16
  first argument represents the Godel coding of the TM being simulated
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    17
  and the second argument represents the right number (in Wang's
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    18
  coding) of the TM tape.  (Notice, left number is always @{text "0"}
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    19
  at the very beginning). However, UTM needs to simulate the execution
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    20
  of any TM which may very well take many input arguments. Therefore,
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    21
  a initialization TM needs to run before the TM compiled from @{text
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    22
  "rec_F"}, and the sequential composition of these two TMs will give
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    23
  rise to the UTM we are seeking. The purpose of this initialization
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    24
  TM is to transform the multiple input arguments of the TM being
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    25
  simulated into Wang's coding, so that it can be consumed by the TM
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    26
  compiled from @{text "rec_F"} as the second argument.
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    27
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    28
  However, this initialization TM (named @{text "t_wcode"}) can not be
169
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
    29
  constructed by compiling from any recursive function, because every
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    30
  recursive function takes a fixed number of input arguments, while
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    31
  @{text "t_wcode"} needs to take varying number of arguments and
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    32
  tranform them into Wang's coding. Therefore, this section give a
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    33
  direct construction of @{text "t_wcode"} with just some parts being
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    34
  obtained from recursive functions.
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    35
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    36
\newlength{\basewidth}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    37
\settowidth{\basewidth}{xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    38
\newlength{\baseheight}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    39
\settoheight{\baseheight}{$B:R$}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    40
\newcommand{\vsep}{5\baseheight}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    41
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    42
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
    43
 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
    44
 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
    45
 fixed to $0$.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    46
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    47
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
    48
\ref{prepare_input} and \ref{prepare_output}.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    49
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    50
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    51
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    52
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    53
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    54
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    55
  [tbox/.style = {draw, thick, inner sep = 5pt}]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    56
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    57
  \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
    58
  \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
    59
  \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
    60
  \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
    61
  \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
    62
  \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
    63
  \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
    64
  \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
    65
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    66
\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
    67
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    68
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    69
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    70
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    71
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    72
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    73
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    74
  \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
    75
  \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
    76
  \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
    77
  \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
    78
  \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
    79
  \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
    80
  \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
    81
  \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
    82
  \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
    83
  \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
    84
  \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
    85
  \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
    86
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    87
\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
    88
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    89
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    90
As shown in Figure \ref{prepare_input}, the input of $prepare$ is the
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    91
same as the the input of UTM, where $m$ is the Godel coding of the TM
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    92
being interpreted and $a_1$ through $a_n$ are the $n$ input arguments
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    93
of the TM under interpretation. The purpose of $purpose$ is to
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    94
transform this initial tape layout to the one shown in Figure
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    95
\ref{prepare_output}, which is convenient for the generation of Wang's
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    96
codding of $a_1, \ldots, a_n$. The coding procedure starts from $a_n$
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    97
and ends after $a_1$ is encoded. The coding result is stored in an
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    98
accumulator at the end of the tape (initially represented by the $1$
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    99
two blanks right to $a_n$ in Figure \ref{prepare_output}). In Figure
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
   100
\ref{prepare_output}, arguments $a_1, \ldots, a_n$ are separated by
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
   101
two blanks on both ends with the rest so that movement conditions can
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
   102
be implemented conveniently in subsequent TMs, because, by convention,
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
   103
two consecutive blanks are usually used to signal the end or start of
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
   104
a large chunk of data. The diagram of $prepare$ is given in Figure
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
   105
\ref{prepare_diag}.
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   106
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
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   109
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   110
\scalebox{0.9}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   111
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   112
     \node[circle,draw] (1) {$1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   113
     \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
   114
     \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
   115
     \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
   116
     \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
   117
     \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
   118
     \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
   119
     \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
   120
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
     \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
   123
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   124
     \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
   125
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   126
     \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
   127
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   128
     \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
   129
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   130
     \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
   131
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   132
     \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
   133
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   134
     \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
   135
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   136
     \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
   137
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   138
     \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
   139
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   140
     \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
   141
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   142
     \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
   143
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   144
     \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
   145
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   146
     \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
   147
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   148
     \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
   149
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   150
 \end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   151
\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
   152
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   153
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   154
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
   155
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
   156
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
   157
every iteration:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   158
\begin{enumerate}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   159
    \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
   160
        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
   161
        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
   162
        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
   163
        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
   164
        $(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
   165
    \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
   166
        \ref{mainwork_case_two_input},
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   167
        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
   168
        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
   169
        $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
   170
        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
   171
        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
   172
        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
   173
        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
   174
        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
   175
        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
   176
        $(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
   177
    \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
   178
        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
   179
        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
   180
        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
   181
        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
   182
\end{enumerate}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   183
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
   184
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
   185
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
   186
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   187
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   188
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   189
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   190
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   191
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   192
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   193
  \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
   194
  \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
   195
  \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
   196
  \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
   197
  \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
   198
  \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
   199
  \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
   200
  \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
   201
  \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
   202
  \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
   203
  \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
   204
  \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
   205
  \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
   206
  \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
   207
  \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
   208
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   209
\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
   210
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   211
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   212
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   213
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   214
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   215
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   216
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   217
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   218
  \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
   219
  \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
   220
  \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
   221
  \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
   222
  \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
   223
  \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
   224
  \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
   225
  \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
   226
  \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
   227
  \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
   228
  \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
   229
  \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
   230
  \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
   231
  \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
   232
  \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
   233
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   234
\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
   235
\label{mainwork_case_one_output}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   236
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   237
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   238
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   239
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   240
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   241
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   242
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   243
  \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
   244
  \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
   245
  \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
   246
  \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
   247
  \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
   248
  \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
   249
  \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
   250
  \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
   251
  \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
   252
  \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
   253
  \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
   254
  \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
   255
  \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
   256
  \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
   257
  \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
   258
  \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
   259
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   260
\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
   261
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   262
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   263
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   264
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   265
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   266
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   267
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   268
  \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
   269
  \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
   270
  \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
   271
  \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
   272
  \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
   273
  \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
   274
  \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
   275
  \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
   276
  \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
   277
  \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
   278
  \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
   279
  \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
   280
  \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
   281
  \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
   282
  \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
   283
  \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
   284
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   285
\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
   286
\label{mainwork_case_two_output}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   287
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   288
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   289
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   290
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   291
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   292
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   293
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   294
  \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
   295
  \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
   296
  \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
   297
  \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
   298
  \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
   299
  \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
   300
  \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
   301
  \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
   302
  \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
   303
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   304
\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
   305
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   306
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   307
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   308
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   309
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   310
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   311
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   312
  \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
   313
  \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
   314
  \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
   315
  \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
   316
  \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
   317
  \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
   318
  \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
   319
  \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
   320
  \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
   321
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   322
\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
   323
\label{mainwork_case_three_output}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   324
\end{figure}
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
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   327
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   328
\scalebox{0.9}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   329
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   330
     \node[circle,draw] (1) {$1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   331
     \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
   332
     \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
   333
     \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
   334
     \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
   335
     \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
   336
     \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
   337
     \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
   338
     \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
   339
     \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
   340
     \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
   341
     \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
   342
     \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
   343
     \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
   344
     \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
   345
     \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
   346
     \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
   347
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   348
     \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
   349
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   350
     \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
   351
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   352
     \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
   353
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   354
     \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
   355
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   356
     \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
   357
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   358
     \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
   359
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   360
     \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
   361
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   362
     \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
   363
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   364
     \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
   365
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   366
     \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
   367
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   368
     \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
   369
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   370
     \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
   371
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   372
     \draw [->, >=latex] (13) -- (14)
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 (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
   375
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   376
     \draw [->, >=latex] ($(1) + (0, 6\baseheight)$) -- (1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   377
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   378
     \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
   379
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   380
     \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
   381
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   382
     \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
   383
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   384
     \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
   385
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   386
     \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
   387
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   388
     \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
   389
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   390
     \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
   391
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   392
     \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
   393
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   394
     \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
   395
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   396
     \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
   397
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   398
     \draw [->, >=latex] (15) -- (16)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   399
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   400
     \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
   401
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   402
     \draw [->, >=latex] ($(1) + (0, -18\baseheight)$) -- (1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   403
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   404
 \end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   405
\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
   406
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   407
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   408
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
   409
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
   410
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
   411
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   412
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   413
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   414
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   415
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   416
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   417
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   418
  \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
   419
  \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
   420
  \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
   421
  \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
   422
  \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
   423
  \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
   424
  \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
   425
  \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
   426
  \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
   427
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   428
\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
   429
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   430
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   431
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   432
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   433
\scalebox{1.2}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   434
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   435
  \node (0) {};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   436
  \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
   437
  \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
   438
  \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
   439
  \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
   440
  \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
   441
  \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
   442
  \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
   443
\end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   444
\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
   445
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   446
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
\begin{figure}[h!]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   449
\centering
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   450
\scalebox{0.9}{
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   451
\begin{tikzpicture}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   452
     \node[circle,draw] (1) {$1$};
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   453
     \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
   454
     \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
   455
     \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
   456
     \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
   457
     \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
   458
     \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
   459
     \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
   460
     \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
   461
     \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
   462
     \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
   463
     \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
   464
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] (1) -- node[above] {$S_1:R$} (2)
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] (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
   469
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   470
     \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
   471
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   472
     \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
   473
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   474
     \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
   475
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   476
     \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
   477
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   478
     \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
   479
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   480
     \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
   481
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   482
     \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
   483
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   484
     \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
   485
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   486
     \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
   487
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   488
     \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
   489
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   490
     \draw [->, >=latex] ($(2) + (0, 6\baseheight)$) -- (2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   491
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   492
     \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
   493
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   494
     \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
   495
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   496
     \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
   497
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   498
     \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
   499
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   500
     \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
   501
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   502
     \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
   503
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   504
     \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
   505
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   506
     \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
   507
     ;
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   508
 \end{tikzpicture}}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   509
\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
   510
\end{figure}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   511
*}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   512
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   513
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   514
definition rec_twice :: "recf"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   515
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   516
  "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
   517
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   518
definition rec_fourtimes  :: "recf"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   519
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   520
  "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
   521
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   522
definition abc_twice :: "abc_prog"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   523
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   524
  "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
   525
                       aprog [+] dummy_abc ((Suc 0)))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   526
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   527
definition abc_fourtimes :: "abc_prog"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   528
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   529
  "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
   530
                       aprog [+] dummy_abc ((Suc 0)))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   531
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   532
definition twice_ly :: "nat list"
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
  "twice_ly = layout_of abc_twice"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   535
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   536
definition fourtimes_ly :: "nat list"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   537
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   538
  "fourtimes_ly = layout_of abc_fourtimes"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   539
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   540
definition t_twice_compile :: "instr list"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   541
where
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   542
  "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
   543
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   544
definition t_twice :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   545
  where
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   546
  "t_twice = adjust t_twice_compile"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   547
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   548
definition t_fourtimes_compile :: "instr list"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   549
where
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   550
  "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
   551
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   552
definition t_fourtimes :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   553
  where
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   554
  "t_fourtimes = adjust t_fourtimes_compile"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   555
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   556
definition t_twice_len :: "nat"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   557
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   558
  "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
   559
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   560
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
   561
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   562
  "t_wcode_main_first_part \<equiv> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   563
                   [(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
   564
                    (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
   565
                    (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
   566
                    (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
   567
                    (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
   568
                    (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
   569
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   570
definition t_wcode_main :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   571
  where
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   572
  "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
   573
                    @ 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
   574
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   575
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
   576
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   577
  "bl_bin [] = 0" 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   578
| "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
   579
| "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
   580
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   581
declare bl_bin.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   582
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   583
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
   584
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   585
fun wcode_before_double :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   586
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   587
  "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
   588
     (\<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
   589
               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
   590
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   591
declare wcode_before_double.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   592
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   593
fun wcode_after_double :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   594
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   595
  "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
   596
     (\<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
   597
         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
   598
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   599
declare wcode_after_double.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   600
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   601
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
   602
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   603
  "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
   604
     (\<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
   605
               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
   606
               ml + mr > Suc 0 \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   607
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   608
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
   609
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   610
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
   611
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   612
  "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
   613
     (\<exists> ln rn.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   614
               l = Oc # ires \<and> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   615
               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
   616
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   617
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
   618
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   619
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
   620
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   621
  "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
   622
          (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
   623
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   624
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
   625
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   626
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
   627
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   628
   "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
   629
    (\<exists> ln rn. l = ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   630
              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
   631
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   632
fun wcode_erase1 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   633
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   634
"wcode_erase1 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   635
       (\<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
   636
                 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
   637
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   638
declare wcode_erase1.simps [simp del]
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
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
   641
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   642
  "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
   643
       (\<exists> ml mr rn.        
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   644
             l = Bk\<up>(ml) @ Oc # ires \<and> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   645
             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
   646
             ml + mr > Suc 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   647
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   648
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
   649
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   650
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
   651
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   652
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
   653
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   654
  "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
   655
      (\<exists> ml mr ln rn. 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   656
            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
   657
            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
   658
            ml + mr = Suc rs)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   659
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   660
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
   661
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   662
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
   663
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   664
  "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
   665
          (\<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
   666
               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
   667
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   668
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
   669
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   670
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
   671
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   672
   "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
   673
        (\<exists> ml mr ln rn. 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   674
            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
   675
            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
   676
            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
   677
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   678
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
   679
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   680
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
   681
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   682
  "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
   683
                                            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
   684
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   685
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
   686
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   687
lemma [simp]: "<0::nat> = [Oc]"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   688
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
   689
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   690
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   691
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
   692
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
   693
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   694
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   695
lemma [simp]: "length (<a::nat>) = Suc a"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   696
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
   697
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   698
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   699
lemma [simp]: "<[a::nat]> = <a>"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   700
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
   701
  tape_of_nat_list.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   702
done
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 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
   705
proof(induct xs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   706
  show " bl_bin [] = bl2wc []" 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   707
    apply(simp add: bl_bin.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   708
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   709
next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   710
  fix a xs
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   711
  assume "bl_bin xs = bl2wc xs"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   712
  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
   713
    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
   714
    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
   715
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   716
qed
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_nat_Suc:  
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   719
  "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
   720
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
   721
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
   722
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   723
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   724
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
   725
apply(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   726
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   727
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   728
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
   729
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
   730
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   731
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   732
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
   733
apply(induct lm, simp, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   734
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
   735
apply(simp add: exp_ind[THEN sym])
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   736
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   737
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   738
lemma [simp]: "a\<up>(Suc 0) = [a]" 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   739
by(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   740
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   741
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
   742
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
   743
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
   744
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   745
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   746
lemma bl_bin_bk_oc[simp]:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   747
  "bl_bin (xs @ [Bk, Oc]) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   748
  bl_bin xs + 2*2^(length xs)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   749
apply(simp add: bin_wc_eq)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   750
using bl2nat_cons_oc[of "xs @ [Bk]"]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   751
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
   752
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   753
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   754
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
   755
apply(simp add: tape_of_nat_abv)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   756
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   757
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   758
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
   759
proof(induct "length xs" arbitrary: xs c,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   760
  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
   761
  fix x xs c
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   762
  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
   763
    <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
   764
    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
   765
  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
   766
  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
   767
    fix a list
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   768
    assume g: "xs = a # list"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   769
    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
   770
      apply(rule_tac ind)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   771
      using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   772
      apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   773
      done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   774
    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
   775
      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
   776
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   777
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   778
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   779
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   780
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
   781
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
   782
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   783
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   784
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
   785
              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
   786
              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
   787
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
   788
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   789
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   790
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   791
declare replicate_Suc[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   792
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   793
lemma [simp]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   794
  "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
   795
  = 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
   796
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   797
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
   798
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
   799
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
   800
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   801
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   802
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
   803
apply(induct list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   804
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
   805
apply(case_tac list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   806
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
   807
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   808
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   809
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
   810
              = 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
   811
              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
   812
apply(simp add: bin_wc_eq)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   813
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
   814
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
   815
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   816
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   817
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
   818
         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
   819
       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
   820
         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
   821
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
   822
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   823
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   824
declare tape_of_nat[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   825
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   826
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
   827
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   828
  "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
   829
          (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
   830
          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
   831
          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
   832
          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
   833
          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
   834
          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
   835
          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
   836
          else False)"
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
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
   839
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   840
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
   841
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   842
  "wcode_double_case_state (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   843
   13 - st"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   844
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   845
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
   846
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   847
  "wcode_double_case_step (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   848
      (if st = Suc 0 then (length l)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   849
      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
   850
      else if st = 3 then 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   851
                 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
   852
      else if st = 4 then (length r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   853
      else if st = 5 then (length r)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   854
      else if st = 6 then (length l)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   855
      else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   856
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   857
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
   858
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   859
  "wcode_double_case_measure (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   860
     (wcode_double_case_state (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   861
      wcode_double_case_step (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   862
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   863
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
   864
  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
   865
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   866
lemma [intro]: "wf lex_pair"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   867
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
   868
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   869
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
   870
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
   871
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   872
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
   873
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
   874
                fetch.simps nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   875
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   876
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   877
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
   878
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
   879
                fetch.simps nth_of.simps)
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 (Suc (Suc 0)) Oc = (R, 3)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   883
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
   884
                fetch.simps nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   885
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   886
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   887
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
   888
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
   889
                fetch.simps nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   890
done 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   891
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   892
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
   893
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
   894
                fetch.simps nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   895
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   896
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   897
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
   898
apply(subgoal_tac "4 = Suc 3")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   899
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
   900
                fetch.simps nth_of.simps, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   901
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   902
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   903
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
   904
apply(subgoal_tac "4 = Suc 3")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   905
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
   906
                fetch.simps nth_of.simps, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   907
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   908
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   909
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
   910
apply(subgoal_tac "5 = Suc 4")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   911
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
   912
                fetch.simps nth_of.simps, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   913
done
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
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
   916
apply(subgoal_tac "5 = Suc 4")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   917
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
   918
                fetch.simps nth_of.simps, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   919
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   920
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   921
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
   922
apply(subgoal_tac "6 = Suc 5")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   923
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
   924
                fetch.simps nth_of.simps, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   925
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   926
  
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   927
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
   928
apply(subgoal_tac "6 = Suc 5")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   929
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
   930
                fetch.simps nth_of.simps, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   931
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   932
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   933
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
   934
apply(case_tac mr, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   935
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   936
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   937
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
   938
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
   939
                wcode_on_left_moving_1_O.simps) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   940
done                                           
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   941
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   942
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   943
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
   944
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   945
lemmas wcode_double_case_inv_simps = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   946
  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
   947
  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
   948
  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
   949
  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
   950
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   951
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   952
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
   953
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
   954
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   955
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   956
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   957
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
   958
                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
   959
               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
   960
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
   961
                wcode_on_left_moving_1_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   962
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   963
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   964
apply(case_tac ml, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   965
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
   966
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
   967
apply(rule_tac disjI1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   968
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
   969
      simp, simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   970
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   971
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   972
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   973
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   974
declare replicate_Suc[simp]
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   975
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   976
lemma [elim]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   977
  "\<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
   978
    \<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
   979
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
   980
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   981
apply(erule_tac [!] exE)+
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   982
apply(case_tac mr, simp, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
   983
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   984
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   985
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
   986
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
   987
done         
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   988
 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   989
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
   990
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
   991
done         
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   992
  
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   993
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
   994
  \<Longrightarrow> wcode_erase1 ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   995
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
   996
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   997
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
   998
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   999
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1000
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1001
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
  1002
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
  1003
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1004
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1005
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
  1006
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
  1007
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1008
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1009
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
  1010
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
  1011
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1012
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1013
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
  1014
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
  1015
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1016
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1017
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
  1018
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
  1019
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1020
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1021
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
  1022
  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
  1023
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
  1024
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1025
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
  1026
      rule_tac x = rn in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1027
apply(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1028
apply(case_tac mr, simp, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1029
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1030
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1031
lemma [elim]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1032
  "\<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
  1033
  \<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
  1034
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
  1035
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1036
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
  1037
      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
  1038
apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1039
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
  1040
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1041
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1042
lemma [simp]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1043
  "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
  1044
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
  1045
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1046
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1047
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
  1048
  \<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
  1049
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
  1050
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1051
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
  1052
      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
  1053
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1054
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1055
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
  1056
  wcode_erase1 ires rs (aa, ba)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1057
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
  1058
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1059
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
  1060
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1061
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1062
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
  1063
              \<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
  1064
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
  1065
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1066
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1067
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
  1068
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
  1069
      rule_tac x = rn in exI, simp)
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]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1073
  "\<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
  1074
  \<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
  1075
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
  1076
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1077
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1078
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
  1079
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
  1080
      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
  1081
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
  1082
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1083
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1084
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
  1085
  \<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
  1086
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
  1087
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1088
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
  1089
      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
  1090
apply(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1091
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
  1092
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1093
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1094
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
  1095
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
  1096
                 wcode_backto_standard_pos_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1097
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1098
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1099
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
  1100
  \<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
  1101
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
  1102
                 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
  1103
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1104
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1105
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
  1106
apply(auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1107
apply(case_tac [!] mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1108
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1109
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1110
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
  1111
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
  1112
                 wcode_backto_standard_pos_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1113
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1114
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1115
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
  1116
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
  1117
                 wcode_backto_standard_pos_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1118
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1119
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1120
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
  1121
       \<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
  1122
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
  1123
                 wcode_backto_standard_pos_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1124
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1125
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1126
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1127
apply(case_tac ml, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1128
apply(rule_tac disjI1, rule_tac conjI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1129
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
  1130
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1131
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
  1132
      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
  1133
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1134
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1135
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
  1136
lemma wcode_double_case_first_correctness:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1137
  "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
  1138
       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
  1139
       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
  1140
       \<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
  1141
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1142
  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
  1143
  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
  1144
  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
  1145
  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
  1146
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1147
    show "wf wcode_double_case_le"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1148
      by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1149
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1150
    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
  1151
                   ?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
  1152
    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
  1153
      fix na a b c
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1154
      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
  1155
               (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
  1156
                   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
  1157
                (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
  1158
        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
  1159
        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
  1160
              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
  1161
        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
  1162
                                        lex_pair_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1163
        apply(auto split: if_splits)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1164
        done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1165
    qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1166
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1167
    show "?Q (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1168
      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
  1169
                                  wcode_on_left_moving_1.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1170
                                  wcode_on_left_moving_1_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1171
      apply(rule_tac disjI1)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1172
      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
  1173
      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
  1174
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1175
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1176
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1177
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1178
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1179
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1180
  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
  1181
    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
  1182
    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
  1183
    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
  1184
    apply(simp add: Let_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1185
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1186
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1187
    
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1188
lemma tm_append_shift_append_steps: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1189
"\<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
  1190
  0 < st';
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1191
  length tp1 mod 2 = 0
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1192
  \<rbrakk>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1193
  \<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
  1194
  = (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
  1195
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1196
  assume h: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1197
    "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
  1198
    "0 < st'"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1199
    "length tp1 mod 2 = 0 "
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1200
  from h have 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1201
    "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
  1202
                            (st' + length tp1 div 2, l', r')"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1203
    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
  1204
  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
  1205
                            (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
  1206
    using h
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1207
    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
  1208
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1209
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1210
    by simp
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1211
qed 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1212
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1213
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
  1214
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
  1215
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1216
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1217
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
  1218
  apply(rule_tac calc_id, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1219
  done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1220
  
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1221
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
  1222
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
  1223
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
  1224
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1225
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1226
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
  1227
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
  1228
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
  1229
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1230
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1231
declare start_of.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1232
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1233
lemma t_twice_correct: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1234
  "\<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
  1235
  (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
  1236
  (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
  1237
proof(case_tac "rec_ci rec_twice")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1238
  fix a b c
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1239
  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
  1240
  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
  1241
    (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
  1242
  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
  1243
    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
  1244
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1245
    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
  1246
      apply(simp add: rec_twice_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1247
      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
  1248
      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
  1249
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1250
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1251
    show "length [rs] = 1" by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1252
  next	
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1253
    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
  1254
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1255
    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
  1256
      using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1257
      apply(simp add: abc_twice_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1258
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1259
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1260
  thus "?thesis"
133
ca7fb6848715 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 131
diff changeset
  1261
    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
  1262
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1263
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1264
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1265
declare adjust.simps[simp]
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1266
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1267
lemma adjust_fetch0: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1268
  "\<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
  1269
  \<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
  1270
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
  1271
                       split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1272
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
  1273
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1274
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1275
lemma adjust_fetch_norm: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1276
  "\<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
  1277
 \<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
  1278
 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
  1279
                       split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1280
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
  1281
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1282
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1283
declare adjust.simps[simp del]
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1284
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1285
lemma adjust_step_eq: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1286
  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
  1287
  and wf_tm: "tm_wf (ap, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1288
  and notfinal: "st' > 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1289
  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
  1290
  using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1291
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1292
  have "st > 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1293
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1294
    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
  1295
  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
  1296
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1297
    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
  1298
    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
  1299
    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
  1300
      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
  1301
    apply(auto simp: mod_ex2)
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1302
    done    
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1303
  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
  1304
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1305
    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
  1306
    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
  1307
    apply(simp add: step.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1308
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1309
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1310
    using exec
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1311
    by(simp add: step.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1312
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1313
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1314
declare adjust.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1315
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1316
lemma adjust_steps_eq: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1317
  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
  1318
  and wf_tm: "tm_wf (ap, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1319
  and notfinal: "st' > 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1320
  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
  1321
  using exec notfinal
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1322
proof(induct stp arbitrary: st' l' r')
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1323
  case 0
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1324
  thus "?case"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1325
    by(simp add: steps.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1326
next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1327
  case (Suc stp st' l' r')
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1328
  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
  1329
    \<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
  1330
  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
  1331
  have g:   "0 < st'" by fact
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1332
  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
  1333
    by (metis prod_cases3)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1334
  hence c:"0 < st''"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1335
    using h g
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1336
    apply(simp add: step_red)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1337
    apply(case_tac st'', auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1338
    done
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  1339
  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
  1340
    using a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1341
    by(rule_tac ind, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1342
  thus "?case"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1343
    using assms a b h g
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1344
    apply(simp add: step_red) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1345
    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
  1346
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1347
qed 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1348
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1349
lemma adjust_halt_eq:
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1350
  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
  1351
  and tm_wf: "tm_wf (ap, 0)" 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1352
  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
  1353
        (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
  1354
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1355
  have "\<exists> stp. \<not> is_final (steps0 (1, l, r) ap stp) \<and> (steps0 (1, l, r) ap (Suc stp) = (0, l', r'))"
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
  1356
    using exec
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1357
    by(erule_tac before_final)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1358
  then obtain stpa where a: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1359
    "\<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
  1360
  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
  1361
  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
  1362
    using assms a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1363
    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
  1364
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1365
  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
  1366
    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
  1367
    by(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1368
  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
  1369
    by (metis prod.exhaust)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1370
  hence f: "ns = 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1371
    using b a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1372
    apply(simp add: step_red step.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1373
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1374
  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
  1375
    using a b c d e f
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1376
    apply(rule_tac adjust_fetch0, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1377
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1378
  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
  1379
    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
  1380
    apply(simp add: step_red, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1381
    apply(simp add: step.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1382
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1383
qed    
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1384
   
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1385
declare tm_wf.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1386
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1387
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
  1388
apply(simp only: t_twice_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1389
apply(rule_tac t_compiled_correct)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1390
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
  1391
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1392
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1393
lemma t_twice_change_term_state:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1394
  "\<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
  1395
     = (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
  1396
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1397
  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
  1398
    (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
  1399
    (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
  1400
    by(rule_tac t_twice_correct)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1401
  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
  1402
    (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
  1403
    (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
  1404
  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
  1405
    (adjust t_twice_compile) stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1406
     = (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
  1407
    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
  1408
    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
  1409
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1410
  then obtain stpb where 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1411
    "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
  1412
    (adjust t_twice_compile) stpb
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1413
     = (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
  1414
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1415
    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
  1416
    by metis
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1417
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1418
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1419
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
  1420
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
  1421
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1422
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1423
lemma t_twice_append_pre:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1424
  "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
  1425
  = (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
  1426
   \<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
  1427
     (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
  1428
      ([(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
  1429
    = (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
  1430
             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
  1431
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
  1432
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1433
lemma t_twice_append:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1434
  "\<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
  1435
     (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
  1436
      ([(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
  1437
    = (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
  1438
  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
  1439
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1440
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1441
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1442
  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
  1443
  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
  1444
  apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1445
  done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1446
  
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1447
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
  1448
apply(auto simp: mopup.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1449
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1450
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1451
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
  1452
     = (L, Suc 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1453
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
  1454
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
  1455
  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
  1456
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
  1457
using mopup_mod2[of 1]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1458
apply(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1459
by arith
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1460
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1461
lemma wcode_jump1: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1462
  "\<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
  1463
                       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
  1464
     t_wcode_main stp 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1465
    = (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
  1466
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
  1467
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
  1468
apply(case_tac m, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1469
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
  1470
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1471
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1472
lemma wcode_main_first_part_len:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1473
  "length t_wcode_main_first_part = 24"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1474
  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
  1475
  done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1476
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1477
lemma wcode_double_case: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1478
  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
  1479
          (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
  1480
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1481
  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
  1482
          (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
  1483
    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
  1484
    apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1485
    apply(erule_tac exE)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1486
    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
  1487
           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
  1488
          auto simp: wcode_double_case_inv.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1489
                     wcode_before_double.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1490
    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
  1491
    apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1492
    done    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1493
  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
  1494
    "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
  1495
    (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
  1496
  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
  1497
    (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
  1498
    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
  1499
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1500
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1501
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1502
    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
  1503
    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
  1504
          rule_tac x = rn in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1505
    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
  1506
    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
  1507
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1508
  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
  1509
    "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
  1510
    (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
  1511
  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
  1512
    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
  1513
       (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
  1514
    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
  1515
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1516
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1517
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1518
    apply(rule_tac x = stp in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1519
          rule_tac x = ln in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1520
          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
  1521
    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
  1522
    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
  1523
    apply(simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1524
    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
  1525
    done               
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1526
  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
  1527
    "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
  1528
    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
  1529
       (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
  1530
    by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1531
  from stp1 stp2 stp3 show "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1532
    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
  1533
         rule_tac x = rnc in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1534
    apply(simp add: steps_add)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1535
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1536
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1537
    
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
(* Begin: fourtime_case*)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1540
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
  1541
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1542
  "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
  1543
     (\<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
  1544
                 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
  1545
                 ml + mr > Suc 0 \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1546
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1547
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
  1548
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1549
  "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
  1550
     (\<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
  1551
               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
  1552
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1553
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
  1554
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1555
  "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
  1556
      (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
  1557
      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
  1558
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1559
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
  1560
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1561
  "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
  1562
       (\<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
  1563
                 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
  1564
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1565
fun wcode_goon_checking :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1566
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1567
  "wcode_goon_checking ires rs (l, r) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1568
       (\<exists> ln rn. l = ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1569
                 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
  1570
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1571
fun wcode_right_move :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1572
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1573
  "wcode_right_move ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1574
     (\<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
  1575
                 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
  1576
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1577
fun wcode_erase2 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1578
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1579
  "wcode_erase2 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1580
        (\<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
  1581
                 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
  1582
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1583
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
  1584
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1585
  "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
  1586
        (\<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
  1587
                     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
  1588
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1589
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
  1590
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1591
  "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
  1592
        (\<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
  1593
                        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
  1594
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1595
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
  1596
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1597
  "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
  1598
           (\<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
  1599
                     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
  1600
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1601
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
  1602
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1603
  "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
  1604
          (\<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
  1605
                          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
  1606
                          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
  1607
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1608
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
  1609
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1610
  "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
  1611
           (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
  1612
           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
  1613
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1614
fun wcode_before_fourtimes :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1615
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1616
  "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
  1617
          (\<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
  1618
                    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
  1619
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1620
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
  1621
        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
  1622
        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
  1623
        wcode_erase2.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1624
        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
  1625
        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
  1626
        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
  1627
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1628
lemmas wcode_fourtimes_invs = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1629
       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
  1630
        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
  1631
        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
  1632
        wcode_erase2.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1633
        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
  1634
        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
  1635
        wcode_backto_standard_pos_2.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1636
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1637
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
  1638
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1639
  "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
  1640
           (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
  1641
            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
  1642
            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
  1643
            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
  1644
            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
  1645
            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
  1646
            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
  1647
            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
  1648
            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
  1649
            else False)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1650
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1651
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
  1652
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1653
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
  1654
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1655
  "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
  1656
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1657
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
  1658
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1659
  "wcode_fourtimes_case_step (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1660
         (if st = Suc 0 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1661
          else if st = 9 then 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1662
           (if hd r = Oc then 1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1663
            else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1664
          else if st = 10 then length r
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1665
          else if st = 11 then length r
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1666
          else if st = 12 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1667
          else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1668
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1669
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
  1670
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1671
  "wcode_fourtimes_case_measure (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1672
     (wcode_fourtimes_case_state (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1673
      wcode_fourtimes_case_step (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1674
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1675
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
  1676
  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
  1677
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1678
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
  1679
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
  1680
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1681
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
  1682
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
  1683
  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
  1684
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1685
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1686
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
  1687
apply(subgoal_tac "7 = Suc 6")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1688
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
  1689
  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
  1690
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1691
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1692
 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1693
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
  1694
apply(subgoal_tac "8 = Suc 7")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1695
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
  1696
  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
  1697
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1698
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1699
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1700
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1701
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
  1702
apply(subgoal_tac "9 = Suc 8")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1703
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
  1704
  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
  1705
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1706
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1707
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1708
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
  1709
apply(subgoal_tac "9 = Suc 8")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1710
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
  1711
  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
  1712
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1713
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1714
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1715
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
  1716
apply(subgoal_tac "10 = Suc 9")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1717
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
  1718
  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
  1719
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1720
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1721
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1722
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
  1723
apply(subgoal_tac "10 = Suc 9")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1724
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
  1725
  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
  1726
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1727
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1728
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1729
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
  1730
apply(subgoal_tac "11 = Suc 10")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1731
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
  1732
  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
  1733
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1734
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1735
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1736
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
  1737
apply(subgoal_tac "11 = Suc 10")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1738
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
  1739
  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
  1740
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1741
done
130
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]: "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
  1744
apply(subgoal_tac "12 = Suc 11")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1745
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
  1746
  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
  1747
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1748
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1749
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1750
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
  1751
apply(subgoal_tac "12 = Suc 11")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1752
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
  1753
  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
  1754
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1755
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1756
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1757
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
  1758
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1759
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1760
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1761
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
  1762
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1763
done          
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1764
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1765
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
  1766
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1767
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1768
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1769
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
  1770
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1771
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1772
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1773
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
  1774
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1775
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1776
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1777
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
  1778
apply(auto simp: wcode_fourtimes_invs)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1779
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1780
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1781
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
  1782
apply(auto simp: wcode_fourtimes_invs)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1783
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1784
    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1785
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
  1786
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
  1787
done     
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1788
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1789
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
  1790
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1791
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1792
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1793
apply(case_tac ml, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1794
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
  1795
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
  1796
apply(rule_tac disjI1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1797
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
  1798
      simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1799
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1800
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1801
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1802
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
  1803
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1804
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1805
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1806
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
  1807
       \<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
  1808
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1809
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1810
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1811
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1812
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
  1813
apply(simp add: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1814
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1815
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1816
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
  1817
apply(simp add: wcode_fourtimes_invs)
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_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
  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
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
  1823
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1824
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1825
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
  1826
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1827
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1828
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1829
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
  1830
apply(auto simp:wcode_fourtimes_invs )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1831
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
  1832
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
  1833
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1834
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1835
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
  1836
apply(auto simp:wcode_fourtimes_invs )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1837
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1838
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1839
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
  1840
       \<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
  1841
apply(auto simp: wcode_fourtimes_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1842
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
  1843
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
  1844
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1845
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1846
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
  1847
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1848
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1849
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1850
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
  1851
                 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
  1852
apply(simp add: wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1853
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
  1854
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
  1855
apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1856
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
  1857
apply(case_tac rn, simp, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1858
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1859
   
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1860
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
  1861
apply(simp add: wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1862
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1863
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1864
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
  1865
apply(simp add: wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1866
done
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_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
  1869
                     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
  1870
apply(auto simp: wcode_fourtimes_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1871
apply(case_tac [!] mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1872
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1873
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1874
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
  1875
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1876
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1877
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1878
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
  1879
              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
  1880
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1881
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1882
apply(rule_tac disjI1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1883
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
  1884
      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
  1885
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1886
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1887
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
  1888
       \<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
  1889
apply(auto simp: wcode_fourtimes_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1890
apply(case_tac [!] mr, auto)
130
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
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1894
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
  1895
apply(simp add: wcode_fourtimes_invs)
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_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
  1899
  (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
  1900
  (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
  1901
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1902
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1903
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1904
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1905
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1906
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
  1907
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1908
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1909
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1910
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
  1911
apply(simp add: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1912
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1913
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1914
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
  1915
       \<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
  1916
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1917
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1918
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1919
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
  1920
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1921
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1922
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1923
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1924
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
  1925
       \<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
  1926
apply(auto simp: wcode_fourtimes_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1927
apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1928
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
  1929
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
  1930
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
  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_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
  1934
apply(simp only:wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1935
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1936
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1937
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
  1938
       \<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
  1939
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
  1940
apply(case_tac [!] mr, simp_all)
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 [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
  1944
apply(simp add: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1945
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1946
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1947
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
  1948
       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
  1949
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
  1950
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
  1951
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
  1952
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
  1953
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1954
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1955
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
  1956
apply(simp only: wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1957
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1958
 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1959
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
  1960
            \<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
  1961
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1962
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1963
apply(erule_tac exE)+
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1964
apply(case_tac ml, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1965
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
  1966
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
  1967
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1968
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1969
lemma wcode_fourtimes_case_first_correctness:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1970
 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
  1971
  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
  1972
  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
  1973
  \<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
  1974
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1975
  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
  1976
  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
  1977
  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
  1978
  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
  1979
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1980
    show "wf wcode_fourtimes_case_le"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1981
      by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1982
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1983
    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
  1984
                  ?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
  1985
    apply(rule_tac allI,
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1986
     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
  1987
     rule_tac impI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1988
    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
  1989
    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
  1990
                        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
  1991
    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
  1992
      wcode_backto_standard_pos_2_B.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1993
    apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1994
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1995
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1996
    show "?Q (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1997
      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
  1998
      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
  1999
                      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
  2000
      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
  2001
      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
  2002
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2003
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2004
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2005
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2006
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2007
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2008
  thus "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2009
    apply(erule_tac exE, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2010
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2011
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2012
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2013
definition t_fourtimes_len :: "nat"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2014
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2015
  "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
  2016
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2017
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
  2018
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
  2019
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2020
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2021
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
  2022
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
  2023
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
  2024
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2025
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2026
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
  2027
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
  2028
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
  2029
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2030
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2031
lemma t_fourtimes_correct: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2032
  "\<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
  2033
    (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
  2034
       (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
  2035
proof(case_tac "rec_ci rec_fourtimes")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2036
  fix a b c
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2037
  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
  2038
  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
  2039
    (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
  2040
  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
  2041
    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
  2042
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2043
    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
  2044
      apply(simp add: rec_fourtimes_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2045
      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
  2046
      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
  2047
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2048
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2049
    show "length [rs] = 1" by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2050
  next	
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2051
    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
  2052
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2053
    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
  2054
      using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2055
      apply(simp add: abc_fourtimes_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2056
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2057
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2058
  thus "?thesis"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  2059
    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
  2060
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2061
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2062
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2063
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
  2064
apply(simp only: t_fourtimes_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2065
apply(rule_tac t_compiled_correct)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2066
apply(simp_all add: abc_twice_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2067
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2068
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2069
lemma t_fourtimes_change_term_state:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2070
  "\<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
  2071
     = (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
  2072
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2073
  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
  2074
    (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
  2075
    (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
  2076
    by(rule_tac t_fourtimes_correct)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2077
  then obtain stp ln rn where 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2078
    "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
  2079
    (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
  2080
    (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
  2081
  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
  2082
    (adjust t_fourtimes_compile) stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2083
     = (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
  2084
    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
  2085
    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
  2086
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2087
  then obtain stpb where 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2088
    "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
  2089
    (adjust t_fourtimes_compile) stpb
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2090
     = (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
  2091
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2092
    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
  2093
    by metis
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2094
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2095
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2096
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
  2097
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
  2098
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2099
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2100
lemma t_fourtimes_append_pre:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2101
  "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
  2102
  = (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
  2103
   \<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
  2104
              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
  2105
       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
  2106
     ((t_wcode_main_first_part @ 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2107
  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
  2108
  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
  2109
  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
  2110
  = ((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
  2111
  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
  2112
  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
  2113
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
  2114
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
  2115
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2116
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2117
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2118
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
  2119
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
  2120
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2121
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2122
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
  2123
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
  2124
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2125
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2126
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
  2127
             = (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
  2128
apply(simp add: t_twice_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2129
done 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2130
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2131
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
  2132
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
  2133
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2134
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2135
lemma t_fourtimes_append:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2136
  "\<exists> stp ln rn. 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2137
  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
  2138
  (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
  2139
  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
  2140
  ((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
  2141
  [(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
  2142
  = (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
  2143
  (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
  2144
                                                                 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
  2145
  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
  2146
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2147
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2148
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2149
  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
  2150
  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
  2151
  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
  2152
  done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2153
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2154
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
  2155
apply(simp add: t_wcode_main_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2156
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2157
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2158
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
  2159
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
  2160
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2161
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2162
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
  2163
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
  2164
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2165
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2166
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
  2167
using even_twice_len
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2168
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2169
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2170
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
  2171
using even_fourtimes_len
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2172
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2173
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2174
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
  2175
             = (L, Suc 0)" 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2176
apply(subgoal_tac "14 = Suc 13")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2177
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
  2178
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
  2179
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2180
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2181
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
  2182
             = (L, Suc 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2183
apply(subgoal_tac "14 = Suc 13")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2184
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
  2185
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
  2186
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2187
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2188
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
  2189
             = (L, Suc 0)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2190
apply(case_tac b, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2191
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2192
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2193
lemma wcode_jump2: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2194
  "\<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
  2195
  , 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
  2196
  (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
  2197
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
  2198
apply(simp add: steps.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2199
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
  2200
apply(simp add: step.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2201
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2202
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2203
lemma wcode_fourtimes_case:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2204
  shows "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2205
  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
  2206
  (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
  2207
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2208
  have "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2209
  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
  2210
  (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
  2211
    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
  2212
    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
  2213
    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
  2214
          rule_tac x = rn in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2215
    apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2216
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2217
  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
  2218
    "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
  2219
  (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
  2220
  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
  2221
                     t_wcode_main stp =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2222
          (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
  2223
    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
  2224
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2225
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2226
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2227
    apply(simp add: t_wcode_main_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2228
    apply(rule_tac x = stp in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2229
          rule_tac x = "ln + lna" in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2230
          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
  2231
    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
  2232
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2233
  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
  2234
    "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
  2235
                     t_wcode_main stpb =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2236
       (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
  2237
    by blast
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2238
  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
  2239
    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
  2240
    t_wcode_main stp =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2241
    (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
  2242
    apply(rule wcode_jump2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2243
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2244
  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
  2245
    "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
  2246
    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
  2247
    t_wcode_main stpc =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2248
    (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
  2249
    by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2250
  from stp1 stp2 stp3 show "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2251
    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
  2252
          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
  2253
    apply(simp add: steps_add)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2254
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2255
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2256
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
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2259
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
  2260
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2261
  "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
  2262
       (\<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
  2263
                    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
  2264
                    ml + mr > Suc 0 \<and> mr > 0 )"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2265
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2266
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
  2267
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2268
  "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
  2269
         (\<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
  2270
                   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
  2271
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2272
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
  2273
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2274
  "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
       (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
  2276
        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
  2277
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2278
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
  2279
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2280
  "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
  2281
         (\<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
  2282
             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
  2283
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2284
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
  2285
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2286
  "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
  2287
         (\<exists> ln rn. l = ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2288
             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
  2289
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2290
fun wcode_stop :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2291
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2292
  "wcode_stop ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2293
          (\<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
  2294
             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
  2295
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2296
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
  2297
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2298
  "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
  2299
          (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
  2300
           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
  2301
           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
  2302
           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
  2303
           else False)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2304
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2305
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
  2306
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2307
  "wcode_halt_case_state (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2308
           (if st = 1 then 5
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2309
            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
  2310
            else if st = 7 then 3
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2311
            else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2312
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2313
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
  2314
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2315
  "wcode_halt_case_step (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2316
         (if st = 1 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2317
         else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2318
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2319
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
  2320
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2321
  "wcode_halt_case_measure (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2322
     (wcode_halt_case_state (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2323
      wcode_halt_case_step (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2324
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2325
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
  2326
  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
  2327
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2328
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
  2329
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
  2330
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2331
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
  2332
        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
  2333
        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
  2334
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2335
lemmas wcode_halt_invs = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2336
  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
  2337
  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
  2338
  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
  2339
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2340
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
  2341
apply(subgoal_tac "7 = Suc 6")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2342
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
  2343
                t_wcode_main_first_part_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2344
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2345
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2346
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2347
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
  2348
apply(simp only: wcode_halt_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2349
apply(simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2350
done    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2351
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2352
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
  2353
apply(simp add: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2354
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2355
              
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2356
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
  2357
apply(simp add: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2358
done 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2359
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2360
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
  2361
 \<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
  2362
apply(simp only: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2363
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2364
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2365
apply(case_tac ml, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2366
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
  2367
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
  2368
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
  2369
apply(rule_tac disjI1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2370
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
  2371
      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
  2372
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2373
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2374
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2375
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
  2376
  (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
  2377
  (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
  2378
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2379
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2380
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2381
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
  2382
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2383
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2384
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2385
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
  2386
               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
  2387
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
  2388
apply(case_tac [!] mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2389
done     
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2390
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2391
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
  2392
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2393
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2394
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2395
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
  2396
apply(simp add: wcode_halt_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2397
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2398
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2399
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
  2400
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2401
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2402
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2403
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
  2404
  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
  2405
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2406
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2407
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2408
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
  2409
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
  2410
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2411
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2412
lemma t_halt_case_correctness: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2413
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
  2414
       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
  2415
       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
  2416
       \<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
  2417
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2418
  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
  2419
  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
  2420
  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
  2421
  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
  2422
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2423
    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
  2424
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2425
    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
  2426
                    ?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
  2427
      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
  2428
      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
  2429
      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
  2430
      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
  2431
      done      
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2432
  next 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2433
    show "?Q (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2434
      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
  2435
      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
  2436
      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
  2437
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2438
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2439
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2440
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2441
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2442
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2443
  thus "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2444
    apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2445
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2446
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2447
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2448
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
  2449
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
  2450
apply(case_tac "rev list", simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2451
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
  2452
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2453
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2454
lemma wcode_halt_case:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2455
  "\<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
  2456
  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
  2457
  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
  2458
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2459
apply(erule_tac exE)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2460
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
  2461
                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
  2462
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
  2463
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
  2464
      rule_tac x = rn in exI, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2465
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2466
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2467
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
  2468
apply(simp add: bl_bin.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2469
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2470
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2471
lemma [simp]: "bl_bin [Oc] = 1"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2472
apply(simp add: bl_bin.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2473
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2474
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2475
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
  2476
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
  2477
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2478
declare replicate_Suc[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2479
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2480
lemma t_wcode_main_lemma_pre:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2481
  "\<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
  2482
       \<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
  2483
                    stp
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2484
      = (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
  2485
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
  2486
  fix x args lm rs m n
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2487
  assume ind:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2488
    "\<And>args lm rs m n.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2489
    \<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
  2490
    \<Longrightarrow> \<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2491
    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
  2492
    (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
  2493
    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
  2494
  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
  2495
    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
  2496
    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
  2497
    done    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2498
  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
  2499
  from h and this show
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2500
    "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2501
    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
  2502
    (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
  2503
  proof(case_tac "xs::nat list", simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2504
    show "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2505
          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
  2506
          (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
  2507
    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
  2508
      fix m n rs ires
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2509
      show "\<exists>stp ln rn.
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2510
          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
  2511
          (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
  2512
          apply(rule_tac wcode_halt_case)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2513
        done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2514
    next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2515
      fix a m n rs ires
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2516
      assume ind2:
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2517
        "\<And>m n rs ires.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2518
           \<exists>stp ln rn.
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2519
              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
  2520
              (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
  2521
      show " \<exists>stp ln rn.
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2522
          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
  2523
          (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
  2524
      proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2525
        have "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2526
          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
  2527
          (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
  2528
          apply(simp add: tape_of_nat)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2529
          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
  2530
          apply(simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2531
          done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2532
        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
  2533
          "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
  2534
          (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
  2535
        moreover have 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2536
          "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2537
          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
  2538
          (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
  2539
          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
  2540
        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
  2541
          "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
  2542
          (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
  2543
          by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2544
        from stp1 and stp2 show "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2545
          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
  2546
            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
  2547
          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
  2548
          apply(auto)
130
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
    qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2552
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2553
    fix aa list
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2554
    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
  2555
    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
  2556
      (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
  2557
    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
  2558
        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
  2559
      fix m n rs args lm
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2560
      have "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2561
        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
  2562
        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
  2563
        (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
  2564
        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
  2565
        proof(simp add: tape_of_nl_rev)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2566
          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
  2567
          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
  2568
          thus "\<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
            (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
  2572
            apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2573
            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
  2574
            apply(simp)
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
        qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2577
      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
  2578
        "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
  2579
        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
  2580
        (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
  2581
        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
  2582
      from g have 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2583
        "\<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
  2584
        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
  2585
        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
  2586
         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
  2587
         done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2588
       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
  2589
         "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
  2590
         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
  2591
         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
  2592
         by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2593
       from stp1 and stp2 and h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2594
       show "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2595
         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
  2596
         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
  2597
         (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
  2598
         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
  2599
         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
  2600
           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
  2601
         done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2602
     next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2603
       fix ab m n rs args lm
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2604
       assume ind2:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2605
         "\<And> m n rs args lm.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2606
         \<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
  2607
         \<Longrightarrow> \<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2608
         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
  2609
         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
  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]>) + 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
  2612
         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
  2613
       show "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2614
         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
  2615
         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
  2616
         (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
  2617
         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
  2618
       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
  2619
         have "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2620
           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
  2621
           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
  2622
           = (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
  2623
           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
  2624
           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
  2625
                                      rs n]
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2626
           apply(simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2627
           done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2628
         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
  2629
           "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
  2630
           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
  2631
           = (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
  2632
           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
  2633
         from k have 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2634
           "\<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
  2635
           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
  2636
           = (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
  2637
           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
  2638
           apply(rule_tac ind2, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2639
           done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2640
         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
  2641
           "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
  2642
           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
  2643
           = (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
  2644
           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
  2645
           by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2646
         from stp1 and stp2 show 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2647
           "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2648
           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
  2649
           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
  2650
           (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
  2651
           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
  2652
           @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2653
           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
  2654
             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
  2655
           done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2656
       qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2657
     qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2658
   qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2659
 qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2660
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2661
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2662
definition t_wcode_prepare :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2663
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2664
  "t_wcode_prepare \<equiv> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2665
         [(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
  2666
          (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
  2667
          (W1, 7), (L, 0)]"
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_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
  2670
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2671
  "wprepare_add_one m lm (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2672
      (\<exists> rn. l = [] \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2673
               (r = <m # lm> @ Bk\<up>(rn) \<or> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2674
                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
  2675
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2676
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
  2677
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2678
  "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
  2679
      (\<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
  2680
                      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
  2681
                      ml + mr = Suc (Suc m))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2682
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2683
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
  2684
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2685
  "wprepare_erase m lm (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2686
     (\<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
  2687
               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
  2688
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2689
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
  2690
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2691
  "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
  2692
     (\<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
  2693
               r = Bk # <lm> @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2694
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2695
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
  2696
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2697
  "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
  2698
     (\<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
  2699
               r = <lm> @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2700
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2701
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
  2702
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2703
  "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
  2704
       (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
  2705
        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
  2706
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2707
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
  2708
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2709
  "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
  2710
     (\<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
  2711
                       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
  2712
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2713
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
  2714
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2715
  "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
  2716
     (\<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
  2717
  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
  2718
  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
  2719
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2720
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
  2721
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2722
  "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
  2723
                                      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
  2724
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2725
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
  2726
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2727
  "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
  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\<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_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
  2732
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2733
  "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
  2734
     (\<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
  2735
  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
  2736
                     (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
  2737
                     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
  2738
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2739
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
  2740
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2741
  "wprepare_loop_goon m lm (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2742
              (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
  2743
               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
  2744
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2745
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
  2746
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2747
  "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
  2748
          (\<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
  2749
               (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
  2750
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2751
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
  2752
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2753
  "wprepare_stop m lm (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2754
         (\<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
  2755
               r = Bk # Oc # Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2756
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2757
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
  2758
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2759
  "wprepare_inv st m lm (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2760
        (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
  2761
         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
  2762
         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
  2763
         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
  2764
         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
  2765
         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
  2766
         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
  2767
         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
  2768
         else False)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2769
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2770
fun wprepare_stage :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2771
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2772
  "wprepare_stage (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2773
      (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
  2774
       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
  2775
       else 1)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2776
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2777
fun wprepare_state :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2778
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2779
  "wprepare_state (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2780
       (if st = 1 then 4
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2781
        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
  2782
        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
  2783
        else if st = 4 then 1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2784
        else if st = 7 then 2
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2785
        else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2786
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2787
fun wprepare_step :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2788
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2789
  "wprepare_step (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2790
      (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
  2791
                       else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2792
       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
  2793
       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
  2794
                            else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2795
       else if st = 4 then length r
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2796
       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
  2797
       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
  2798
       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
  2799
                            else 1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2800
       else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2801
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2802
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
  2803
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2804
  "wcode_prepare_measure (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2805
     (wprepare_stage (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2806
      wprepare_state (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2807
      wprepare_step (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2808
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2809
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
  2810
  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
  2811
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2812
lemma [intro]: "wf lex_pair"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2813
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
  2814
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2815
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
  2816
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
  2817
           lex_triple_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2818
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2819
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
  2820
        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
  2821
        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
  2822
        wprepare_add_one2.simps[simp del]
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
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
  2825
        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
  2826
        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
  2827
        wprepare_add_one2.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2828
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2829
declare wprepare_inv.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2830
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
  2831
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
  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 (Suc 0) Oc = (L, 1)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2835
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
  2836
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2837
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2838
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
  2839
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
  2840
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2841
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2842
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
  2843
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
  2844
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2845
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2846
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
  2847
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
  2848
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2849
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2850
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
  2851
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
  2852
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2853
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2854
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
  2855
apply(subgoal_tac "4 = Suc 3")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2856
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
  2857
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2858
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2859
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2860
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
  2861
apply(subgoal_tac "4 = Suc 3")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2862
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
  2863
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2864
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2865
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2866
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2867
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
  2868
apply(subgoal_tac "5 = Suc 4")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2869
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
  2870
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2871
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2872
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2873
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
  2874
apply(subgoal_tac "5 = Suc 4")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2875
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
  2876
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2877
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2878
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2879
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
  2880
apply(subgoal_tac "6 = Suc 5")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2881
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
  2882
apply(auto)
130
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]: "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
  2886
apply(subgoal_tac "6 = Suc 5")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2887
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
  2888
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2889
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2890
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2891
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
  2892
apply(subgoal_tac "7 = Suc 6")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2893
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
  2894
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2895
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2896
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2897
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
  2898
apply(subgoal_tac "7 = Suc 6")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2899
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
  2900
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2901
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2902
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2903
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
  2904
apply(simp add: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2905
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2906
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2907
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
  2908
apply(simp add: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2909
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2910
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2911
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
  2912
apply(simp add: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2913
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2914
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2915
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
  2916
apply(simp add: wprepare_invs)
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]: "\<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
  2920
apply(simp add: wprepare_invs)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2921
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2922
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2923
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
  2924
by auto
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2925
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2926
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
  2927
                                  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
  2928
apply(simp only: wprepare_invs)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2929
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2930
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2931
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
  2932
                wprepare_loop_goon_on_rightmost.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2933
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
  2934
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2935
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2936
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
  2937
apply(simp only: wprepare_invs, auto)
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]:"\<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
  2941
  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
  2942
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
  2943
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2944
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2945
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
  2946
apply(simp only: wprepare_invs, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2947
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2948
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2949
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
  2950
apply(simp only: wprepare_invs, 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]: "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
  2954
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
  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]: "\<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
  2958
       \<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
  2959
           (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
  2960
apply(simp only: wprepare_invs)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2961
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
  2962
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
  2963
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
  2964
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2965
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2966
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
  2967
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
  2968
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2969
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2970
declare replicate_Suc[simp]
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2971
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2972
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
  2973
                          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
  2974
apply(simp only: wprepare_invs, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2975
apply(case_tac mr, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2976
apply(case_tac mr, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2977
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2978
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2979
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
  2980
apply(simp only: wprepare_invs, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2981
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2982
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2983
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
  2984
                           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
  2985
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2986
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2987
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2988
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
  2989
apply(simp only: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2990
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
  2991
                         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
  2992
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2993
    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2994
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
  2995
apply(simp only: wprepare_invs, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2996
apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2997
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2998
     
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2999
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
  3000
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3001
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3002
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3003
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
  3004
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3005
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3006
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3007
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
  3008
apply(simp only: wprepare_invs, auto)
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]: "\<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
  3012
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3013
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
  3014
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
  3015
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3016
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3017
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
  3018
apply(simp only: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3019
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3020
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3021
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3022
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
  3023
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3024
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3025
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3026
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
  3027
  (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
  3028
  (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
  3029
apply(simp only: wprepare_invs, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3030
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
  3031
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
  3032
apply(case_tac mr, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3033
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
  3034
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
  3035
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3036
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3037
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
  3038
apply(simp only: wprepare_invs, simp)
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]: "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
  3042
      (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
  3043
      (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
  3044
apply(simp only:  wprepare_invs, auto)
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_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
  3048
       \<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
  3049
           (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
  3050
apply(simp only:  wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3051
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
  3052
apply(case_tac mr, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3053
apply(case_tac ml, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3054
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
  3055
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
  3056
done
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 [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
  3059
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
  3060
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3061
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3062
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
  3063
  \<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
  3064
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
  3065
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3066
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3067
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
  3068
       \<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
  3069
apply(simp only:wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3070
apply(case_tac [!] lm, simp, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3071
done
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
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
  3074
apply(simp only:wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3075
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3076
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
  3077
apply(case_tac mr, simp_all)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3078
apply(case_tac rn, simp_all)
130
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 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
  3082
by simp
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3083
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3084
lemma tape_of_nl_false1:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3085
  "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
  3086
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3087
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
  3088
apply(case_tac "rev lm")
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3089
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
  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_in_middle m lm (b, [Bk]) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3093
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
  3094
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
  3095
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3096
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3097
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
  3098
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3099
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
  3100
        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
  3101
        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
  3102
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3103
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
  3104
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
  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 m lm (b, [Bk])\<rbrakk> \<Longrightarrow>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3108
  wprepare_loop_goon m lm (Bk # b, [])"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3109
apply(simp only: wprepare_invs, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3110
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
  3111
  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
  3112
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
  3113
apply(rule_tac rev_eq)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3114
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
  3115
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
  3116
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3117
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3118
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
  3119
 \<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
  3120
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
  3121
                 wprepare_loop_goon_in_middle.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3122
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3123
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3124
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
  3125
    \<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
  3126
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
  3127
                 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
  3128
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
  3129
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
  3130
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
  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_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
  3134
  \<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
  3135
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
  3136
                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
  3137
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
  3138
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
  3139
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
  3140
apply(case_tac [!] rna, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3141
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
  3142
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
  3143
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
  3144
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3145
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3146
lemma [simp]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3147
  "\<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
  3148
  \<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
  3149
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
  3150
               wprepare_loop_goon_in_middle.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3151
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
  3152
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
  3153
apply(case_tac lm1, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3154
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
  3155
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
  3156
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
  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]: "\<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
  3160
  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
  3161
apply(simp add: wprepare_loop_start.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3162
                wprepare_loop_goon.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3163
apply(erule_tac disjE, simp, auto)
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 start_2_goon:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3167
  "\<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
  3168
   (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
  3169
  (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
  3170
apply(case_tac list, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3171
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3172
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3173
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
  3174
  \<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
  3175
                     (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
  3176
  (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
  3177
                 (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
  3178
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
  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_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
  3182
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3183
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3184
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3185
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
  3186
  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
  3187
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
  3188
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
  3189
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
  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_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
  3193
                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
  3194
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
  3195
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
  3196
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
  3197
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
  3198
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
  3199
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3200
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3201
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
  3202
       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
  3203
apply(simp add: wprepare_loop_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3204
apply(erule_tac disjE, simp_all )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3205
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3206
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3207
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
  3208
apply(simp add: wprepare_loop_goon.simps     
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3209
                wprepare_loop_goon_in_middle.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3210
                wprepare_loop_goon_on_rightmost.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3211
apply(auto)
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_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
  3215
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
  3216
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3217
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3218
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
  3219
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
  3220
done
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3221
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3222
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
  3223
         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
  3224
       \<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
  3225
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
  3226
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
  3227
apply(case_tac mr, simp, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3228
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3229
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3230
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
  3231
                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
  3232
       \<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
  3233
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
  3234
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
  3235
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
  3236
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
  3237
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
  3238
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3239
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3240
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
  3241
                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
  3242
                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
  3243
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
  3244
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
  3245
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3246
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3247
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
  3248
  \<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
  3249
apply(simp add: wprepare_loop_goon.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3250
                wprepare_loop_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3251
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3252
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3253
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
  3254
       \<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
  3255
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3256
apply(simp add: wprepare_add_one.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3257
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3258
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3259
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
  3260
              \<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
  3261
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
  3262
                 wprepare_loop_start_on_rightmost.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3263
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
  3264
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
  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
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
  3268
       \<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
  3269
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
  3270
                 wprepare_loop_start_in_middle.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3271
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
  3272
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
  3273
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
  3274
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
  3275
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3276
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3277
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
  3278
       \<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
  3279
apply(case_tac lm, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3280
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
  3281
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3282
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3283
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
  3284
apply(auto simp: wprepare_add_one2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3285
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3286
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3287
lemma add_one_2_stop:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3288
  "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
  3289
  \<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
  3290
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
  3291
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3292
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3293
declare wprepare_stop.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3294
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3295
lemma wprepare_correctness:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3296
  assumes h: "lm \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3297
  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
  3298
  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
  3299
  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
  3300
    \<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
  3301
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3302
  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
  3303
  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
  3304
  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
  3305
  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
  3306
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3307
    show "wf wcode_prepare_le" by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3308
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3309
    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
  3310
                 ?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
  3311
      using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3312
      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
  3313
            simp add: step_red step.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3314
      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
  3315
      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
  3316
                 split: if_splits)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3317
      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
  3318
                           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
  3319
      apply(auto simp: wprepare_add_one2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3320
      done   
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3321
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3322
    show "?Q (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3323
      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
  3324
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3325
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3326
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3327
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3328
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3329
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3330
  thus "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3331
    apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3332
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3333
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3334
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3335
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
  3336
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
  3337
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3338
   
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3339
lemma t_correct_shift:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3340
         "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
  3341
          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
  3342
apply(auto simp: List.list_all_length)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3343
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
  3344
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
  3345
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3346
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3347
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
  3348
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
  3349
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3350
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3351
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
  3352
  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
  3353
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
  3354
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3355
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3356
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3357
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3358
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
  3359
      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
  3360
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
  3361
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
  3362
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
  3363
by (metis in_set_conv_nth)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3364
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3365
lemma tm_wf_shift:
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3366
         "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
  3367
          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
  3368
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
  3369
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
  3370
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
  3371
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3372
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3373
declare length_tp'[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3374
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3375
lemma [simp]: "length (mopup (Suc 0)) = 16"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3376
apply(auto simp: mopup.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3377
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3378
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3379
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
  3380
  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
  3381
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
  3382
proof -
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3383
  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
  3384
  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
  3385
  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
  3386
  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
  3387
    (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
  3388
  proof(auto simp: mod_ex1)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3389
    fix q qa
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3390
    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
  3391
    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
  3392
    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
  3393
      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
  3394
        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
  3395
      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
  3396
        using h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3397
        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
  3398
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3399
    qed
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3400
    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
  3401
      by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3402
  qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3403
  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
  3404
    using g
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3405
    apply(auto simp:t_twice_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3406
    apply(simp add: Ball_set[THEN sym])
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3407
    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
  3408
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3409
qed 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3410
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3411
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
  3412
  \<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
  3413
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
  3414
proof -
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3415
  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
  3416
    (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
  3417
  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
  3418
  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
  3419
  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
  3420
    (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
  3421
    (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
  3422
  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
  3423
    fix q qa
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3424
    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
  3425
    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
  3426
      (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
  3427
    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
  3428
      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
  3429
        (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
  3430
        apply(rule_tac tm_wf_change_termi)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3431
        using wf_fourtimes h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3432
        apply(simp add: t_fourtimes_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3433
        done        
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3434
      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
  3435
        using h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3436
        apply(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3437
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3438
    qed
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 145
diff changeset
  3439
    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
  3440
      apply(subgoal_tac "qa + q = q + qa")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3441
      apply(simp, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3442
      done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3443
  qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3444
  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
  3445
    using g
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3446
    apply(simp add: Ball_set[THEN sym])
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3447
    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
  3448
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3449
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3450
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3451
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
  3452
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
  3453
                 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
  3454
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3455
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3456
declare tm_comp.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3457
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
  3458
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
  3459
                 tm_comp.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3460
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3461
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3462
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
  3463
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
  3464
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3465
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3466
lemma prepare_mainpart_lemma:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3467
  "args \<noteq> [] \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3468
  \<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
  3469
              = (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
  3470
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3471
  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
  3472
  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
  3473
  let ?P2 = ?Q1
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3474
  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
  3475
                           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
  3476
  let ?P3 = "\<lambda> tp. False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3477
  assume h: "args \<noteq> []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3478
  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
  3479
  proof(rule_tac Hoare_plus_halt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3480
    show "{?P1} t_wcode_prepare {?Q1}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3481
    proof(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3482
      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
  3483
        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
  3484
        using wprepare_correctness[of args m] h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3485
        apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3486
        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
  3487
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3488
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3489
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3490
    show "{?P2} t_wcode_main {?Q2}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3491
    proof(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3492
      fix l r
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3493
      assume "wprepare_stop m args (l, r)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3494
      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
  3495
              (\<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
  3496
        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
  3497
      proof(auto simp: wprepare_stop.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3498
        fix rn
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3499
        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
  3500
          (\<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
  3501
          (\<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
  3502
          Bk # Bk # Oc \<up> bl_bin (<args>) @
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3503
          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
  3504
          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
  3505
          apply(auto simp: tape_of_nl_rev)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3506
          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
  3507
          done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3508
      qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3509
    qed
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3510
  next
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3511
    show "tm_wf0 t_wcode_prepare"
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3512
      by auto
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3513
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3514
  thus "?thesis"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3515
    apply(auto simp: Hoare_halt_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3516
    apply(rule_tac x = n in exI)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3517
    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
  3518
      (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
  3519
    apply(auto simp: tm_comp.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3520
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3521
qed
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3522
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3523
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
  3524
  where
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3525
  "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
  3526
   
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3527
lemma [simp]:  "tinres r r' \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3528
  fetch t ss (read r) = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3529
  fetch t ss (read r')"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3530
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
  3531
apply(case_tac [!] n, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3532
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3533
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3534
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
  3535
by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3536
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3537
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
  3538
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3539
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3540
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3541
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
  3542
apply(simp add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3543
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3544
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3545
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
  3546
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3547
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3548
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3549
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
  3550
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3551
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3552
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3553
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
  3554
apply(case_tac r, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3555
apply(case_tac n, simp, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3556
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
  3557
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
  3558
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3559
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3560
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
  3561
apply(auto simp: tinres_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3562
apply(case_tac r', simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3563
apply(case_tac n, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3564
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
  3565
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
  3566
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3567
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3568
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
  3569
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
  3570
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
  3571
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
  3572
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3573
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3574
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
  3575
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
  3576
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
  3577
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
  3578
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3579
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3580
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
  3581
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3582
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3583
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3584
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
  3585
apply(auto simp: tinres_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3586
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3587
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3588
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
  3589
apply(auto simp: tinres_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3590
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3591
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3592
lemma tinres_step2: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3593
  "\<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
  3594
    \<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
  3595
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
  3596
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
  3597
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
  3598
apply(auto simp: update.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3599
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
  3600
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3601
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3602
lemma tinres_steps2: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3603
  "\<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
  3604
    \<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
  3605
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
  3606
apply(simp add: step_red)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3607
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
  3608
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
  3609
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3610
  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
  3611
  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
  3612
    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
  3613
  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
  3614
         "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
  3615
         "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
  3616
  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
  3617
    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
  3618
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3619
  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
  3620
    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
  3621
            and t = t in tinres_step2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3622
    using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3623
    apply(simp, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3624
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3625
qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3626
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3627
definition t_wcode_adjust :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3628
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3629
  "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
  3630
                   (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
  3631
                   (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
  3632
                    (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
  3633
                 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3634
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
  3635
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
  3636
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3637
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3638
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
  3639
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
  3640
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3641
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3642
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
  3643
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
  3644
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3645
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3646
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
  3647
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
  3648
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3649
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3650
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
  3651
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
  3652
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3653
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  3654
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
  3655
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
  3656
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3657
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  3658
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
  3659
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
  3660
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3661
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3662
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
  3663
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
  3664
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3665
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3666
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
  3667
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
  3668
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3669
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3670
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
  3671
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
  3672
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3673
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3674
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
  3675
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
  3676
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3677
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3678
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
  3679
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
  3680
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3681
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3682
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
  3683
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
  3684
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3685
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3686
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
  3687
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
  3688
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3689
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3690
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
  3691
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
  3692
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3693
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3694
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
  3695
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
  3696
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3697
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3698
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
  3699
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
  3700
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3701
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3702
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
  3703
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
  3704
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3705
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3706
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
  3707
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
  3708
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3709
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3710
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
  3711
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
  3712
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3713
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3714
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
  3715
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3716
  "wadjust_start m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3717
         (\<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
  3718
                   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
  3719
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3720
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
  3721
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3722
  "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
  3723
          (\<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
  3724
                          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
  3725
                          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
  3726
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3727
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
  3728
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3729
  "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
  3730
   (\<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
  3731
                      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
  3732
                      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
  3733
                      nl + nr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3734
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3735
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
  3736
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3737
  "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
  3738
  (\<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
  3739
                  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
  3740
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3741
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
  3742
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3743
  "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
  3744
    (\<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
  3745
                    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
  3746
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3747
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
  3748
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3749
  "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
  3750
      (\<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
  3751
                      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
  3752
                      ml + mr = Suc rs \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3753
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3754
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
  3755
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3756
  "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
  3757
      (\<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
  3758
                         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
  3759
                         ml + mr = Suc rs \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3760
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3761
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
  3762
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3763
  "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
  3764
       (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
  3765
       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
  3766
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3767
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
  3768
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3769
  "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
  3770
        (\<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
  3771
                        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
  3772
                        ml + mr = Suc rs \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3773
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3774
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
  3775
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3776
  "wadjust_erase2 m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3777
     (\<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
  3778
                     tl r = Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3779
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3780
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
  3781
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3782
  "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
  3783
        (\<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
  3784
                  r = Oc # Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3785
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3786
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
  3787
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3788
  "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
  3789
         (\<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
  3790
                   r = Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3791
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3792
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
  3793
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3794
  "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
  3795
      (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
  3796
       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
  3797
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3798
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
  3799
  where 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3800
  "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
  3801
        (\<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
  3802
               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
  3803
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3804
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
  3805
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3806
  "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
  3807
      (\<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
  3808
                      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
  3809
                      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
  3810
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3811
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
  3812
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3813
  "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
  3814
            (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
  3815
             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
  3816
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3817
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
  3818
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3819
  "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
  3820
        (\<exists> rn. l = [] \<and> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3821
               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
  3822
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3823
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
  3824
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3825
  "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
  3826
      (\<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
  3827
                      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
  3828
                      ml + mr = Suc m \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3829
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3830
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
  3831
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3832
  "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
  3833
        (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
  3834
        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
  3835
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3836
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
  3837
where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3838
  "wadjust_stop m rs (l, r) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3839
        (\<exists> rn. l = [Bk] \<and> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3840
               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
  3841
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3842
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
  3843
        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
  3844
        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
  3845
        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
  3846
        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
  3847
        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
  3848
        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
  3849
        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
  3850
        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
  3851
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3852
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
  3853
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3854
  "wadjust_inv st m rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3855
       (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
  3856
        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
  3857
        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
  3858
        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
  3859
        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
  3860
        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
  3861
        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
  3862
        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
  3863
        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
  3864
        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
  3865
        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
  3866
        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
  3867
        else False
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3868
)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3869
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3870
declare wadjust_inv.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3871
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3872
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
  3873
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3874
  "wadjust_phase rs (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3875
         (if st = 1 then 3 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3876
          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
  3877
          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
  3878
          else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3879
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3880
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
  3881
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3882
  "wadjust_stage rs (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3883
           (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
  3884
                  rs - length (takeWhile (\<lambda> a. a = Oc) 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3885
                          (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
  3886
            else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3887
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3888
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
  3889
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3890
  "wadjust_state rs (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3891
       (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
  3892
        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
  3893
        else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3894
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3895
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
  3896
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3897
  "wadjust_step rs (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3898
       (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
  3899
                        else 0) 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3900
        else if st = 3 then length r
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3901
        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
  3902
                             else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3903
        else if st = 6 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3904
        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
  3905
                             else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3906
        else if st = 9 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3907
        else if st = 10 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3908
        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
  3909
                              else Suc (length l))
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3910
        else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3911
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3912
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
  3913
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3914
  "wadjust_measure (rs, (st, l, r)) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3915
     (wadjust_phase rs (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3916
      wadjust_stage rs (st, l, r),
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3917
      wadjust_state rs (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3918
      wadjust_step rs (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3919
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3920
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
  3921
  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
  3922
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3923
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
  3924
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
  3925
  Abacus.lex_triple_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3926
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3927
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
  3928
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
  3929
           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
  3930
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3931
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
  3932
apply(auto simp: wadjust_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3933
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3934
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3935
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
  3936
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
  3937
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3938
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3939
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
  3940
        \<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
  3941
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
  3942
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3943
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3944
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3945
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
  3946
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
  3947
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3948
 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3949
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
  3950
apply(simp add: wadjust_loop_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3951
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3952
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3953
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
  3954
  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
  3955
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
  3956
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3957
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3958
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3959
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3960
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
  3961
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
  3962
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3963
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3964
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
  3965
    \<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
  3966
        (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
  3967
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
  3968
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3969
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3970
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
  3971
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
  3972
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3973
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3974
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3975
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
  3976
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
  3977
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3978
   
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3979
lemma [simp]: "wadjust_erase2 m rs ([], []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3980
apply(auto simp: wadjust_erase2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3981
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3982
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3983
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
  3984
                 (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
  3985
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
  3986
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3987
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3988
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
  3989
                 (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
  3990
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
  3991
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
  3992
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3993
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3994
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
  3995
            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
  3996
apply(simp only: wadjust_erase2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3997
apply(erule_tac exE)+
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3998
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
  3999
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4000
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4001
lemma [simp]: "wadjust_erase2 m rs (c, [])
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4002
    \<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
  4003
       (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
  4004
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4005
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4006
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4007
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
  4008
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
  4009
  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
  4010
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4011
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4012
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
  4013
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
  4014
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4015
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4016
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
  4017
                                      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
  4018
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
  4019
apply(case_tac [!] ln, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4020
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4021
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4022
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
  4023
                                  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
  4024
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
  4025
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
  4026
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4027
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4028
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
  4029
  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
  4030
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
  4031
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4032
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4033
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4034
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
  4035
    \<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
  4036
       (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
  4037
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4038
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4039
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4040
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
  4041
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
  4042
                 wadjust_goon_left_moving_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4043
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4044
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4045
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
  4046
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
  4047
 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
  4048
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4049
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4050
lemma [simp]:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4051
  "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
  4052
  (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
  4053
  (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
  4054
apply(auto simp: wadjust_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4055
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4056
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4057
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
  4058
apply(auto simp: wadjust_loop_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4059
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4060
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4061
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
  4062
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
  4063
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4064
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4065
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
  4066
    \<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
  4067
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
  4068
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4069
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
  4070
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
  4071
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
  4072
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
  4073
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
  4074
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4075
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4076
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
  4077
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
  4078
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4079
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4080
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
  4081
              \<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
  4082
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
  4083
apply(case_tac [!] mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4084
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4085
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4086
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
  4087
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
  4088
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4089
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4090
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
  4091
        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
  4092
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4093
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
  4094
    \<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
  4095
apply(simp only: wadjust_loop_erase.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4096
  wadjust_loop_on_left_moving_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4097
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4098
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
  4099
      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
  4100
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
  4101
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
  4102
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4103
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4104
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
  4105
             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
  4106
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
  4107
       auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4108
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
  4109
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4110
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4111
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
  4112
                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
  4113
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
  4114
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4115
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4116
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
  4117
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
  4118
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
  4119
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4120
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4121
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
  4122
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
  4123
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4124
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4125
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
  4126
    \<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
  4127
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
  4128
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4129
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
  4130
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
  4131
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
  4132
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4133
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4134
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
  4135
    \<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
  4136
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
  4137
                 wadjust_loop_on_left_moving_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4138
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4139
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
  4140
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
  4141
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4142
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4143
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
  4144
            \<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
  4145
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
  4146
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4147
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4148
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4149
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
  4150
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
  4151
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4152
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4153
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
  4154
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
  4155
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
  4156
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
  4157
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
  4158
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
  4159
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
  4160
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
  4161
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
  4162
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4163
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4164
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
  4165
apply(auto simp:wadjust_erase2.simps )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4166
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4167
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4168
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
  4169
                 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
  4170
apply(auto simp: wadjust_erase2.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4171
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
  4172
        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
  4173
apply(auto)
131
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: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4175
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
  4176
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
  4177
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4178
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4179
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
  4180
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
  4181
                wadjust_on_left_moving_O.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4182
                wadjust_on_left_moving_B.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4183
             , auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4184
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4185
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4186
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
  4187
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
  4188
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4189
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4190
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
  4191
    \<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
  4192
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
  4193
apply(case_tac ln, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4194
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4195
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4196
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
  4197
    \<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
  4198
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
  4199
                 wadjust_on_left_moving_B.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4200
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
  4201
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4202
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4203
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
  4204
                  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
  4205
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
  4206
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4207
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4208
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4209
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
  4210
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
  4211
                wadjust_goon_left_moving_B.simps
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4212
                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
  4213
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4214
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4215
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
  4216
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
  4217
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
  4218
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4219
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4220
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
  4221
    \<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
  4222
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
  4223
                 wadjust_backto_standard_pos_B.simps )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4224
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4225
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4226
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
  4227
    \<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
  4228
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
  4229
                 wadjust_backto_standard_pos_O.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4230
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4231
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4232
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
  4233
  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
  4234
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
  4235
                                     wadjust_goon_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4236
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4237
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4238
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
  4239
  (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
  4240
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
  4241
                 wadjust_backto_standard_pos_B.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4242
                 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
  4243
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
  4244
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4245
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4246
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
  4247
              \<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
  4248
                (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
  4249
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
  4250
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
  4251
      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
  4252
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4253
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4254
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
  4255
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
  4256
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4257
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4258
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
  4259
              \<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
  4260
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
  4261
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
  4262
      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
  4263
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
  4264
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4265
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4266
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
  4267
                       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
  4268
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
  4269
                 wadjust_loop_check.simps, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4270
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
  4271
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
  4272
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
  4273
apply(case_tac [!] nr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4274
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4275
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4276
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
  4277
               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
  4278
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
  4279
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4280
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
  4281
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
  4282
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4283
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4284
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
  4285
                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
  4286
apply(auto simp: wadjust_loop_erase.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4287
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4288
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4289
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
  4290
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
  4291
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
  4292
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4293
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4294
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
  4295
           \<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
  4296
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
  4297
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
  4298
                 wadjust_loop_right_move2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4299
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4300
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4301
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
  4302
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
  4303
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
  4304
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4305
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4306
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
  4307
              \<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
  4308
               \<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
  4309
apply(auto simp: wadjust_erase2.simps )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4310
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4311
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4312
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
  4313
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
  4314
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4315
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4316
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
  4317
         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
  4318
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
  4319
     wadjust_goon_left_moving_B.simps )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4320
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4321
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4322
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
  4323
    \<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
  4324
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
  4325
                 wadjust_goon_left_moving_O.simps )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4326
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
  4327
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4328
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4329
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4330
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
  4331
              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
  4332
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
  4333
                 wadjust_goon_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4334
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4335
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4336
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4337
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
  4338
  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
  4339
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
  4340
  wadjust_goon_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4341
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4342
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4343
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4344
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
  4345
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
  4346
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4347
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4348
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
  4349
               \<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
  4350
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
  4351
apply(case_tac [!] ml, auto simp: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4352
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4353
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4354
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
  4355
  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
  4356
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
  4357
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
  4358
apply(case_tac ml, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4359
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
  4360
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4361
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4362
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
  4363
  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
  4364
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
  4365
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4366
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4367
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4368
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
  4369
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
  4370
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4371
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4372
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
  4373
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
  4374
apply(case_tac mr, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4375
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4376
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4377
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
  4378
  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
  4379
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
  4380
                 wadjust_backto_standard_pos_B.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4381
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4382
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4383
lemma [simp]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4384
  "\<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
  4385
  \<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
  4386
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
  4387
        wadjust_backto_standard_pos_B.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4388
done 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4389
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4390
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
  4391
          \<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
  4392
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
  4393
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
  4394
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4395
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4396
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
  4397
  \<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
  4398
 (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
  4399
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
  4400
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4401
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4402
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4403
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
  4404
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
  4405
apply(rule_tac iffI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4406
apply(erule_tac exE)+
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4407
apply(case_tac nr, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4408
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
  4409
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4410
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4411
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
  4412
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
  4413
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4414
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4415
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
  4416
  \<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
  4417
  < 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
  4418
  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
  4419
  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
  4420
apply(simp only: wadjust_loop_erase.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4421
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4422
apply(case_tac c, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4423
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4424
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4425
lemma [simp]:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4426
  "\<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
  4427
  \<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
  4428
  < 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
  4429
  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
  4430
  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
  4431
apply(subgoal_tac "c \<noteq> []")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4432
apply(case_tac c, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4433
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4434
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4435
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
  4436
apply(induct n, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4437
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4438
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
  4439
apply(induct n, simp_all add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4440
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4441
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4442
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
  4443
              \<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
  4444
                 < 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
  4445
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
  4446
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
  4447
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
  4448
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4449
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4450
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
  4451
apply(simp add: wadjust_loop_check.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4452
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4453
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4454
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
  4455
  \<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
  4456
  < 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
  4457
  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
  4458
  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
  4459
apply(case_tac "c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4460
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4461
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4462
lemma [simp]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4463
  "\<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
  4464
  \<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
  4465
  < 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
  4466
  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
  4467
  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
  4468
apply(simp add: wadjust_loop_erase.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4469
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4470
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4471
apply(simp add: dropWhile_exp1 takeWhile_exp1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4472
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4473
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4474
declare numeral_2_eq_2[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4475
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4476
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
  4477
       \<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
  4478
apply(auto simp: wadjust_start.simps)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4479
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4480
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4481
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
  4482
       \<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
  4483
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
  4484
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
  4485
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4486
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4487
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
  4488
       \<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
  4489
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
  4490
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
  4491
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
  4492
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
  4493
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4494
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4495
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
  4496
       \<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
  4497
apply(auto simp: wadjust_erase2.simps)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4498
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4499
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4500
lemma wadjust_correctness:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4501
  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
  4502
  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
  4503
  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
  4504
                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
  4505
    \<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
  4506
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4507
  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
  4508
  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
  4509
  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
  4510
                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
  4511
  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
  4512
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4513
    show "wf wadjust_le" by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4514
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4515
    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
  4516
                 ?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
  4517
      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
  4518
      apply(simp add: step.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4519
      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
  4520
      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
  4521
      apply(simp_all)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4522
      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
  4523
            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
  4524
      done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4525
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4526
    show "?Q (?f 0)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4527
      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
  4528
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4529
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4530
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4531
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4532
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4533
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4534
  thus"?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4535
    apply(simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4536
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4537
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4538
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4539
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
  4540
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
  4541
done
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
declare tm_comp.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4544
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4545
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
  4546
apply(case_tac args)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4547
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
  4548
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4549
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4550
lemma wcode_lemma_pre':
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4551
  "args \<noteq> [] \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4552
  \<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
  4553
              ((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
  4554
  = (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
  4555
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4556
  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
  4557
  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
  4558
    (\<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
  4559
  let ?P2 = ?Q1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4560
  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
  4561
  let ?P3 = "\<lambda> tp. False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4562
  assume h: "args \<noteq> []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4563
  hence a: "bl_bin (<args>) > 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4564
    using h by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4565
  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
  4566
  proof(rule_tac Hoare_plus_halt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4567
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4568
    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
  4569
      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
  4570
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4571
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4572
    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
  4573
    proof(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4574
      show 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4575
        "\<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
  4576
        (\<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
  4577
        (\<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
  4578
        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
  4579
        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
  4580
        apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4581
        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
  4582
        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
  4583
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4584
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4585
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4586
    show "{?P2} t_wcode_adjust {?Q2}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4587
    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
  4588
      fix ln rn
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4589
      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
  4590
        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
  4591
        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
  4592
        (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
  4593
        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
  4594
        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
  4595
        apply(rule_tac x = n in exI)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4596
        using a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4597
        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
  4598
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4599
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4600
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4601
  thus "?thesis"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4602
    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
  4603
    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
  4604
      ((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
  4605
    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
  4606
    using a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4607
    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
  4608
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4609
qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4610
    
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4611
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4612
  The initialization TM @{text "t_wcode"}.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4613
  *}
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4614
definition t_wcode :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4615
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4616
  "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
  4617
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4618
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4619
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4620
  The correctness of @{text "t_wcode"}.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4621
  *}
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4622
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4623
lemma wcode_lemma_1:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4624
  "args \<noteq> [] \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4625
  \<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
  4626
              (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
  4627
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
  4628
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4629
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4630
lemma wcode_lemma: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4631
  "args \<noteq> [] \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4632
  \<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
  4633
              (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
  4634
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
  4635
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
  4636
done
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
section {* The universal TM *}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4639
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4640
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4641
  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
  4642
  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
  4643
  *}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4644
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4645
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4646
definition UTM :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4647
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4648
  "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
  4649
          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
  4650
          (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
  4651
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4652
definition F_aprog :: "abc_prog"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4653
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4654
  "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
  4655
                       aprog [+] dummy_abc (Suc (Suc 0)))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4656
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4657
definition F_tprog :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4658
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4659
  "F_tprog = tm_of (F_aprog)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4660
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4661
definition t_utm :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4662
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4663
  "t_utm \<equiv>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4664
     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
  4665
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4666
definition UTM_pre :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4667
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4668
  "UTM_pre = t_wcode |+| t_utm"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4669
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4670
lemma tinres_step1: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4671
  "\<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
  4672
                 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
  4673
    \<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
  4674
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
  4675
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
  4676
        split: if_splits )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4677
apply(case_tac [!] "t ! (2 * nat)", 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4678
     auto simp: tinres_def split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4679
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
  4680
apply(case_tac [!] "t ! (2 * nat)", 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4681
     auto simp: tinres_def split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4682
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
  4683
apply(case_tac [!] "t ! Suc (2 * nat)", 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4684
     auto simp: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4685
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
  4686
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4687
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4688
lemma tinres_steps1: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4689
  "\<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
  4690
                 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
  4691
    \<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
  4692
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
  4693
apply(simp add: step_red)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4694
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
  4695
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
  4696
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4697
  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
  4698
  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
  4699
          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
  4700
  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
  4701
         "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
  4702
         "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
  4703
  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
  4704
    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
  4705
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4706
  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
  4707
    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
  4708
            and t = t in tinres_step1)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4709
    using h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4710
    apply(simp, simp, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4711
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4712
qed
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
lemma [simp]: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4715
  "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
  4716
apply(auto simp: tinres_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4717
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
  4718
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
  4719
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
  4720
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
  4721
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
  4722
apply(simp only: exp_ind, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4723
apply(subgoal_tac "m = length la + nata")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4724
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
  4725
apply(drule_tac length_equal, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4726
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
  4727
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
  4728
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4729
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4730
lemma t_utm_halt_eq: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4731
  assumes tm_wf: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4732
  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
  4733
  and resutl: "0 < rs"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4734
  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
  4735
                                                (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
  4736
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4737
  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
  4738
    by (metis prod_cases3) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4739
  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
  4740
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4741
    apply(rule_tac F_correct, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4742
    done 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4743
  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
  4744
    (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
  4745
    = (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
  4746
  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
  4747
    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
  4748
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4749
    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
  4750
      using b by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4751
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4752
    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
  4753
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4754
    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
  4755
      by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4756
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4757
    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
  4758
      using a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4759
      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
  4760
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4761
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4762
  then obtain stp m l where 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4763
    "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
  4764
    (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
  4765
    = (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
  4766
  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
  4767
    (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
  4768
    = (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
  4769
  proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4770
    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
  4771
      (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
  4772
      (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
  4773
   moreover have "tinres [Bk, Bk] [Bk]"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4774
     apply(auto simp: tinres_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4775
     done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4776
    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
  4777
    (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
  4778
      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
  4779
    (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
  4780
      done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4781
    ultimately show "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4782
      apply(drule_tac tinres_steps1, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4783
      done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4784
  qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4785
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4786
    apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4787
    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
  4788
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4789
    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
  4790
    done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4791
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4792
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4793
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
  4794
apply(simp add: t_wcode_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4795
apply(rule_tac tm_wf_comp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4796
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
  4797
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4798
      
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4799
lemma [intro]: "tm_wf (t_utm, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4800
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
  4801
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
  4802
done 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4803
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4804
lemma UTM_halt_lemma_pre: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4805
  assumes wf_tm: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4806
  and result: "0 < rs"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4807
  and args: "args \<noteq> []"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4808
  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
  4809
  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
  4810
                                                (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
  4811
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4812
  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
  4813
  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
  4814
  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
  4815
    (\<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
  4816
  let ?P2 = ?Q1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4817
  let ?P3 = "\<lambda> (l, r). False"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4818
  have "{?P1} (t_wcode |+| t_utm) {?Q2}"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4819
  proof(rule_tac Hoare_plus_halt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4820
    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
  4821
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4822
    show "{?P1} t_wcode {?Q1}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4823
      apply(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4824
      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
  4825
      apply(auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4826
      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
  4827
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4828
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4829
    show "{?P2} t_utm {?Q2}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4830
    proof(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4831
      fix rn
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4832
      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
  4833
        (\<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
  4834
        (\<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
  4835
        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
  4836
        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
  4837
      apply(auto simp: bin_wc_eq)
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4838
      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
  4839
      done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4840
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4841
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4842
  thus "?thesis"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4843
    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
  4844
    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
  4845
    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
  4846
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4847
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4848
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4849
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4850
  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
  4851
*}
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4852
lemma UTM_halt_lemma': 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4853
  assumes tm_wf: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4854
  and result: "0 < rs"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4855
  and args: "args \<noteq> []"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4856
  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
  4857
  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
  4858
                                                (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
  4859
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
  4860
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
  4861
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
  4862
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4863
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4864
definition TSTD:: "config \<Rightarrow> bool"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4865
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4866
  "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
  4867
             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
  4868
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4869
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
  4870
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
  4871
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4872
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4873
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
  4874
apply(rule classical, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4875
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
  4876
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
  4877
  add: bl2nat.simps bl2nat_double)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4878
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
  4879
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
  4880
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4881
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4882
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
  4883
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
  4884
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4885
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4886
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
  4887
apply(induct x arbitrary: y, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4888
apply(case_tac y, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4889
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4890
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4891
declare replicate_Suc[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4892
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4893
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
  4894
apply(auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4895
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
  4896
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
  4897
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4898
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4899
lemma bl2wc_exp_ex: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4900
  "\<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
  4901
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
  4902
apply(case_tac a, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4903
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
  4904
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
  4905
  simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4906
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
  4907
apply(case_tac m, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4908
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4909
  fix c m nat
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4910
  assume ind: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4911
    "\<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
  4912
  and h: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4913
    "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
  4914
  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
  4915
    apply(rule_tac m = nat in ind)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4916
    using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4917
    apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4918
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4919
  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
  4920
  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
  4921
    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
  4922
    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
  4923
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4924
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4925
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4926
lemma lg_bin: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4927
  "\<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
  4928
  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
  4929
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
  4930
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
  4931
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
  4932
  erule_tac x = n in allE, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4933
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
  4934
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
  4935
  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
  4936
apply(simp add: bl2wc.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4937
apply(rule_tac x = rs in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4938
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
  4939
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4940
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4941
lemma nstd_case3: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4942
  "\<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
  4943
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
  4944
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4945
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
  4946
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4947
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4948
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
  4949
    \<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
  4950
  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
  4951
       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
  4952
  apply(simp add: TSTD_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4953
  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
  4954
  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
  4955
  apply(erule_tac nstd_case3)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4956
  done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4957
 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4958
lemma nonstop_t_uhalt_eq:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4959
  "\<lbrakk>tm_wf (tp, 0);
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4960
  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
  4961
  \<not> TSTD (a, b, c)\<rbrakk>
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4962
  \<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
  4963
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
  4964
apply(subgoal_tac 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4965
  "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
  4966
  trpl_code (a, b, c)", simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4967
apply(erule_tac NSTD_1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4968
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
  4969
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4970
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4971
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4972
lemma nonstop_true:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4973
  "\<lbrakk>tm_wf (tp, 0);
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4974
  \<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
  4975
  \<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
  4976
  ([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
  4977
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
  4978
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
  4979
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
  4980
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4981
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4982
declare ci_cn_para_eq[simp]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4983
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4984
lemma F_aprog_uhalt: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4985
  "\<lbrakk>tm_wf (tp,0); 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4986
    \<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
  4987
    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
  4988
  \<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
  4989
               @ 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
  4990
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
  4991
               ([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
  4992
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
  4993
  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
  4994
apply(simp add: ci_cn_para_eq)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4995
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
  4996
  ([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
  4997
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
  4998
              ([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
  4999
           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
  5000
          gs = "[Cn (Suc (Suc 0)) rec_conf 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5001
           ([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
  5002
           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
  5003
          cn_gi_uhalt)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5004
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
  5005
     simp add: ci_cn_para_eq)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5006
apply(case_tac "rec_ci rec_halt")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5007
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
  5008
  ([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
  5009
  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
  5010
  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
  5011
  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
  5012
  gc = cb in cn_gi_uhalt)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5013
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
  5014
  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
  5015
apply(simp only: rec_halt_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5016
apply(case_tac [!] "rec_ci ((rec_nonstop))")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5017
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
  5018
apply(case_tac j, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5019
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
  5020
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
  5021
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
  5022
  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
  5023
  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
  5024
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
  5025
apply(drule_tac  nonstop_true, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5026
apply(rule_tac allI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5027
apply(erule_tac x = y in allE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5028
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5029
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5030
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5031
lemma uabc_uhalt': 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5032
  "\<lbrakk>tm_wf (tp, 0);
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5033
  \<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
  5034
  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
  5035
  \<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
  5036
           \<Rightarrow>  ss < length ap"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5037
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
  5038
    and suflm = "[]" in F_aprog_uhalt, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5039
  fix stp a b
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5040
  assume h: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5041
    "\<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
  5042
    (ss, e) \<Rightarrow> ss < length ap"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5043
    "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
  5044
    "tm_wf (tp, 0)" 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5045
    "rec_ci rec_F = (ap, pos, md)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5046
  moreover have "ap \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5047
    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
  5048
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5049
  ultimately show "a < length ap"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5050
  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
  5051
  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
  5052
    fix aa ba
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5053
    assume g: "aa < length ap" 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5054
      "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
  5055
      "ap \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5056
    thus "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5057
      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
  5058
                                   "md - pos" ap stp aa ba] h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5059
      apply(simp)
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
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5062
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5063
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5064
lemma uabc_uhalt: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5065
  "\<lbrakk>tm_wf (tp, 0); 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5066
  \<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
  5067
  \<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
  5068
       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
  5069
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
  5070
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
  5071
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5072
  fix a b c
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5073
  assume 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5074
    "\<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
  5075
                                                   \<Rightarrow> ss < length a"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5076
    "rec_ci rec_F = (a, b, c)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5077
  thus 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5078
    "\<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
  5079
    (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
  5080
           ss < Suc (Suc (Suc (length a)))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5081
    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
  5082
      "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
  5083
    apply(simp)
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
qed
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 tutm_uhalt': 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5088
assumes tm_wf:  "tm_wf (tp,0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5089
  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
  5090
  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
  5091
apply(simp add: t_utm_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5092
proof(rule_tac compile_correct_unhalt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5093
  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
  5094
next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5095
  show "F_tprog = tm_of F_aprog"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5096
    by(simp add:  F_tprog_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5097
next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5098
  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
  5099
    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
  5100
next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5101
  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
  5102
next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5103
  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
  5104
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5105
    apply(erule_tac uabc_uhalt, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5106
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5107
qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5108
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5109
 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5110
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
  5111
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5112
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5113
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5114
lemma inres_tape:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5115
  "\<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
  5116
  tinres l l'; tinres r r'\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5117
  \<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
  5118
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
  5119
  fix aa ba ca
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5120
  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
  5121
            "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
  5122
            "tinres l l'" "tinres r r'"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5123
            "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
  5124
  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
  5125
    using h
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5126
    apply(rule_tac tinres_steps1, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5127
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5128
  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
  5129
    using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5130
    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
  5131
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5132
  ultimately show "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5133
    apply(auto intro: tinres_commute)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5134
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5135
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5136
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5137
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
  5138
      \<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
  5139
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
  5140
               <[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
  5141
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
  5142
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
  5143
apply(drule_tac inres_tape, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5144
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5145
apply(case_tac "m > Suc (Suc 0)")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5146
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
  5147
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
  5148
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
  5149
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
  5150
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5151
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5152
lemma tutm_uhalt: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5153
  "\<lbrakk>tm_wf (tp,0);
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5154
    \<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
  5155
  \<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
  5156
apply(rule_tac tape_normalize)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5157
apply(rule_tac tutm_uhalt', simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5158
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5159
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5160
lemma UTM_uhalt_lemma_pre:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5161
  assumes tm_wf: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5162
  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
  5163
  and args: "args \<noteq> []"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5164
  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
  5165
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5166
  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
  5167
  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
  5168
             (\<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
  5169
  let ?P2 = ?Q1
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5170
  have "{?P1} (t_wcode |+| t_utm) \<up>"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5171
  proof(rule_tac Hoare_plus_unhalt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5172
    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
  5173
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5174
    show "{?P1} t_wcode {?Q1}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  5175
      apply(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5176
      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
  5177
      apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5178
      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
  5179
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5180
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5181
    show "{?P2} t_utm \<up>"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  5182
    proof(rule_tac Hoare_unhaltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5183
      fix n rn
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5184
      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
  5185
      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
  5186
        using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5187
        apply(rule_tac tutm_uhalt, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5188
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5189
      thus "False"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5190
        using h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5191
        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
  5192
        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
  5193
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5194
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5195
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5196
  thus "?thesis"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5197
    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
  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
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5202
  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
  5203
  *}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5204
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5205
lemma UTM_uhalt_lemma':
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5206
  assumes tm_wf: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5207
  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
  5208
  and args: "args \<noteq> []"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5209
  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
  5210
  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
  5211
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
  5212
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
  5213
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5214
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5215
lemma UTM_halt_lemma:
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5216
  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
  5217
  and resut: "rs > 0"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5218
  and args: "(args::nat list) \<noteq> []"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5219
  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
  5220
  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
  5221
proof -
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5222
  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
  5223
          {(\<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
  5224
  proof(rule_tac Hoare_plus_halt)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5225
    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
  5226
    (\<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
  5227
      apply(rule_tac Hoare_haltI, auto)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5228
      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
  5229
      apply(auto)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5230
      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
  5231
      done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5232
  next
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5233
    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
  5234
      using exec
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5235
      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
  5236
      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
  5237
      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
  5238
      done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5239
    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
  5240
      ..
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5241
    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
  5242
      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
  5243
    proof(rule_tac Hoare_haltI, auto)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5244
      fix rn
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5245
      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
  5246
             (\<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
  5247
         (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
  5248
        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
  5249
        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
  5250
        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
  5251
        done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5252
    qed
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5253
  next
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5254
    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
  5255
  qed
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5256
  thus "?thesis"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5257
    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
  5258
    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
  5259
    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
  5260
    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
  5261
    apply(auto)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5262
    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
  5263
           (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
  5264
                        shift (mopup (Suc (Suc 0)))
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5265
                         (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
  5266
                          2))) n)")
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5267
    apply(simp)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5268
    done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5269
qed
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5270
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5271
lemma UTM_halt_lemma2:
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5272
  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
  5273
  and args: "(args::nat list) \<noteq> []"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5274
  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
  5275
  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
  5276
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
  5277
using assms(3)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5278
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
  5279
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5280
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5281
    
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5282
lemma UTM_unhalt_lemma: 
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5283
  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
  5284
  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
  5285
  and args: "args \<noteq> []"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5286
  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
  5287
proof -
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5288
  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
  5289
    using unhalt
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5290
    apply(auto simp: Hoare_unhalt_def)    
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5291
    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
  5292
    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
  5293
    done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5294
  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
  5295
    using assms
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5296
    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
  5297
    done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5298
  thus "?thesis"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5299
    apply(simp add: Hoare_unhalt_def)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5300
    done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5301
qed
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5302
    
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5303
lemma UTM_unhalt_lemma2: 
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5304
  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
  5305
  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
  5306
  and args: "args \<noteq> []"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5307
  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
  5308
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
  5309
using assms(2-3)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5310
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
  5311
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5312
end