thys/UTM.thy
author Christian Urban <christian dot urban at kcl dot ac dot uk>
Sat, 23 Nov 2013 13:23:53 +0000
changeset 285 447b433b67fa
parent 248 aea02b5a58d2
child 288 a9003e6d0463
permissions -rwxr-xr-x
added things --- in messy state
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
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
   546
  "t_twice = adjust0 t_twice_compile"
131
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
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
   554
  "t_fourtimes = adjust0 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
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1217
declare start_of.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1218
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1219
lemma twice_lemma: "rec_exec rec_twice [rs] = 2*rs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1220
by(auto simp: rec_twice_def rec_exec.simps)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  1221
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1222
lemma t_twice_correct: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1223
  "\<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
  1224
  (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
  1225
  (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
  1226
proof(case_tac "rec_ci rec_twice")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1227
  fix a b c
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1228
  assume h: "rec_ci rec_twice = (a, b, c)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  1229
  have "\<exists>stp m l. steps0 (Suc 0, Bk # Bk # ires, <[rs]> @ Bk\<up>(n)) (tm_of abc_twice @ shift (mopup (length [rs])) 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1230
    (length (tm_of abc_twice) div 2)) stp = (0, Bk\<up>(m) @ Bk # Bk # ires, Oc\<up>(Suc (rec_exec rec_twice [rs])) @ Bk\<up>(l))"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  1231
    thm  recursive_compile_to_tm_correct1
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  1232
  proof(rule_tac recursive_compile_to_tm_correct1)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1233
    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
  1234
  next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1235
    show "terminate rec_twice [rs]"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1236
      apply(rule_tac primerec_terminate, auto)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  1237
      apply(simp add: rec_twice_def, auto simp: constn.simps numeral_2_eq_2)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  1238
      by(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1239
  next
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  1240
    show "tm_of abc_twice = tm_of (a [+] dummy_abc (length [rs]))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1241
      using h
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  1242
      by(simp add: abc_twice_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1243
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1244
  thus "?thesis"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1245
    apply(simp add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv rec_exec.simps twice_lemma)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1246
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1247
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1248
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1249
declare adjust.simps[simp]
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1250
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1251
lemma adjust_fetch0: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1252
  "\<lbrakk>0 < a; a \<le> length ap div 2;  fetch ap a b = (aa, 0)\<rbrakk>
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  1253
  \<Longrightarrow> fetch (adjust0 ap) a b = (aa, Suc (length ap div 2))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1254
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
  1255
                       split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1256
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
  1257
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1258
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1259
lemma adjust_fetch_norm: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1260
  "\<lbrakk>st > 0;  st \<le> length tp div 2; fetch ap st b = (aa, ns); ns \<noteq> 0\<rbrakk>
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  1261
 \<Longrightarrow>  fetch (adjust0 ap) st b = (aa, ns)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1262
 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
  1263
                       split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1264
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
  1265
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1266
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1267
declare adjust.simps[simp del]
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1268
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1269
lemma adjust_step_eq: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1270
  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
  1271
  and wf_tm: "tm_wf (ap, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1272
  and notfinal: "st' > 0"
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  1273
  shows "step0 (st, l, r) (adjust0 ap) = (st', l', r')"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1274
  using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1275
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1276
  have "st > 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1277
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1278
    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
  1279
  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
  1280
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1281
    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
  1282
    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
  1283
    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
  1284
      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
  1285
    apply(auto simp: mod_ex2)
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  1286
    done    
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  1287
  ultimately have "fetch (adjust0 ap) st (read r) = fetch ap st (read r)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1288
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1289
    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
  1290
    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
  1291
    apply(simp add: step.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1292
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1293
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1294
    using exec
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1295
    by(simp add: step.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1296
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1297
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1298
declare adjust.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1299
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1300
lemma adjust_steps_eq: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1301
  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
  1302
  and wf_tm: "tm_wf (ap, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1303
  and notfinal: "st' > 0"
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  1304
  shows "steps0 (st, l, r) (adjust0 ap) stp = (st', l', r')"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1305
  using exec notfinal
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1306
proof(induct stp arbitrary: st' l' r')
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1307
  case 0
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1308
  thus "?case"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1309
    by(simp add: steps.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1310
next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1311
  case (Suc stp st' l' r')
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1312
  have ind: "\<And>st' l' r'. \<lbrakk>steps0 (st, l, r) ap stp = (st', l', r'); 0 < st'\<rbrakk> 
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  1313
    \<Longrightarrow> steps0 (st, l, r) (adjust0 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
  1314
  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
  1315
  have g:   "0 < st'" by fact
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1316
  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
  1317
    by (metis prod_cases3)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1318
  hence c:"0 < st''"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1319
    using h g
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1320
    apply(simp add: step_red)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1321
    apply(case_tac st'', auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1322
    done
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  1323
  hence b: "steps0 (st, l, r) (adjust0 ap) stp = (st'', l'', r'')"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1324
    using a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1325
    by(rule_tac ind, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1326
  thus "?case"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1327
    using assms a b h g
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1328
    apply(simp add: step_red) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1329
    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
  1330
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1331
qed 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1332
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1333
lemma adjust_halt_eq:
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1334
  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
  1335
  and tm_wf: "tm_wf (ap, 0)" 
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  1336
  shows "\<exists> stp. steps0 (Suc 0, l, r) (adjust0 ap) stp = 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1337
        (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
  1338
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1339
  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
  1340
    using exec
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1341
    by(erule_tac before_final)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1342
  then obtain stpa where a: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1343
    "\<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
  1344
  obtain sa la ra where b:"steps0 (1, l, r) ap stpa = (sa, la, ra)"  by (metis prod_cases3)
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  1345
  hence c: "steps0 (Suc 0, l, r) (adjust0 ap) stpa = (sa, la, ra)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1346
    using assms a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1347
    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
  1348
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1349
  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
  1350
    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
  1351
    by(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1352
  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
  1353
    by (metis prod.exhaust)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1354
  hence f: "ns = 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1355
    using b a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1356
    apply(simp add: step_red step.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1357
    done
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  1358
  have k: "fetch (adjust0 ap) sa (read ra) = (ac, Suc (length ap div 2))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1359
    using a b c d e f
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1360
    apply(rule_tac adjust_fetch0, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1361
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1362
  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
  1363
    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
  1364
    apply(simp add: step_red, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1365
    apply(simp add: step.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1366
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1367
qed    
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1368
   
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1369
declare tm_wf.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1370
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1371
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
  1372
apply(simp only: t_twice_compile_def)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  1373
apply(rule_tac wf_tm_from_abacus, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1374
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1375
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1376
lemma t_twice_change_term_state:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1377
  "\<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
  1378
     = (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
  1379
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1380
  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
  1381
    (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
  1382
    (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
  1383
    by(rule_tac t_twice_correct)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1384
  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
  1385
    (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
  1386
    (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
  1387
  hence "\<exists> stp. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  1388
    (adjust0 t_twice_compile) stp
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1389
     = (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
  1390
    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
  1391
    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
  1392
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1393
  then obtain stpb where 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1394
    "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  1395
    (adjust0 t_twice_compile) stpb
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1396
     = (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
  1397
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1398
    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
  1399
    by metis
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1400
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1401
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1402
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
  1403
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
  1404
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1405
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1406
lemma t_twice_append_pre:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1407
  "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
  1408
  = (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
  1409
   \<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
  1410
     (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
  1411
      ([(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
  1412
    = (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
  1413
             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
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
  1415
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1416
lemma t_twice_append:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1417
  "\<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
  1418
     (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
  1419
      ([(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
  1420
    = (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
  1421
  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
  1422
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1423
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1424
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1425
  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
  1426
  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
  1427
  apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1428
  done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1429
  
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1430
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
  1431
apply(auto simp: mopup.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1432
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1433
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1434
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
  1435
     = (L, Suc 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1436
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
  1437
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
  1438
  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
  1439
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
  1440
using mopup_mod2[of 1]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1441
apply(simp)
285
447b433b67fa added things --- in messy state
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 248
diff changeset
  1442
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1443
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1444
lemma wcode_jump1: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1445
  "\<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
  1446
                       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
  1447
     t_wcode_main stp 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1448
    = (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
  1449
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
  1450
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
  1451
apply(case_tac m, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1452
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
  1453
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1454
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1455
lemma wcode_main_first_part_len:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1456
  "length t_wcode_main_first_part = 24"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1457
  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
  1458
  done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1459
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1460
lemma wcode_double_case: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1461
  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
  1462
          (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
  1463
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1464
  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
  1465
          (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
  1466
    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
  1467
    apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1468
    apply(erule_tac exE)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1469
    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
  1470
           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
  1471
          auto simp: wcode_double_case_inv.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1472
                     wcode_before_double.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1473
    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
  1474
    apply(simp)
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
  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
  1477
    "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
  1478
    (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
  1479
  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
  1480
    (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
  1481
    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
  1482
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1483
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1484
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1485
    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
  1486
    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
  1487
          rule_tac x = rn in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1488
    apply(simp add: t_wcode_main_def)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  1489
    apply(simp add: replicate_Suc[THEN sym] replicate_add [THEN sym] del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1490
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1491
  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
  1492
    "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
  1493
    (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
  1494
  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
  1495
    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
  1496
       (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
  1497
    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
  1498
    apply(erule_tac exE)
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(rule_tac x = stp in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1502
          rule_tac x = ln in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1503
          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
  1504
    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
  1505
    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
  1506
    apply(simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1507
    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
  1508
    done               
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1509
  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
  1510
    "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
  1511
    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
  1512
       (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
  1513
    by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1514
  from stp1 stp2 stp3 show "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1515
    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
  1516
         rule_tac x = rnc in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1517
    apply(simp add: steps_add)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1518
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1519
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1520
    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1521
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1522
(* Begin: fourtime_case*)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1523
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
  1524
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1525
  "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
  1526
     (\<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
  1527
                 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
  1528
                 ml + mr > Suc 0 \<and> mr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1529
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1530
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
  1531
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1532
  "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
  1533
     (\<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
  1534
               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
  1535
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1536
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
  1537
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1538
  "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
  1539
      (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
  1540
      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
  1541
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1542
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
  1543
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1544
  "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
  1545
       (\<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
  1546
                 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
  1547
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1548
fun wcode_goon_checking :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1549
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1550
  "wcode_goon_checking ires rs (l, r) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1551
       (\<exists> ln rn. l = ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1552
                 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
  1553
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1554
fun wcode_right_move :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1555
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1556
  "wcode_right_move ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1557
     (\<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
  1558
                 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
  1559
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1560
fun wcode_erase2 :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1561
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1562
  "wcode_erase2 ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1563
        (\<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
  1564
                 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
  1565
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1566
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
  1567
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1568
  "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
  1569
        (\<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
  1570
                     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
  1571
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1572
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
  1573
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1574
  "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
  1575
        (\<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
  1576
                        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
  1577
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1578
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
  1579
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1580
  "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
  1581
           (\<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
  1582
                     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
  1583
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1584
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
  1585
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1586
  "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
  1587
          (\<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
  1588
                          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
  1589
                          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
  1590
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1591
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
  1592
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1593
  "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
  1594
           (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
  1595
           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
  1596
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1597
fun wcode_before_fourtimes :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1598
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1599
  "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
  1600
          (\<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
  1601
                    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
  1602
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1603
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
  1604
        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
  1605
        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
  1606
        wcode_erase2.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1607
        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
  1608
        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
  1609
        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
  1610
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1611
lemmas wcode_fourtimes_invs = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1612
       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
  1613
        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
  1614
        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
  1615
        wcode_erase2.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1616
        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
  1617
        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
  1618
        wcode_backto_standard_pos_2.simps
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
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
  1621
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1622
  "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
  1623
           (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
  1624
            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
  1625
            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
  1626
            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
  1627
            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
  1628
            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
  1629
            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
  1630
            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
  1631
            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
  1632
            else False)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1633
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1634
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
  1635
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1636
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
  1637
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1638
  "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
  1639
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1640
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
  1641
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1642
  "wcode_fourtimes_case_step (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1643
         (if st = Suc 0 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1644
          else if st = 9 then 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1645
           (if hd r = Oc then 1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1646
            else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1647
          else if st = 10 then length r
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1648
          else if st = 11 then length r
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1649
          else if st = 12 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1650
          else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1651
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1652
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
  1653
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1654
  "wcode_fourtimes_case_measure (st, l, r) = 
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), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1656
      wcode_fourtimes_case_step (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1657
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1658
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
  1659
  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
  1660
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1661
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
  1662
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
  1663
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1664
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
  1665
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
  1666
  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
  1667
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1668
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1669
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
  1670
apply(subgoal_tac "7 = Suc 6")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1671
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
  1672
  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
  1673
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1674
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1675
 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1676
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
  1677
apply(subgoal_tac "8 = Suc 7")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1678
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
  1679
  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
  1680
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1681
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1682
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1683
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1684
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
  1685
apply(subgoal_tac "9 = Suc 8")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1686
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
  1687
  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
  1688
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1689
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1690
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1691
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
  1692
apply(subgoal_tac "9 = Suc 8")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1693
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
  1694
  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
  1695
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1696
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1697
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1698
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
  1699
apply(subgoal_tac "10 = Suc 9")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1700
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
  1701
  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
  1702
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1703
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1704
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1705
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
  1706
apply(subgoal_tac "10 = Suc 9")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1707
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
  1708
  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
  1709
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1710
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1711
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1712
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
  1713
apply(subgoal_tac "11 = Suc 10")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1714
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
  1715
  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
  1716
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1717
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1718
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1719
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
  1720
apply(subgoal_tac "11 = Suc 10")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1721
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
  1722
  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
  1723
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1724
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1725
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1726
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
  1727
apply(subgoal_tac "12 = Suc 11")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1728
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
  1729
  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
  1730
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1731
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1732
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1733
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
  1734
apply(subgoal_tac "12 = Suc 11")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1735
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
  1736
  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
  1737
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1738
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1739
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1740
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
  1741
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1742
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1743
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1744
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
  1745
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1746
done          
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1747
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1748
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
  1749
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1750
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1751
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1752
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
  1753
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1754
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1755
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1756
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
  1757
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1758
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1759
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1760
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
  1761
apply(auto simp: wcode_fourtimes_invs)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1762
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1763
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1764
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
  1765
apply(auto simp: wcode_fourtimes_invs)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1766
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1767
    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1768
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
  1769
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
  1770
done     
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1771
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1772
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
  1773
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1774
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1775
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1776
apply(case_tac ml, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1777
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
  1778
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
  1779
apply(rule_tac disjI1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1780
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
  1781
      simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1782
apply(simp)
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_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
  1786
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1787
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1788
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1789
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
  1790
       \<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
  1791
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1792
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1793
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1794
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1795
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
  1796
apply(simp add: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1797
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1798
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1799
lemma [simp]: " wcode_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
  1800
apply(simp add: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1801
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1802
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1803
lemma [simp]: "wcode_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
  1804
apply(auto simp:wcode_fourtimes_invs )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1805
apply(rule_tac x = 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
  1806
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1807
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1808
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
  1809
apply(auto simp: wcode_fourtimes_invs)
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_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
  1813
apply(auto simp:wcode_fourtimes_invs )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1814
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
  1815
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
  1816
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1817
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1818
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
  1819
apply(auto simp:wcode_fourtimes_invs )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1820
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1821
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1822
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
  1823
       \<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
  1824
apply(auto simp: wcode_fourtimes_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1825
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
  1826
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
  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_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
  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
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1832
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1833
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
  1834
                 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
  1835
apply(simp add: wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1836
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
  1837
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
  1838
apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1839
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
  1840
apply(case_tac rn, simp, simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1841
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1842
   
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1843
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
  1844
apply(simp add: wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1845
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1846
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1847
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
  1848
apply(simp add: wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1849
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1850
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1851
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
  1852
                     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
  1853
apply(auto simp: wcode_fourtimes_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1854
apply(case_tac [!] mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1855
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1856
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1857
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
  1858
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1859
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1860
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1861
lemma [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
  1862
              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
  1863
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1864
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1865
apply(rule_tac disjI1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1866
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
  1867
      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
  1868
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1869
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1870
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
  1871
       \<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
  1872
apply(auto simp: wcode_fourtimes_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1873
apply(case_tac [!] mr, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1874
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1875
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1876
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1877
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
  1878
apply(simp add: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1879
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1880
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1881
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
  1882
  (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
  1883
  (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
  1884
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1885
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1886
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1887
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1888
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1889
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
  1890
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1891
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1892
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1893
lemma [simp]: " wcode_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
  1894
apply(simp add: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1895
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1896
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1897
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
  1898
       \<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
  1899
apply(auto simp: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1900
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1901
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1902
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
  1903
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1904
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1905
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1906
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1907
lemma [simp]: "wcode_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
  1908
       \<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
  1909
apply(auto simp: wcode_fourtimes_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1910
apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1911
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
  1912
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
  1913
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
  1914
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1915
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1916
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
  1917
apply(simp only:wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1918
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1919
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1920
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
  1921
       \<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
  1922
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
  1923
apply(case_tac [!] mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1924
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1925
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1926
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
  1927
apply(simp add: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1928
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1929
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1930
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
  1931
       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
  1932
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
  1933
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
  1934
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
  1935
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
  1936
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1937
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1938
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
  1939
apply(simp only: wcode_fourtimes_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1940
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1941
 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1942
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
  1943
            \<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
  1944
apply(simp only: wcode_fourtimes_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1945
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1946
apply(erule_tac exE)+
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1947
apply(case_tac ml, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1948
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
  1949
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
  1950
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1951
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1952
lemma wcode_fourtimes_case_first_correctness:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1953
 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
  1954
  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
  1955
  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
  1956
  \<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
  1957
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1958
  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
  1959
  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
  1960
  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
  1961
  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
  1962
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1963
    show "wf wcode_fourtimes_case_le"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1964
      by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1965
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1966
    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
  1967
                  ?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
  1968
    apply(rule_tac allI,
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1969
     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
  1970
     rule_tac impI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1971
    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
  1972
    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
  1973
                        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
  1974
    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
  1975
      wcode_backto_standard_pos_2_B.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  1976
    apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1977
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1978
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1979
    show "?Q (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1980
      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
  1981
      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
  1982
                      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
  1983
      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
  1984
      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
  1985
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1986
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1987
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1988
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1989
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1990
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1991
  thus "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1992
    apply(erule_tac exE, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1993
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1994
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1995
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1996
definition t_fourtimes_len :: "nat"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1997
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1998
  "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
  1999
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2000
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
  2001
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
  2002
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2003
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2004
lemma [intro]: "primerec rec_fourtimes (Suc 0)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2005
apply(auto simp: rec_fourtimes_def numeral_4_eq_4 constn.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2006
by auto
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2007
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2008
lemma fourtimes_lemma: "rec_exec rec_fourtimes [rs] = 4 * rs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2009
by(simp add: rec_exec.simps rec_fourtimes_def)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2010
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2011
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2012
lemma t_fourtimes_correct: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2013
  "\<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
  2014
    (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
  2015
       (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
  2016
proof(case_tac "rec_ci rec_fourtimes")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2017
  fix a b c
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2018
  assume h: "rec_ci rec_fourtimes = (a, b, c)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2019
  have "\<exists>stp m l. steps0 (Suc 0, Bk # Bk # ires, <[rs]> @ Bk\<up>(n)) (tm_of abc_fourtimes @ shift (mopup (length [rs])) 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2020
    (length (tm_of abc_fourtimes) div 2)) stp = (0, Bk\<up>(m) @ Bk # Bk # ires, Oc\<up>(Suc (rec_exec rec_fourtimes [rs])) @ Bk\<up>(l))"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2021
    thm recursive_compile_to_tm_correct1
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2022
  proof(rule_tac recursive_compile_to_tm_correct1)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2023
    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
  2024
  next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2025
    show "terminate rec_fourtimes [rs]"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2026
      apply(rule_tac primerec_terminate)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2027
      by auto
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2028
  next
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2029
    show "tm_of abc_fourtimes = tm_of (a [+] dummy_abc (length [rs]))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2030
      using h
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2031
      by(simp add: abc_fourtimes_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2032
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2033
  thus "?thesis"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2034
    apply(simp add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv fourtimes_lemma)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2035
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2036
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2037
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2038
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
  2039
apply(simp only: t_fourtimes_compile_def)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2040
apply(rule_tac wf_tm_from_abacus, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2041
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2042
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2043
lemma t_fourtimes_change_term_state:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2044
  "\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_fourtimes stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2045
     = (Suc t_fourtimes_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2046
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2047
  have "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2048
    (tm_of abc_fourtimes @ shift (mopup 1) ((length (tm_of abc_fourtimes) div 2))) stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2049
    (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2050
    by(rule_tac t_fourtimes_correct)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2051
  then obtain stp ln rn where 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2052
    "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2053
    (tm_of abc_fourtimes @ shift (mopup 1) ((length (tm_of abc_fourtimes) div 2))) stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2054
    (0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))" by blast
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2055
  hence "\<exists> stp. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  2056
    (adjust0 t_fourtimes_compile) stp
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2057
     = (Suc (length t_fourtimes_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2058
    apply(rule_tac stp = stp in adjust_halt_eq)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2059
    apply(simp add: t_fourtimes_compile_def, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2060
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2061
  then obtain stpb where 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2062
    "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  2063
    (adjust0 t_fourtimes_compile) stpb
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2064
     = (Suc (length t_fourtimes_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))" ..
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2065
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2066
    apply(simp add: t_fourtimes_def t_fourtimes_len_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2067
    by metis
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2068
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2069
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2070
lemma [intro]: "length t_twice mod 2 = 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2071
apply(auto simp: t_twice_def t_twice_compile_def)
285
447b433b67fa added things --- in messy state
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 248
diff changeset
  2072
by (metis mopup_mod2)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2073
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2074
lemma t_fourtimes_append_pre:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2075
  "steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_fourtimes stp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2076
  = (Suc t_fourtimes_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2077
   \<Longrightarrow> steps0 (Suc 0 + length (t_wcode_main_first_part @ 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2078
              shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2079
       Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2080
     ((t_wcode_main_first_part @ 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2081
  shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) @ 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2082
  shift t_fourtimes (length (t_wcode_main_first_part @ 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2083
  shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2) @ ([(L, 1), (L, 1)])) stp 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2084
  = ((Suc t_fourtimes_len) + length (t_wcode_main_first_part @ 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2085
  shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2086
  Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2087
apply(rule_tac tm_append_shift_append_steps, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2088
apply(auto simp: t_wcode_main_first_part_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2089
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2090
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2091
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2092
lemma [simp]: "length t_wcode_main_first_part = 24"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2093
apply(simp add: t_wcode_main_first_part_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2094
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2095
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2096
lemma [simp]: "(26 + length t_twice) div 2 = (length t_twice) div 2 + 13"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2097
apply(simp add: t_twice_def t_twice_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2098
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2099
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2100
lemma [simp]: "((26 + length (shift t_twice 12)) div 2)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2101
             = (length (shift t_twice 12) div 2 + 13)"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2102
apply(simp add: t_twice_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2103
done 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2104
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2105
lemma [simp]: "t_twice_len + 14 =  14 + length (shift t_twice 12) div 2"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2106
apply(simp add: t_twice_def t_twice_len_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2107
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2108
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2109
lemma t_fourtimes_append:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2110
  "\<exists> stp ln rn. 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2111
  steps0 (Suc 0 + length (t_wcode_main_first_part @ shift t_twice
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2112
  (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2, 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2113
  Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2114
  ((t_wcode_main_first_part @ shift t_twice (length t_wcode_main_first_part div 2) @
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2115
  [(L, 1), (L, 1)]) @ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)]) stp 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2116
  = (Suc t_fourtimes_len + length (t_wcode_main_first_part @ shift t_twice
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2117
  (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2, Bk\<up>(ln) @ Bk # Bk # ires,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2118
                                                                 Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2119
  using t_fourtimes_change_term_state[of ires rs n]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2120
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2121
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2122
  apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2123
  apply(drule_tac t_fourtimes_append_pre)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2124
  apply(rule_tac x = stp in exI, rule_tac x = ln in exI, rule_tac x = rn in exI)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2125
  apply(simp add: t_twice_len_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2126
  done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2127
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2128
lemma t_wcode_main_len: "length t_wcode_main = length t_twice + length t_fourtimes + 28"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2129
apply(simp add: t_wcode_main_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2130
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2132
lemma even_twice_len: "length t_twice mod 2 = 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2133
apply(auto simp: t_twice_def t_twice_compile_def)
285
447b433b67fa added things --- in messy state
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 248
diff changeset
  2134
by (metis mopup_mod2)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2135
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2136
lemma even_fourtimes_len: "length t_fourtimes mod 2 = 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2137
apply(auto simp: t_fourtimes_def t_fourtimes_compile_def)
285
447b433b67fa added things --- in messy state
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 248
diff changeset
  2138
by (metis mopup_mod2)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2139
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2140
lemma [simp]: "2 * (length t_twice div 2) = length t_twice"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2141
using even_twice_len
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2142
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2143
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2144
lemma [simp]: "2 * (length t_fourtimes div 2) = length t_fourtimes"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2145
using even_fourtimes_len
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2146
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2147
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2148
lemma [simp]: "fetch t_wcode_main (14 + length t_twice div 2 + t_fourtimes_len) Oc
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2149
             = (L, Suc 0)" 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2150
apply(subgoal_tac "14 = Suc 13")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2151
apply(simp only: fetch.simps add_Suc nth_of.simps t_wcode_main_def)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2152
apply(simp add:length_append length_shift Parity.two_times_even_div_two even_twice_len t_fourtimes_len_def nth_append)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2153
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2154
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2155
lemma [simp]: "fetch t_wcode_main (14 + length t_twice div 2 + t_fourtimes_len) Bk
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2156
             = (L, Suc 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2157
apply(subgoal_tac "14 = Suc 13")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2158
apply(simp only: fetch.simps add_Suc nth_of.simps t_wcode_main_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2159
apply(simp add:length_append length_shift Parity.two_times_even_div_two even_twice_len t_fourtimes_len_def nth_append)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2160
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2161
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2162
lemma [simp]: "fetch t_wcode_main (14 + length t_twice div 2 + t_fourtimes_len) b
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2163
             = (L, Suc 0)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2164
apply(case_tac b, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2165
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2166
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2167
lemma wcode_jump2: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2168
  "\<exists> stp ln rn. steps0 (t_twice_len + 14 + t_fourtimes_len
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2169
  , Bk # Bk # Bk\<up>(lnb) @ Oc # ires, Oc\<up>(Suc (4 * rs + 4)) @ Bk\<up>(rnb)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2170
  (Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (4 * rs + 4)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2171
apply(rule_tac x = "Suc 0" in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2172
apply(simp add: steps.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2173
apply(rule_tac x = lnb in exI, rule_tac x = rnb in exI)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2174
apply(simp add: step.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2175
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2176
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2177
lemma wcode_fourtimes_case:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2178
  shows "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2179
  steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2180
  (Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2181
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2182
  have "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2183
  steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2184
  (t_twice_len + 14, Bk # Bk # Bk\<up>(ln) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2185
    using wcode_fourtimes_case_first_correctness[of ires rs m n]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2186
    apply(simp add: wcode_fourtimes_case_inv.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2187
    apply(rule_tac x = na in exI, rule_tac x = ln in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2188
          rule_tac x = rn in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2189
    apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2190
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2191
  from this obtain stpa lna rna where stp1:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2192
    "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stpa =
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2193
  (t_twice_len + 14, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rna))" by blast
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2194
  have "\<exists>stp ln rn. steps0 (t_twice_len + 14, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rna))
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2195
                     t_wcode_main stp =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2196
          (t_twice_len + 14 + t_fourtimes_len, Bk # Bk # Bk\<up>(ln) @ Oc # ires,  Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2197
    using t_fourtimes_append[of " Bk\<up>(lna) @ Oc # ires" "rs + 1" rna]
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2198
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2199
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2200
    apply(erule_tac exE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2201
    apply(simp add: t_wcode_main_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2202
    apply(rule_tac x = stp in exI, 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2203
          rule_tac x = "ln + lna" in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2204
          rule_tac x = rn in exI, simp)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  2205
    apply(simp add: replicate_Suc[THEN sym] replicate_add[THEN sym] del: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2206
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2207
  from this obtain stpb lnb rnb where stp2:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2208
    "steps0 (t_twice_len + 14, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rna))
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2209
                     t_wcode_main stpb =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2210
       (t_twice_len + 14 + t_fourtimes_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires,  Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnb))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2211
    by blast
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2212
  have "\<exists>stp ln rn. steps0 (t_twice_len + 14 + t_fourtimes_len,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2213
    Bk # Bk # Bk\<up>(lnb) @ Oc # ires,  Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnb))
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2214
    t_wcode_main stp =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2215
    (Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2216
    apply(rule wcode_jump2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2217
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2218
  from this obtain stpc lnc rnc where stp3: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2219
    "steps0 (t_twice_len + 14 + t_fourtimes_len,
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2220
    Bk # Bk # Bk\<up>(lnb) @ Oc # ires,  Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnb))
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2221
    t_wcode_main stpc =
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2222
    (Suc 0, Bk # Bk\<up>(lnc) @ Oc # ires, Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnc))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2223
    by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2224
  from stp1 stp2 stp3 show "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2225
    apply(rule_tac x = "stpa + stpb + stpc" in exI,
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2226
          rule_tac x = lnc in exI, rule_tac x = rnc in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2227
    apply(simp add: steps_add)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2228
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2229
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2230
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2231
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
  2232
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2233
  "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
  2234
       (\<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
  2235
                    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
  2236
                    ml + mr > Suc 0 \<and> mr > 0 )"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2237
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2238
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
  2239
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2240
  "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
  2241
         (\<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
  2242
                   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
  2243
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2244
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
  2245
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2246
  "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
  2247
       (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
  2248
        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
  2249
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2250
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
  2251
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2252
  "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
  2253
         (\<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
  2254
             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
  2255
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2256
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
  2257
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2258
  "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
  2259
         (\<exists> ln rn. l = ires \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2260
             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
  2261
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2262
fun wcode_stop :: "bin_inv_t"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2263
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2264
  "wcode_stop ires rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2265
          (\<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
  2266
             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
  2267
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2268
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
  2269
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2270
  "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
  2271
          (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
  2272
           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
  2273
           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
  2274
           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
  2275
           else False)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2276
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2277
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
  2278
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2279
  "wcode_halt_case_state (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2280
           (if st = 1 then 5
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2281
            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
  2282
            else if st = 7 then 3
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2283
            else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2284
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2285
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
  2286
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2287
  "wcode_halt_case_step (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2288
         (if st = 1 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2289
         else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2290
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2291
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
  2292
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2293
  "wcode_halt_case_measure (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2294
     (wcode_halt_case_state (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2295
      wcode_halt_case_step (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2296
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2297
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
  2298
  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
  2299
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2300
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
  2301
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
  2302
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2303
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
  2304
        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
  2305
        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
  2306
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2307
lemmas wcode_halt_invs = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2308
  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
  2309
  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
  2310
  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
  2311
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2312
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
  2313
apply(subgoal_tac "7 = Suc 6")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2314
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
  2315
                t_wcode_main_first_part_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2316
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2317
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2318
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2319
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
  2320
apply(simp only: wcode_halt_invs)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2321
apply(simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2322
done    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2323
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2324
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
  2325
apply(simp add: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2326
done
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 [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
  2329
apply(simp add: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2330
done 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2331
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2332
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
  2333
 \<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
  2334
apply(simp only: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2335
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2336
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2337
apply(case_tac ml, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2338
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
  2339
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
  2340
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
  2341
apply(rule_tac disjI1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2342
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
  2343
      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
  2344
apply(simp)
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_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
  2348
  (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
  2349
  (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
  2350
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2351
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2352
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2353
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
  2354
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2355
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2356
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2357
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
  2358
               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
  2359
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
  2360
apply(case_tac [!] mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2361
done     
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2362
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2363
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
  2364
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2365
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2366
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2367
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
  2368
apply(simp add: wcode_halt_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2369
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2370
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2371
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
  2372
apply(auto simp: wcode_halt_invs)
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_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
  2376
  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
  2377
apply(auto simp: wcode_halt_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2378
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2379
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2380
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
  2381
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
  2382
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2383
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2384
lemma t_halt_case_correctness: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2385
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
  2386
       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
  2387
       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
  2388
       \<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
  2389
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2390
  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
  2391
  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
  2392
  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
  2393
  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
  2394
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2395
    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
  2396
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2397
    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
  2398
                    ?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
  2399
      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
  2400
      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
  2401
      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
  2402
      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
  2403
      done      
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2404
  next 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2405
    show "?Q (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2406
      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
  2407
      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
  2408
      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
  2409
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2410
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2411
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2412
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2413
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2414
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2415
  thus "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2416
    apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2417
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2418
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2419
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2420
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
  2421
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
  2422
apply(case_tac "rev list", simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2423
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
  2424
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2425
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2426
lemma wcode_halt_case:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2427
  "\<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
  2428
  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
  2429
  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
  2430
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2431
apply(erule_tac exE)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2432
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
  2433
                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
  2434
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
  2435
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
  2436
      rule_tac x = rn in exI, simp)
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
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2439
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
  2440
apply(simp add: bl_bin.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
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2443
lemma [simp]: "bl_bin [Oc] = 1"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2444
apply(simp add: bl_bin.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2445
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2446
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2447
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
  2448
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
  2449
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2450
declare replicate_Suc[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2451
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2452
lemma t_wcode_main_lemma_pre:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2453
  "\<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
  2454
       \<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
  2455
                    stp
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2456
      = (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
  2457
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
  2458
  fix x args lm rs m n
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2459
  assume ind:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2460
    "\<And>args lm rs m n.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2461
    \<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
  2462
    \<Longrightarrow> \<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2463
    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
  2464
    (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
  2465
    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
  2466
  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
  2467
    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
  2468
    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
  2469
    done    
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2470
  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
  2471
  from h and this show
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2472
    "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2473
    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
  2474
    (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
  2475
  proof(case_tac "xs::nat list", simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2476
    show "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2477
          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
  2478
          (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
  2479
    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
  2480
      fix m n rs ires
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2481
      show "\<exists>stp ln rn.
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2482
          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
  2483
          (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
  2484
          apply(rule_tac wcode_halt_case)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2485
        done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2486
    next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2487
      fix a m n rs ires
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2488
      assume ind2:
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2489
        "\<And>m n rs ires.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2490
           \<exists>stp ln rn.
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 @ 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
  2492
              (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
  2493
      show " \<exists>stp ln rn.
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2494
          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
  2495
          (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
  2496
      proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2497
        have "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2498
          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
  2499
          (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
  2500
          apply(simp add: tape_of_nat)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2501
          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
  2502
          apply(simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2503
          done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2504
        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
  2505
          "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
  2506
          (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
  2507
        moreover have 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2508
          "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2509
          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
  2510
          (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
  2511
          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
  2512
        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
  2513
          "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
  2514
          (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
  2515
          by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2516
        from stp1 and stp2 show "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2517
          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
  2518
            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
  2519
          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
  2520
          apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2521
          done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2522
      qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2523
    qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2524
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2525
    fix aa list
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2526
    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
  2527
    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
  2528
      (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
  2529
    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
  2530
        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
  2531
      fix m n rs args lm
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2532
      have "\<exists>stp ln rn.
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) @ 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
  2534
        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
  2535
        (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
  2536
        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
  2537
        proof(simp add: tape_of_nl_rev)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2538
          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
  2539
          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
  2540
          thus "\<exists>stp ln rn.
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>(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
  2542
            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
  2543
            (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
  2544
            apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2545
            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
  2546
            apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2547
            done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2548
        qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2549
      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
  2550
        "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
  2551
        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
  2552
        (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
  2553
        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
  2554
      from g have 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2555
        "\<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
  2556
        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
  2557
        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
  2558
         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
  2559
         done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2560
       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
  2561
         "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
  2562
         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
  2563
         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
  2564
         by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2565
       from stp1 and stp2 and h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2566
       show "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2567
         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
  2568
         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
  2569
         (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
  2570
         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
  2571
         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
  2572
           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
  2573
         done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2574
     next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2575
       fix ab m n rs args lm
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2576
       assume ind2:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2577
         "\<And> m n rs args lm.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2578
         \<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
  2579
         \<Longrightarrow> \<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2580
         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
  2581
         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
  2582
         (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
  2583
         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
  2584
         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
  2585
       show "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2586
         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
  2587
         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
  2588
         (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
  2589
         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
  2590
       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
  2591
         have "\<exists>stp ln rn.
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2592
           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
  2593
           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
  2594
           = (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
  2595
           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
  2596
           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
  2597
                                      rs n]
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2598
           apply(simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2599
           done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2600
         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
  2601
           "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
  2602
           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
  2603
           = (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
  2604
           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
  2605
         from k have 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2606
           "\<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
  2607
           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
  2608
           = (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
  2609
           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
  2610
           apply(rule_tac ind2, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2611
           done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2612
         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
  2613
           "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
  2614
           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
  2615
           = (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
  2616
           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
  2617
           by blast
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2618
         from stp1 and stp2 show 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2619
           "\<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\<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
  2622
           (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
  2623
           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
  2624
           @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2625
           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
  2626
             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
  2627
           done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2628
       qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2629
     qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2630
   qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2631
 qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2632
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2633
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2634
definition t_wcode_prepare :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2635
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2636
  "t_wcode_prepare \<equiv> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2637
         [(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
  2638
          (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
  2639
          (W1, 7), (L, 0)]"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2640
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2641
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
  2642
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2643
  "wprepare_add_one m lm (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2644
      (\<exists> rn. l = [] \<and>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2645
               (r = <m # lm> @ Bk\<up>(rn) \<or> 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2646
                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
  2647
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2648
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
  2649
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2650
  "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
  2651
      (\<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
  2652
                      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
  2653
                      ml + mr = Suc (Suc m))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2654
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2655
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
  2656
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2657
  "wprepare_erase m lm (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2658
     (\<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
  2659
               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
  2660
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2661
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
  2662
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2663
  "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
  2664
     (\<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
  2665
               r = Bk # <lm> @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2666
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2667
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
  2668
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2669
  "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
  2670
     (\<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
  2671
               r = <lm> @ Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2672
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2673
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
  2674
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2675
  "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
  2676
       (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
  2677
        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
  2678
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2679
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
  2680
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2681
  "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
  2682
     (\<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
  2683
                       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
  2684
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2685
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
  2686
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2687
  "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
  2688
     (\<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
  2689
  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
  2690
  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
  2691
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2692
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
  2693
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2694
  "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
  2695
                                      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
  2696
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2697
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
  2698
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2699
  "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
  2700
     (\<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
  2701
               r = Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2702
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2703
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
  2704
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2705
  "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
  2706
     (\<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
  2707
  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
  2708
                     (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
  2709
                     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
  2710
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2711
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
  2712
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2713
  "wprepare_loop_goon m lm (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2714
              (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
  2715
               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
  2716
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2717
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
  2718
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2719
  "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
  2720
          (\<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
  2721
               (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
  2722
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2723
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
  2724
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2725
  "wprepare_stop m lm (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2726
         (\<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
  2727
               r = Bk # Oc # Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2728
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2729
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
  2730
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2731
  "wprepare_inv st m lm (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2732
        (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
  2733
         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
  2734
         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
  2735
         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
  2736
         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
  2737
         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
  2738
         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
  2739
         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
  2740
         else False)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2741
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2742
fun wprepare_stage :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2743
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2744
  "wprepare_stage (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2745
      (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
  2746
       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
  2747
       else 1)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2748
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2749
fun wprepare_state :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2750
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2751
  "wprepare_state (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2752
       (if st = 1 then 4
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2753
        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
  2754
        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
  2755
        else if st = 4 then 1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2756
        else if st = 7 then 2
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2757
        else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2758
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2759
fun wprepare_step :: "config \<Rightarrow> nat"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2760
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2761
  "wprepare_step (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2762
      (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
  2763
                       else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2764
       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
  2765
       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
  2766
                            else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2767
       else if st = 4 then length r
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2768
       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
  2769
       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
  2770
       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
  2771
                            else 1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2772
       else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2773
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2774
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
  2775
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2776
  "wcode_prepare_measure (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2777
     (wprepare_stage (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2778
      wprepare_state (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2779
      wprepare_step (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2780
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2781
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
  2782
  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
  2783
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2784
lemma [intro]: "wf lex_pair"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2785
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
  2786
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2787
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
  2788
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
  2789
           lex_triple_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2790
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2791
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
  2792
        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
  2793
        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
  2794
        wprepare_add_one2.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2795
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2796
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
  2797
        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
  2798
        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
  2799
        wprepare_add_one2.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2800
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2801
declare wprepare_inv.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2802
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
  2803
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
  2804
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2805
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2806
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
  2807
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
  2808
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2809
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2810
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
  2811
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
  2812
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2813
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2814
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
  2815
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
  2816
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2817
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2818
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
  2819
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
  2820
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2821
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2822
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
  2823
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
  2824
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2825
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2826
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
  2827
apply(subgoal_tac "4 = Suc 3")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2828
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
  2829
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2830
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2831
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2832
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
  2833
apply(subgoal_tac "4 = Suc 3")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2834
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
  2835
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2836
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2837
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2838
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2839
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
  2840
apply(subgoal_tac "5 = Suc 4")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2841
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
  2842
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2843
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2844
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2845
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
  2846
apply(subgoal_tac "5 = Suc 4")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2847
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
  2848
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2849
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2850
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2851
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
  2852
apply(subgoal_tac "6 = Suc 5")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2853
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
  2854
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2855
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2856
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2857
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
  2858
apply(subgoal_tac "6 = Suc 5")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2859
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
  2860
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2861
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2862
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2863
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
  2864
apply(subgoal_tac "7 = Suc 6")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2865
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
  2866
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2867
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2868
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2869
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
  2870
apply(subgoal_tac "7 = Suc 6")
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2871
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
  2872
apply(auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2873
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2874
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2875
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
  2876
apply(simp add: wprepare_invs)
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]: "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
  2880
apply(simp add: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2881
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2882
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2883
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
  2884
apply(simp add: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2885
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2886
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2887
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
  2888
apply(simp add: wprepare_invs)
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]: "\<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
  2892
apply(simp add: wprepare_invs)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2893
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2894
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2895
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
  2896
by auto
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2897
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2898
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
  2899
                                  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
  2900
apply(simp only: wprepare_invs)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2901
apply(erule_tac disjE)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2902
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2903
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
  2904
                wprepare_loop_goon_on_rightmost.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2905
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
  2906
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2907
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2908
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
  2909
apply(simp only: wprepare_invs, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2910
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2911
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2912
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
  2913
  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
  2914
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
  2915
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2916
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2917
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
  2918
apply(simp only: wprepare_invs, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2919
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2920
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2921
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
  2922
apply(simp only: wprepare_invs, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2923
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2924
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2925
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
  2926
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
  2927
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2928
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2929
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
  2930
       \<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
  2931
           (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
  2932
apply(simp only: wprepare_invs)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2933
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
  2934
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
  2935
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
  2936
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2937
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2938
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
  2939
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
  2940
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2941
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2942
declare replicate_Suc[simp]
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2943
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2944
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
  2945
                          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
  2946
apply(simp only: wprepare_invs, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2947
apply(case_tac mr, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2948
apply(case_tac mr, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2949
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2950
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2951
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
  2952
apply(simp only: wprepare_invs, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2953
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2954
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2955
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
  2956
                           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
  2957
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2958
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2959
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2960
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
  2961
apply(simp only: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2962
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
  2963
                         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
  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]: "\<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
  2967
apply(simp only: wprepare_invs, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  2968
apply(case_tac mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2969
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2970
     
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2971
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
  2972
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2973
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2974
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2975
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
  2976
apply(simp only: wprepare_invs, auto)
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]: "\<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
  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]: "\<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
  2984
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2985
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
  2986
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
  2987
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2988
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2989
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
  2990
apply(simp only: wprepare_invs)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2991
apply(auto)
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_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
  2995
apply(simp only: wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2996
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2997
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2998
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
  2999
  (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
  3000
  (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
  3001
apply(simp only: wprepare_invs, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3002
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
  3003
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
  3004
apply(case_tac mr, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3005
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
  3006
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
  3007
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3008
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3009
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
  3010
apply(simp only: wprepare_invs, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3011
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3012
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3013
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
  3014
      (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
  3015
      (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
  3016
apply(simp only:  wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3017
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3018
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3019
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
  3020
       \<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
  3021
           (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
  3022
apply(simp only:  wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3023
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
  3024
apply(case_tac mr, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3025
apply(case_tac ml, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3026
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
  3027
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
  3028
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3029
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3030
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
  3031
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
  3032
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3033
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3034
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
  3035
  \<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
  3036
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
  3037
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3038
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3039
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
  3040
       \<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
  3041
apply(simp only:wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3042
apply(case_tac [!] lm, simp, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3043
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3044
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3045
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
  3046
apply(simp only:wprepare_invs, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3047
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3048
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
  3049
apply(case_tac mr, simp_all)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3050
apply(case_tac rn, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3051
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3052
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3053
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
  3054
by simp
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3055
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3056
lemma tape_of_nl_false1:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3057
  "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
  3058
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3059
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
  3060
apply(case_tac "rev lm")
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3061
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
  3062
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3063
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3064
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
  3065
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
  3066
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
  3067
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3068
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3069
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
  3070
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3071
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
  3072
        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
  3073
        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
  3074
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3075
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
  3076
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
  3077
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3078
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3079
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
  3080
  wprepare_loop_goon m lm (Bk # b, [])"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3081
apply(simp only: wprepare_invs, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3082
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
  3083
  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
  3084
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
  3085
apply(rule_tac rev_eq)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3086
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
  3087
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
  3088
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3089
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3090
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
  3091
 \<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
  3092
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
  3093
                 wprepare_loop_goon_in_middle.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3094
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3095
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3096
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
  3097
    \<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
  3098
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
  3099
                 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
  3100
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
  3101
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
  3102
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
  3103
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3104
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3105
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
  3106
  \<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
  3107
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
  3108
                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
  3109
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
  3110
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
  3111
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
  3112
apply(case_tac [!] rna, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3113
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
  3114
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
  3115
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
  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]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3119
  "\<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
  3120
  \<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
  3121
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
  3122
               wprepare_loop_goon_in_middle.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3123
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
  3124
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
  3125
apply(case_tac lm1, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3126
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
  3127
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
  3128
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
  3129
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3131
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
  3132
  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
  3133
apply(simp add: wprepare_loop_start.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3134
                wprepare_loop_goon.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3135
apply(erule_tac disjE, simp, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3136
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3137
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3138
lemma start_2_goon:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3139
  "\<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
  3140
   (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
  3141
  (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
  3142
apply(case_tac list, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3143
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3144
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3145
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
  3146
  \<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
  3147
                     (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
  3148
  (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
  3149
                 (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
  3150
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
  3151
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3152
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3153
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
  3154
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3155
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3156
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3157
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
  3158
  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
  3159
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
  3160
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
  3161
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
  3162
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3163
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3164
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
  3165
                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
  3166
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
  3167
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
  3168
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
  3169
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
  3170
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
  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 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
  3174
       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
  3175
apply(simp add: wprepare_loop_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3176
apply(erule_tac disjE, simp_all )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3177
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3178
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3179
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
  3180
apply(simp add: wprepare_loop_goon.simps     
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3181
                wprepare_loop_goon_in_middle.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3182
                wprepare_loop_goon_on_rightmost.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3183
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3184
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3185
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3186
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
  3187
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
  3188
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3189
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3190
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
  3191
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
  3192
done
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3193
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3194
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
  3195
         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
  3196
       \<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
  3197
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
  3198
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
  3199
apply(case_tac mr, simp, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3200
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3201
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3202
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
  3203
                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
  3204
       \<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
  3205
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
  3206
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
  3207
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
  3208
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
  3209
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
  3210
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3211
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3212
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
  3213
                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
  3214
                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
  3215
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
  3216
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
  3217
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3218
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3219
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
  3220
  \<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
  3221
apply(simp add: wprepare_loop_goon.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3222
                wprepare_loop_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3223
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3224
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3225
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
  3226
       \<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
  3227
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3228
apply(simp add: wprepare_add_one.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3229
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3230
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3231
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
  3232
              \<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
  3233
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
  3234
                 wprepare_loop_start_on_rightmost.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3235
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
  3236
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
  3237
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3238
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3239
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
  3240
       \<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
  3241
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
  3242
                 wprepare_loop_start_in_middle.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3243
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
  3244
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
  3245
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
  3246
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
  3247
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3248
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3249
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
  3250
       \<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
  3251
apply(case_tac lm, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3252
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
  3253
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3254
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3255
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
  3256
apply(auto simp: wprepare_add_one2.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 add_one_2_stop:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3260
  "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
  3261
  \<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
  3262
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
  3263
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3264
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3265
declare wprepare_stop.simps[simp del]
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 wprepare_correctness:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3268
  assumes h: "lm \<noteq> []"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3269
  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
  3270
  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
  3271
  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
  3272
    \<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
  3273
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3274
  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
  3275
  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
  3276
  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
  3277
  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
  3278
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3279
    show "wf wcode_prepare_le" by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3280
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3281
    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
  3282
                 ?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
  3283
      using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3284
      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
  3285
            simp add: step_red step.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3286
      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
  3287
      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
  3288
                 split: if_splits)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3289
      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
  3290
                           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
  3291
      apply(auto simp: wprepare_add_one2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3292
      done   
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3293
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3294
    show "?Q (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3295
      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
  3296
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3297
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3298
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3299
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3300
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3301
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3302
  thus "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3303
    apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3304
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3305
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3306
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3307
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
  3308
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
  3309
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3310
   
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3311
lemma t_correct_shift:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3312
         "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
  3313
          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
  3314
apply(auto simp: List.list_all_length)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3315
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
  3316
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
  3317
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3318
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3319
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
  3320
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
  3321
by arith
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3322
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3323
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
  3324
  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
  3325
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
  3326
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3327
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3328
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3329
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3330
lemma tm_wf_change_termi: "tm_wf (tp, 0) \<Longrightarrow> 
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3331
      list_all (\<lambda>(acn, st). (st \<le> Suc (length tp div 2))) (adjust0 tp)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3332
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
  3333
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
  3334
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
  3335
by (metis in_set_conv_nth)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3336
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3337
lemma tm_wf_shift:
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3338
         "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
  3339
          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
  3340
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
  3341
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
  3342
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
  3343
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3344
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3345
declare length_tp'[simp del]
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 [simp]: "length (mopup (Suc 0)) = 16"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3348
apply(auto simp: mopup.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3349
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3350
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3351
lemma [elim]: "(a, b) \<in> set (shift (adjust0 t_twice_compile) 12) \<Longrightarrow> 
131
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(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
  3354
proof -
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3355
  assume g: "(a, b)
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3356
    \<in> set (shift
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3357
            (adjust
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3358
              (tm_of abc_twice @
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3359
               shift (mopup (Suc 0)) (length (tm_of abc_twice) div 2))
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3360
              (Suc ((length (tm_of abc_twice) + 16) div 2)))
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3361
            12)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3362
  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
  3363
  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
  3364
  ultimately have "list_all (\<lambda>(acn, st). (st \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2)) 
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3365
    (shift (adjust0 t_twice_compile) 12)"
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3366
  proof(auto simp add: mod_ex1 del: adjust.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3367
    fix q qa
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3368
    assume h: "length (tm_of abc_twice) = 2 * q" "length (tm_of abc_fourtimes) = 2 * qa"
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3369
    hence "list_all (\<lambda>(acn, st). st \<le> (18 + (q + qa)) + 12) (shift (adjust0 t_twice_compile) 12)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3370
    proof(rule_tac tm_wf_shift t_twice_compile_def)
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3371
      have "list_all (\<lambda>(acn, st). st \<le> Suc (length t_twice_compile div 2)) (adjust0 t_twice_compile)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3372
        by(rule_tac tm_wf_change_termi, auto)
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3373
      thus "list_all (\<lambda>(acn, st). st \<le> 18 + (q + qa)) (adjust0 t_twice_compile)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3374
        using h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3375
        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
  3376
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3377
    qed
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3378
    thus "list_all (\<lambda>(acn, st). st \<le> 30 + (q + qa))
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3379
           (shift
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3380
             (adjust t_twice_compile (Suc (length t_twice_compile div 2))) 12)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3381
      by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3382
  qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3383
  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
  3384
    using g
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3385
    apply(auto simp:t_twice_compile_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3386
    apply(simp add: Ball_set[THEN sym])
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3387
    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
  3388
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3389
qed 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3390
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3391
lemma [elim]: "(a, b) \<in> set (shift (adjust0 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
  3392
  \<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
  3393
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
  3394
proof -
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3395
  assume g: "(a, b)
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3396
    \<in> set (shift
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3397
            (adjust
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3398
              (tm_of abc_fourtimes @
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3399
               shift (mopup (Suc 0)) (length (tm_of abc_fourtimes) div 2))
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3400
              (Suc ((length (tm_of abc_fourtimes) + 16) div 2)))
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3401
            (length t_twice div 2 + 13))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3402
  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
  3403
  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
  3404
  ultimately have "list_all (\<lambda>(acn, st). (st \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2)) 
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3405
    (shift (adjust0 (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
  3406
    (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
  3407
  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
  3408
    fix q qa
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3409
    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
  3410
    hence "list_all (\<lambda>(acn, st). st \<le> (9 + qa + (21 + q)))
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3411
      (shift (adjust0 (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
  3412
    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
  3413
      have "list_all (\<lambda>(acn, st). st \<le> Suc (length (tm_of abc_fourtimes @ shift 
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3414
        (mopup (Suc 0)) qa) div 2)) (adjust0 (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
  3415
        apply(rule_tac tm_wf_change_termi)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3416
        using wf_fourtimes h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3417
        apply(simp add: t_fourtimes_compile_def)
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3418
        done
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3419
      thus "list_all (\<lambda>(acn, st). st \<le> 9 + qa)
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3420
        (adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa)
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3421
          (Suc (length (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa) div
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3422
                2)))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3423
        using h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3424
        apply(simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3425
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3426
    qed
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3427
    thus "list_all (\<lambda>(acn, st). st \<le> 30 + (q + qa))
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3428
           (shift
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3429
             (adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa)
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3430
               (9 + qa))
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3431
             (21 + q))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3432
      apply(subgoal_tac "qa + q = q + qa")
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3433
      apply(simp add: h)
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3434
      apply(simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3435
      done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3436
  qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3437
  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
  3438
    using g
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3439
    apply(simp add: Ball_set[THEN sym])
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3440
    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
  3441
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3442
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3443
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3444
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
  3445
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
  3446
                 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
  3447
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3448
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3449
declare tm_comp.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3450
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
  3451
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
  3452
                 tm_comp.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3453
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3454
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3455
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
  3456
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
  3457
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3458
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3459
lemma prepare_mainpart_lemma:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3460
  "args \<noteq> [] \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3461
  \<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
  3462
              = (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
  3463
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3464
  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
  3465
  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
  3466
  let ?P2 = ?Q1
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3467
  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
  3468
                           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
  3469
  let ?P3 = "\<lambda> tp. False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3470
  assume h: "args \<noteq> []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3471
  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
  3472
  proof(rule_tac Hoare_plus_halt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3473
    show "{?P1} t_wcode_prepare {?Q1}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3474
    proof(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3475
      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
  3476
        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
  3477
        using wprepare_correctness[of args m] h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3478
        apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3479
        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
  3480
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3481
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3482
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3483
    show "{?P2} t_wcode_main {?Q2}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3484
    proof(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3485
      fix l r
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3486
      assume "wprepare_stop m args (l, r)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3487
      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
  3488
              (\<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
  3489
        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
  3490
      proof(auto simp: wprepare_stop.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3491
        fix rn
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3492
        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
  3493
          (\<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
  3494
          (\<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
  3495
          Bk # Bk # Oc \<up> bl_bin (<args>) @
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3496
          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
  3497
          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
  3498
          apply(auto simp: tape_of_nl_rev)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3499
          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
  3500
          done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3501
      qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3502
    qed
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3503
  next
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3504
    show "tm_wf0 t_wcode_prepare"
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3505
      by auto
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3506
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3507
  thus "?thesis"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3508
    apply(auto simp: Hoare_halt_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3509
    apply(rule_tac x = n in exI)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3510
    apply(case_tac "(steps0 (Suc 0, [], <m # args>)
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  3511
      (adjust0 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
  3512
    apply(auto simp: tm_comp.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3513
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3514
qed
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3515
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3516
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
  3517
  where
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  3518
  "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
  3519
   
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3520
lemma [simp]:  "tinres r r' \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3521
  fetch t ss (read r) = 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3522
  fetch t ss (read r')"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3523
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
  3524
apply(case_tac [!] n, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3525
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3526
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3527
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
  3528
by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3529
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3530
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
  3531
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3532
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3533
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3534
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
  3535
apply(simp add: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3536
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3537
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3538
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
  3539
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3540
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3541
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3542
lemma [simp]: "\<lbrakk>tinres [] r'; r' \<noteq> []\<rbrakk> \<Longrightarrow> hd r' = Bk"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3543
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3544
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3545
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3546
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
  3547
apply(case_tac r, simp)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3548
apply(case_tac n, simp, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3549
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
  3550
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
  3551
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3552
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3553
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
  3554
apply(auto simp: tinres_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3555
apply(case_tac r', simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3556
apply(case_tac n, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3557
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
  3558
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
  3559
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3560
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3561
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
  3562
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
  3563
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
  3564
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
  3565
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3566
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3567
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
  3568
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
  3569
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
  3570
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
  3571
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3572
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3573
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
  3574
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3575
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3576
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3577
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
  3578
apply(auto simp: tinres_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3579
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3580
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3581
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
  3582
apply(auto simp: tinres_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3583
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3584
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3585
lemma tinres_step2: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3586
  "\<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
  3587
    \<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
  3588
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
  3589
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
  3590
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
  3591
apply(auto simp: update.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3592
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
  3593
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3594
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3595
lemma tinres_steps2: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3596
  "\<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
  3597
    \<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
  3598
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
  3599
apply(simp add: step_red)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3600
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
  3601
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
  3602
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3603
  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
  3604
  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
  3605
    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
  3606
  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
  3607
         "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
  3608
         "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
  3609
  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
  3610
    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
  3611
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3612
  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
  3613
    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
  3614
            and t = t in tinres_step2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3615
    using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3616
    apply(simp, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3617
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3618
qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3619
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3620
definition t_wcode_adjust :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3621
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3622
  "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
  3623
                   (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
  3624
                   (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
  3625
                    (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
  3626
                 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3627
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
  3628
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
  3629
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3630
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3631
lemma [simp]: "fetch t_wcode_adjust (Suc 0) Oc = (R, 2)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3632
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3633
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3634
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3635
lemma [simp]: "fetch t_wcode_adjust (Suc (Suc 0)) Oc = (R, 3)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3636
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3637
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3638
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3639
lemma [simp]: "fetch t_wcode_adjust (Suc (Suc (Suc 0))) Oc = (R, 4)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3640
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3641
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3642
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3643
lemma [simp]: "fetch t_wcode_adjust  (Suc (Suc (Suc 0))) Bk = (R, 3)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3644
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3645
done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3646
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  3647
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
  3648
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
  3649
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3650
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  3651
lemma [simp]: "fetch t_wcode_adjust 4 Oc = (L, 5)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3652
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_4_eq_4)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3653
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3654
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3655
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
  3656
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
  3657
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3658
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3659
lemma [simp]: "fetch t_wcode_adjust 5 Bk = (L, 6)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3660
apply(simp only: fetch.simps t_wcode_adjust_def nth_of.simps numeral_5_eq_5, auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3661
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3662
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3663
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
  3664
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
  3665
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3666
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3667
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
  3668
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
  3669
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3670
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3671
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
  3672
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
  3673
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3674
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3675
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
  3676
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
  3677
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3678
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3679
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
  3680
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
  3681
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3682
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3683
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
  3684
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
  3685
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3686
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3687
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
  3688
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
  3689
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3690
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3691
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
  3692
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
  3693
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3694
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3695
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
  3696
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
  3697
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3698
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3699
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
  3700
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
  3701
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3702
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3703
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
  3704
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
  3705
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3706
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3707
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
  3708
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3709
  "wadjust_start m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3710
         (\<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
  3711
                   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
  3712
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3713
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
  3714
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3715
  "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
  3716
          (\<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
  3717
                          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
  3718
                          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
  3719
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3720
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
  3721
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3722
  "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
  3723
   (\<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
  3724
                      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
  3725
                      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
  3726
                      nl + nr > 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3727
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3728
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
  3729
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3730
  "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
  3731
  (\<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
  3732
                  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
  3733
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3734
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
  3735
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3736
  "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
  3737
    (\<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
  3738
                    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
  3739
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3740
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
  3741
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3742
  "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
  3743
      (\<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
  3744
                      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
  3745
                      ml + mr = Suc rs \<and> mr > 0)"
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_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
  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_B 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 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
  3751
                         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
  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 :: "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 m rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3757
       (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
  3758
       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
  3759
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3760
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
  3761
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3762
  "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
  3763
        (\<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
  3764
                        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
  3765
                        ml + mr = Suc rs \<and> mr > 0)"
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_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
  3768
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3769
  "wadjust_erase2 m rs (l, r) = 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3770
     (\<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
  3771
                     tl r = Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3772
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3773
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
  3774
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3775
  "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
  3776
        (\<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
  3777
                  r = Oc # Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3778
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3779
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
  3780
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3781
  "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
  3782
         (\<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
  3783
                   r = Bk\<up>(rn))"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3784
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3785
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
  3786
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3787
  "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
  3788
      (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
  3789
       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
  3790
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3791
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
  3792
  where 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3793
  "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
  3794
        (\<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
  3795
               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
  3796
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3797
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
  3798
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3799
  "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
  3800
      (\<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
  3801
                      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
  3802
                      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
  3803
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3804
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
  3805
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3806
  "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
  3807
            (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
  3808
             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
  3809
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3810
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
  3811
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3812
  "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
  3813
        (\<exists> rn. l = [] \<and> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3814
               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
  3815
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3816
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
  3817
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3818
  "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
  3819
      (\<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
  3820
                      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
  3821
                      ml + mr = Suc m \<and> mr > 0)"
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 :: "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 m rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3826
        (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
  3827
        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
  3828
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3829
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
  3830
where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3831
  "wadjust_stop m rs (l, r) =
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3832
        (\<exists> rn. l = [Bk] \<and> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3833
               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
  3834
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3835
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
  3836
        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
  3837
        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
  3838
        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
  3839
        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
  3840
        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
  3841
        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
  3842
        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
  3843
        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
  3844
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3845
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
  3846
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3847
  "wadjust_inv st m rs (l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3848
       (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
  3849
        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
  3850
        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
  3851
        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
  3852
        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
  3853
        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
  3854
        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
  3855
        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
  3856
        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
  3857
        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
  3858
        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
  3859
        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
  3860
        else False
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3861
)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3862
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3863
declare wadjust_inv.simps[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3864
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3865
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
  3866
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3867
  "wadjust_phase rs (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3868
         (if st = 1 then 3 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3869
          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
  3870
          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
  3871
          else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3872
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3873
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
  3874
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3875
  "wadjust_stage rs (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3876
           (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
  3877
                  rs - length (takeWhile (\<lambda> a. a = Oc) 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3878
                          (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
  3879
            else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3880
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3881
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
  3882
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3883
  "wadjust_state rs (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3884
       (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
  3885
        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
  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_step :: "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_step rs (st, l, r) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3891
       (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
  3892
                        else 0) 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3893
        else if st = 3 then length r
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3894
        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
  3895
                             else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3896
        else if st = 6 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3897
        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
  3898
                             else 0)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3899
        else if st = 9 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3900
        else if st = 10 then length l
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3901
        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
  3902
                              else Suc (length l))
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3903
        else 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3904
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3905
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
  3906
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3907
  "wadjust_measure (rs, (st, l, r)) = 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3908
     (wadjust_phase rs (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3909
      wadjust_stage rs (st, l, r),
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3910
      wadjust_state rs (st, l, r), 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3911
      wadjust_step rs (st, l, r))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3912
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3913
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
  3914
  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
  3915
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3916
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
  3917
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
  3918
  Abacus.lex_triple_def)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3919
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3920
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
  3921
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
  3922
           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
  3923
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3924
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
  3925
apply(auto simp: wadjust_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3926
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3927
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3928
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
  3929
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
  3930
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3931
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3932
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
  3933
        \<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
  3934
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
  3935
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3936
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3937
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3938
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
  3939
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
  3940
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3941
 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3942
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
  3943
apply(simp add: wadjust_loop_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3944
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3945
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3946
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
  3947
  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
  3948
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
  3949
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3950
apply(auto)
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_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
  3954
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
  3955
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3956
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3957
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
  3958
    \<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
  3959
        (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
  3960
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
  3961
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3962
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3963
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
  3964
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
  3965
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3966
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3967
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3968
lemma [simp]: "wadjust_loop_right_move2 m rs (c, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3969
apply(auto simp: wadjust_loop_right_move2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3970
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3971
   
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3972
lemma [simp]: "wadjust_erase2 m rs ([], []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3973
apply(auto simp: wadjust_erase2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3974
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3975
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3976
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
  3977
                 (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
  3978
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
  3979
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3980
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3981
lemma [simp]: "wadjust_on_left_moving_B m rs 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3982
                 (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
  3983
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
  3984
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
  3985
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3986
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3987
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
  3988
            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
  3989
apply(simp only: wadjust_erase2.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3990
apply(erule_tac exE)+
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  3991
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
  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]: "wadjust_erase2 m rs (c, [])
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3995
    \<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
  3996
       (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
  3997
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3998
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3999
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4000
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
  4001
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
  4002
  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
  4003
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4004
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4005
lemma [simp]: "wadjust_on_left_moving_O m rs (c, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4006
apply(simp add: wadjust_on_left_moving_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4007
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4008
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4009
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
  4010
                                      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
  4011
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
  4012
apply(case_tac [!] ln, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4013
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4014
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4015
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
  4016
                                  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
  4017
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
  4018
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
  4019
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4020
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4021
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
  4022
  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
  4023
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
  4024
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4025
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4026
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4027
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
  4028
    \<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
  4029
       (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
  4030
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4031
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4032
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4033
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
  4034
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
  4035
                 wadjust_goon_left_moving_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4036
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4037
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4038
lemma [simp]: "wadjust_backto_standard_pos m rs (c, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4039
apply(auto simp: wadjust_backto_standard_pos.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4040
 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
  4041
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4042
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4043
lemma [simp]:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4044
  "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
  4045
  (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
  4046
  (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
  4047
apply(auto simp: wadjust_start.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]: "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
  4051
apply(auto simp: wadjust_loop_start.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4052
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4053
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4054
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
  4055
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
  4056
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4057
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4058
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
  4059
    \<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
  4060
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
  4061
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4062
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
  4063
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
  4064
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
  4065
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
  4066
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
  4067
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4068
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4069
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
  4070
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
  4071
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4072
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4073
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
  4074
              \<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
  4075
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
  4076
apply(case_tac [!] mr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4077
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4078
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4079
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
  4080
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
  4081
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4082
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4083
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
  4084
        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
  4085
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4086
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
  4087
    \<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
  4088
apply(simp only: wadjust_loop_erase.simps 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4089
  wadjust_loop_on_left_moving_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4090
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4091
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
  4092
      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
  4093
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
  4094
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
  4095
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4096
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4097
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
  4098
             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
  4099
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
  4100
       auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4101
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
  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> []\<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 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
  4106
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
  4107
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4108
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4109
lemma [simp]: "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
  4110
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
  4111
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
  4112
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4113
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4114
lemma [simp]: "wadjust_loop_on_left_moving_O m rs (c, Bk # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4115
apply(simp add: wadjust_loop_on_left_moving_O.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4116
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4117
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4118
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
  4119
    \<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
  4120
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
  4121
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4122
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
  4123
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
  4124
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
  4125
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4126
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4127
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
  4128
    \<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
  4129
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
  4130
                 wadjust_loop_on_left_moving_B.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4131
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4132
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
  4133
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
  4134
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4135
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4136
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
  4137
            \<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
  4138
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
  4139
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4140
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4141
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4142
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
  4143
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
  4144
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4145
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4146
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
  4147
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
  4148
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
  4149
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
  4150
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
  4151
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
  4152
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
  4153
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
  4154
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
  4155
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4156
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4157
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
  4158
apply(auto simp:wadjust_erase2.simps )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4159
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4160
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4161
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
  4162
                 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
  4163
apply(auto simp: wadjust_erase2.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4164
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
  4165
        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
  4166
apply(auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4167
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
  4168
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
  4169
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
  4170
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4171
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4172
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
  4173
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
  4174
                wadjust_on_left_moving_O.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4175
                wadjust_on_left_moving_B.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4176
             , auto)
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_O m rs (c, Bk # list) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4180
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
  4181
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4182
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4183
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
  4184
    \<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
  4185
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
  4186
apply(case_tac ln, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4187
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4188
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4189
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
  4190
    \<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
  4191
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
  4192
                 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 add: )
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]: "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
  4197
                  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
  4198
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
  4199
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4200
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4201
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4202
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
  4203
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
  4204
                wadjust_goon_left_moving_B.simps
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4205
                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
  4206
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4207
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4208
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
  4209
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
  4210
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
  4211
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4212
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4213
lemma [simp]: "\<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
  4214
    \<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
  4215
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
  4216
                 wadjust_backto_standard_pos_B.simps )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4217
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4218
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4219
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
  4220
    \<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
  4221
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
  4222
                 wadjust_backto_standard_pos_O.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4223
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4224
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4225
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
  4226
  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
  4227
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
  4228
                                     wadjust_goon_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4229
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4230
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4231
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
  4232
  (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
  4233
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
  4234
                 wadjust_backto_standard_pos_B.simps
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4235
                 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
  4236
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
  4237
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4238
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4239
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
  4240
              \<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
  4241
                (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
  4242
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
  4243
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
  4244
      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
  4245
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4246
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4247
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
  4248
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
  4249
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4250
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4251
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
  4252
              \<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
  4253
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
  4254
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
  4255
      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
  4256
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
  4257
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4258
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4259
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
  4260
                       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
  4261
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
  4262
                 wadjust_loop_check.simps, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4263
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
  4264
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
  4265
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
  4266
apply(case_tac [!] nr, simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4267
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4268
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4269
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
  4270
               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
  4271
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
  4272
apply(erule_tac exE)+
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4273
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
  4274
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
  4275
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4276
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4277
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
  4278
                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
  4279
apply(auto simp: wadjust_loop_erase.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4280
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4281
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4282
lemma [simp]: "wadjust_loop_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
  4283
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
  4284
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
  4285
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4286
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4287
lemma [simp]: "wadjust_loop_on_left_moving m rs (c, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4288
           \<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
  4289
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
  4290
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
  4291
                 wadjust_loop_right_move2.simps)
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_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
  4295
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
  4296
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
  4297
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4298
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4299
lemma [simp]: "wadjust_erase2 m rs (c, Oc # list)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4300
              \<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
  4301
               \<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
  4302
apply(auto simp: wadjust_erase2.simps )
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4303
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4304
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4305
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
  4306
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
  4307
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4308
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4309
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
  4310
         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
  4311
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
  4312
     wadjust_goon_left_moving_B.simps )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4313
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4314
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4315
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
  4316
    \<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
  4317
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
  4318
                 wadjust_goon_left_moving_O.simps )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4319
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
  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
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4323
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
  4324
              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
  4325
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
  4326
                 wadjust_goon_left_moving.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4327
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4328
done
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_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
  4338
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
  4339
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4340
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4341
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
  4342
               \<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
  4343
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
  4344
apply(case_tac [!] ml, auto simp: )
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4345
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4346
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4347
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
  4348
  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
  4349
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
  4350
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
  4351
apply(case_tac ml, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4352
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
  4353
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4354
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4355
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
  4356
  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
  4357
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
  4358
apply(case_tac "hd c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4359
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4360
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4361
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
  4362
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
  4363
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4364
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4365
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
  4366
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
  4367
apply(case_tac mr, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4368
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4369
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4370
lemma [simp]: "wadjust_backto_standard_pos_O m rs ([], Oc # list) \<Longrightarrow> 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4371
  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
  4372
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
  4373
                 wadjust_backto_standard_pos_B.simps)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4374
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4375
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4376
lemma [simp]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4377
  "\<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
  4378
  \<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
  4379
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
  4380
        wadjust_backto_standard_pos_B.simps, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4381
done 
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]: "\<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
  4384
          \<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
  4385
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
  4386
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
  4387
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4388
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4389
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
  4390
  \<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
  4391
 (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
  4392
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
  4393
apply(case_tac "hd c", simp_all)
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_loop_right_move m rs (c, []) = False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4397
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
  4398
apply(rule_tac iffI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4399
apply(erule_tac exE)+
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4400
apply(case_tac nr, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4401
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
  4402
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4403
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4404
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
  4405
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
  4406
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4407
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4408
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
  4409
  \<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
  4410
  < 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
  4411
  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
  4412
  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
  4413
apply(simp only: wadjust_loop_erase.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4414
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4415
apply(case_tac c, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4416
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4417
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4418
lemma [simp]:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4419
  "\<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
  4420
  \<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
  4421
  < 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
  4422
  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
  4423
  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
  4424
apply(subgoal_tac "c \<noteq> []")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4425
apply(case_tac c, simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4426
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4427
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4428
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
  4429
apply(induct n, simp_all add: )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4430
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4431
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
  4432
apply(induct n, simp_all add: )
130
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
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4435
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
  4436
              \<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
  4437
                 < 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
  4438
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
  4439
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
  4440
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
  4441
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4442
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4443
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
  4444
apply(simp add: wadjust_loop_check.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4445
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4446
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4447
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
  4448
  \<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
  4449
  < 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
  4450
  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
  4451
  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
  4452
apply(case_tac "c", simp_all)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4453
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4454
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4455
lemma [simp]: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4456
  "\<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
  4457
  \<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
  4458
  < 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
  4459
  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
  4460
  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
  4461
apply(simp add: wadjust_loop_erase.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4462
apply(rule_tac disjI2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4463
apply(auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4464
apply(simp add: dropWhile_exp1 takeWhile_exp1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4465
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4466
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4467
declare numeral_2_eq_2[simp del]
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4468
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4469
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
  4470
       \<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
  4471
apply(auto simp: wadjust_start.simps)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4472
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4473
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4474
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
  4475
       \<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
  4476
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
  4477
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
  4478
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4479
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4480
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
  4481
       \<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
  4482
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
  4483
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
  4484
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
  4485
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
  4486
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4487
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4488
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
  4489
       \<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
  4490
apply(auto simp: wadjust_erase2.simps)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4491
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4492
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4493
lemma wadjust_correctness:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4494
  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
  4495
  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
  4496
  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
  4497
                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
  4498
    \<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
  4499
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4500
  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
  4501
  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
  4502
  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
  4503
                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
  4504
  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
  4505
  proof(rule_tac halt_lemma2)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4506
    show "wf wadjust_le" by auto
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4507
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4508
    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
  4509
                 ?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
  4510
      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
  4511
      apply(simp add: step.simps)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4512
      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
  4513
      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
  4514
      apply(simp_all)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4515
      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
  4516
            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
  4517
      done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4518
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4519
    show "?Q (?f 0)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4520
      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
  4521
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4522
  next
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4523
    show "\<not> ?P (?f 0)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4524
      apply(simp add: steps.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4525
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4526
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4527
  thus"?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4528
    apply(simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4529
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4530
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4531
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4532
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
  4533
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
  4534
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4535
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4536
declare tm_comp.simps[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4537
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4538
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
  4539
apply(case_tac args)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4540
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
  4541
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4542
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4543
lemma wcode_lemma_pre':
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4544
  "args \<noteq> [] \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4545
  \<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
  4546
              ((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
  4547
  = (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
  4548
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4549
  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
  4550
  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
  4551
    (\<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
  4552
  let ?P2 = ?Q1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4553
  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
  4554
  let ?P3 = "\<lambda> tp. False"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4555
  assume h: "args \<noteq> []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4556
  hence a: "bl_bin (<args>) > 0"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4557
    using h by simp
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4558
  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
  4559
  proof(rule_tac Hoare_plus_halt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4560
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4561
    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
  4562
      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
  4563
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4564
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4565
    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
  4566
    proof(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4567
      show 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4568
        "\<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
  4569
        (\<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
  4570
        (\<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
  4571
        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
  4572
        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
  4573
        apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4574
        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
  4575
        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
  4576
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4577
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4578
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4579
    show "{?P2} t_wcode_adjust {?Q2}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4580
    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
  4581
      fix ln rn
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4582
      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
  4583
        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
  4584
        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
  4585
        (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
  4586
        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
  4587
        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
  4588
        apply(rule_tac x = n in exI)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4589
        using a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4590
        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
  4591
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4592
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4593
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4594
  thus "?thesis"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4595
    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
  4596
    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
  4597
      ((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
  4598
    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
  4599
    using a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4600
    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
  4601
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4602
qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4603
    
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4604
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4605
  The initialization TM @{text "t_wcode"}.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4606
  *}
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4607
definition t_wcode :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4608
  where
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
  4609
  "t_wcode = (t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust        "
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4610
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4611
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4612
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4613
  The correctness of @{text "t_wcode"}.
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4614
  *}
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4615
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4616
lemma wcode_lemma_1:
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4617
  "args \<noteq> [] \<Longrightarrow> 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4618
  \<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
  4619
              (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
  4620
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
  4621
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4622
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4623
lemma wcode_lemma: 
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],  <[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
  4627
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
  4628
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
  4629
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4630
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4631
section {* The universal TM *}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4632
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4633
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4634
  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
  4635
  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
  4636
  *}
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
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4639
definition UTM :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4640
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4641
  "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
  4642
          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
  4643
          (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
  4644
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4645
definition F_aprog :: "abc_prog"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4646
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4647
  "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
  4648
                       aprog [+] dummy_abc (Suc (Suc 0)))"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4649
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4650
definition F_tprog :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4651
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4652
  "F_tprog = tm_of (F_aprog)"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4653
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4654
definition t_utm :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4655
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4656
  "t_utm \<equiv>
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4657
     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
  4658
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4659
definition UTM_pre :: "instr list"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4660
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4661
  "UTM_pre = t_wcode |+| t_utm"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4662
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4663
lemma tinres_step1: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4664
  "\<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
  4665
                 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
  4666
    \<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
  4667
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
  4668
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
  4669
        split: if_splits )
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4670
apply(case_tac [!] "t ! (2 * nat)", 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4671
     auto simp: tinres_def split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4672
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
  4673
apply(case_tac [!] "t ! (2 * nat)", 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4674
     auto simp: tinres_def split: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4675
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
  4676
apply(case_tac [!] "t ! Suc (2 * nat)", 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4677
     auto simp: if_splits)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4678
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
  4679
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4680
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4681
lemma tinres_steps1: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4682
  "\<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
  4683
                 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
  4684
    \<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
  4685
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
  4686
apply(simp add: step_red)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4687
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
  4688
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
  4689
proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4690
  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
  4691
  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
  4692
          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
  4693
  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
  4694
         "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
  4695
         "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
  4696
  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
  4697
    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
  4698
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4699
  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
  4700
    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
  4701
            and t = t in tinres_step1)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4702
    using h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4703
    apply(simp, simp, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4704
    done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4705
qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4706
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4707
lemma [simp]: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4708
  "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
  4709
apply(auto simp: tinres_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4710
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
  4711
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
  4712
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
  4713
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
  4714
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
  4715
apply(simp only: exp_ind, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4716
apply(subgoal_tac "m = length la + nata")
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4717
apply(rule_tac x = "m - nata" in exI, simp add: replicate_add)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4718
apply(drule_tac length_equal, simp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4719
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
  4720
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
  4721
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4722
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4723
lemma t_utm_halt_eq: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4724
  assumes tm_wf: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4725
  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
  4726
  and resutl: "0 < rs"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4727
  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
  4728
                                                (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
  4729
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4730
  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
  4731
    by (metis prod_cases3) 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4732
  moreover have b: "rec_exec rec_F [code tp, (bl2wc (<lm>))] = (rs - Suc 0)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4733
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4734
    apply(rule_tac F_correct, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4735
    done 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4736
  have "\<exists> stp m l. steps0 (Suc 0, Bk # Bk # [], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4737
    (F_tprog @ shift (mopup (length [code tp, bl2wc (<lm>)])) (length F_tprog div 2)) stp
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4738
    = (0, Bk\<up>m @ Bk # Bk # [], Oc\<up>Suc (rec_exec rec_F [code tp, (bl2wc (<lm>))]) @ Bk\<up>l)"  
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4739
  proof(rule_tac recursive_compile_to_tm_correct1)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4740
    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
  4741
  next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4742
    show "terminate rec_F [code tp, bl2wc (<lm>)]"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4743
      using assms
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4744
      by(rule_tac terminate_F, simp_all)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4745
  next
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4746
    show "F_tprog = tm_of (ap [+] dummy_abc (length [code tp, bl2wc (<lm>)]))"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4747
      using a
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4748
      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
  4749
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4750
  qed
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4751
  then obtain stp m l where 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4752
    "steps0 (Suc 0, Bk # Bk # [], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4753
    (F_tprog @ shift (mopup (length [code tp, (bl2wc (<lm>))])) (length F_tprog div 2)) stp
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4754
    = (0, Bk\<up>m @ Bk # Bk # [], Oc\<up>Suc (rec_exec rec_F [code tp, (bl2wc (<lm>))]) @ Bk\<up>l)" by blast
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4755
  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
  4756
    (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
  4757
    = (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
  4758
  proof -
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4759
    assume g: "steps0 (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk \<up> i)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4760
      (F_tprog @ shift (mopup (length [code tp, bl2wc (<lm>)])) (length F_tprog div 2)) stp =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4761
      (0, Bk \<up> m @ [Bk, Bk], Oc \<up> Suc ((rec_exec rec_F [code tp, bl2wc (<lm>)])) @ Bk \<up> l)"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4762
   moreover have "tinres [Bk, Bk] [Bk]"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4763
     apply(auto simp: tinres_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4764
     done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4765
    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
  4766
    (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
  4767
      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
  4768
    (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
  4769
      done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4770
    ultimately show "?thesis"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4771
      using b
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4772
      apply(drule_tac la = "Bk\<up>m @ [Bk, Bk]" in tinres_steps1, auto simp: numeral_2_eq_2)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4773
      done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4774
  qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4775
  thus "?thesis"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4776
    apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4777
    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
  4778
    using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4779
    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
  4780
    done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4781
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4782
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4783
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
  4784
apply(simp add: t_wcode_def)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4785
apply(rule_tac tm_wf_comp)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4786
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
  4787
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4788
      
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4789
lemma [intro]: "tm_wf (t_utm, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4790
apply(simp only: t_utm_def F_tprog_def)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4791
apply(rule_tac wf_tm_from_abacus, auto)
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4792
done 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4793
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4794
lemma UTM_halt_lemma_pre: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4795
  assumes wf_tm: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4796
  and result: "0 < rs"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4797
  and args: "args \<noteq> []"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4798
  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
  4799
  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
  4800
                                                (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
  4801
proof -
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4802
  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
  4803
  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
  4804
  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
  4805
    (\<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
  4806
  let ?P2 = ?Q1
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4807
  let ?P3 = "\<lambda> (l, r). False"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4808
  have "{?P1} (t_wcode |+| t_utm) {?Q2}"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4809
  proof(rule_tac Hoare_plus_halt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4810
    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
  4811
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4812
    show "{?P1} t_wcode {?Q1}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4813
      apply(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4814
      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
  4815
      apply(auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4816
      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
  4817
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4818
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4819
    show "{?P2} t_utm {?Q2}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4820
    proof(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4821
      fix rn
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4822
      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
  4823
        (\<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
  4824
        (\<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
  4825
        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
  4826
        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
  4827
      apply(auto simp: bin_wc_eq)
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4828
      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
  4829
      done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4830
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4831
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4832
  thus "?thesis"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  4833
    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
  4834
    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
  4835
    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
  4836
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4837
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4838
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4839
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4840
  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
  4841
*}
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  4842
lemma UTM_halt_lemma': 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4843
  assumes tm_wf: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4844
  and result: "0 < rs"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4845
  and args: "args \<noteq> []"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4846
  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
  4847
  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
  4848
                                                (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
  4849
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
  4850
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
  4851
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
  4852
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4853
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4854
definition TSTD:: "config \<Rightarrow> bool"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4855
  where
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4856
  "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
  4857
             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
  4858
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4859
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
  4860
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
  4861
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4862
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4863
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
  4864
apply(rule classical, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4865
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
  4866
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
  4867
  add: bl2nat.simps bl2nat_double)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4868
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
  4869
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
  4870
done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4871
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4872
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
  4873
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
  4874
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4875
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4876
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
  4877
apply(induct x arbitrary: y, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4878
apply(case_tac y, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4879
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4880
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4881
declare replicate_Suc[simp del]
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4882
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4883
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
  4884
apply(auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4885
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
  4886
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
  4887
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4888
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4889
lemma bl2wc_exp_ex: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4890
  "\<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
  4891
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
  4892
apply(case_tac a, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4893
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
  4894
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
  4895
  simp add: replicate_Suc)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4896
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
  4897
apply(case_tac m, simp, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4898
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4899
  fix c m nat
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4900
  assume ind: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4901
    "\<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
  4902
  and h: 
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4903
    "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
  4904
  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
  4905
    apply(rule_tac m = nat in ind)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4906
    using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4907
    apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4908
    done
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4909
  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
  4910
  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
  4911
    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
  4912
    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
  4913
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4914
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4915
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4916
lemma lg_bin: 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4917
  "\<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
  4918
  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
  4919
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
  4920
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
  4921
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
  4922
  erule_tac x = n in allE, simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4923
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
  4924
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
  4925
  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
  4926
apply(simp add: bl2wc.simps)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4927
apply(rule_tac x = rs in exI)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4928
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
  4929
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4930
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4931
lemma nstd_case3: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4932
  "\<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
  4933
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
  4934
apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4935
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
  4936
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4937
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4938
lemma NSTD_1: "\<not> TSTD (a, b, c)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4939
    \<Longrightarrow> rec_exec rec_NSTD [trpl_code (a, b, c)] = Suc 0"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4940
  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
  4941
       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
  4942
  apply(simp add: TSTD_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4943
  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
  4944
  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
  4945
  apply(erule_tac nstd_case3)
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 nonstop_t_uhalt_eq:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4949
  "\<lbrakk>tm_wf (tp, 0);
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4950
  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
  4951
  \<not> TSTD (a, b, c)\<rbrakk>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4952
  \<Longrightarrow> rec_exec rec_nonstop [code tp, bl2wc (<lm>), stp] = Suc 0"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4953
apply(simp add: rec_nonstop_def rec_exec.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4954
apply(subgoal_tac 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4955
  "rec_exec rec_conf [code tp, bl2wc (<lm>), stp] =
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4956
  trpl_code (a, b, c)", simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4957
apply(erule_tac NSTD_1)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4958
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
  4959
apply(simp)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4960
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4961
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4962
lemma nonstop_true:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4963
  "\<lbrakk>tm_wf (tp, 0);
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  4964
  \<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp))\<rbrakk>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4965
  \<Longrightarrow> \<forall>y. rec_exec rec_nonstop ([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
  4966
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
  4967
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
  4968
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
  4969
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4970
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4971
lemma cn_arity:  "rec_ci (Cn n f gs) = (a, b, c) \<Longrightarrow> b = n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4972
by(case_tac "rec_ci f", simp add: rec_ci.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4973
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4974
lemma mn_arity: "rec_ci (Mn n f) = (a, b, c) \<Longrightarrow> b = n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4975
by(case_tac "rec_ci f", simp add: rec_ci.simps)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4976
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4977
lemma F_aprog_uhalt: 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4978
  assumes wf_tm: "tm_wf (tp,0)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4979
   and unhalt:  "\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp))"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4980
   and compile: "rec_ci rec_F = (F_ap, rs_pos, a_md)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4981
 shows "{\<lambda> nl. nl = [code tp, bl2wc (<lm>)] @ 0\<up>(a_md - rs_pos ) @ suflm} (F_ap) \<up>"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4982
  using compile
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4983
proof(simp only: rec_F_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4984
  assume h: "rec_ci (Cn (Suc (Suc 0)) rec_valu [Cn (Suc (Suc 0)) rec_right [Cn (Suc (Suc 0)) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4985
    rec_conf [recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), rec_halt]]]) =
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4986
    (F_ap, rs_pos, a_md)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4987
  moreover hence "rs_pos = Suc (Suc 0)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4988
    using cn_arity 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4989
    by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4990
  moreover obtain ap1 ar1 ft1 where a: "rec_ci 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4991
    (Cn (Suc (Suc 0)) rec_right 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4992
    [Cn (Suc (Suc 0)) rec_conf [recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), rec_halt]]) = (ap1, ar1, ft1)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4993
    by(case_tac "rec_ci (Cn (Suc (Suc 0)) rec_right [Cn (Suc (Suc 0)) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4994
      rec_conf [recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), rec_halt]])", auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4995
  moreover hence b: "ar1 = Suc (Suc 0)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4996
    using cn_arity by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4997
  ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4998
  proof(rule_tac i = 0 in cn_unhalt_case, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  4999
    fix anything
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5000
    obtain ap2 ar2 ft2 where c: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5001
      "rec_ci (Cn (Suc (Suc 0)) rec_conf [recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), rec_halt])
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5002
      = (ap2, ar2, ft2)" 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5003
      by(case_tac "rec_ci (Cn (Suc (Suc 0)) rec_conf
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5004
        [recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), rec_halt])", auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5005
    moreover hence d:"ar2 = Suc (Suc 0)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5006
      using cn_arity by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5007
    ultimately have "{\<lambda>nl. nl = [code tp, bl2wc (<lm>)] @ 0 \<up> (ft1 - Suc (Suc 0)) @ anything} ap1 \<up>"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5008
      using a b c d
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5009
    proof(rule_tac i = 0 in cn_unhalt_case, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5010
      fix anything
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5011
      obtain ap3 ar3 ft3 where e: "rec_ci rec_halt = (ap3, ar3, ft3)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5012
        by(case_tac "rec_ci rec_halt", auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5013
      hence f: "ar3 = Suc (Suc 0)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5014
        using mn_arity
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5015
        by(simp add: rec_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5016
      have "{\<lambda>nl. nl = [code tp, bl2wc (<lm>)] @ 0 \<up> (ft2 - Suc (Suc 0)) @ anything} ap2 \<up>"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5017
        using c d e f
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5018
      proof(rule_tac i = 2 in cn_unhalt_case, auto simp: rec_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5019
        fix anything
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5020
        have "{\<lambda>nl. nl = [code tp, bl2wc (<lm>)] @ 0 \<up> (ft3 - Suc (Suc 0)) @ anything} ap3 \<up>"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5021
          using e f
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5022
        proof(rule_tac mn_unhalt_case, auto simp: rec_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5023
          fix i
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  5024
          show "terminate rec_nonstop [code tp, bl2wc (<lm>), i]"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  5025
            by(rule_tac primerec_terminate, auto)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5026
        next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5027
          fix i
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  5028
          show "0 < rec_exec rec_nonstop [code tp, bl2wc (<lm>), i]"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5029
            using assms
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5030
            by(drule_tac nonstop_true, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5031
        qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5032
        thus "{\<lambda>nl. nl = code tp # bl2wc (<lm>) # 0 \<up> (ft3 - Suc (Suc 0)) @ anything} ap3 \<up>" by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5033
      next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5034
        fix apj arj ftj j  anything
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5035
        assume "j<2" "rec_ci ([recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), Mn (Suc (Suc 0)) rec_nonstop] ! j) = (apj, arj, ftj)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5036
        hence "{\<lambda>nl. nl = [code tp, bl2wc (<lm>)] @ 0 \<up> (ftj - arj) @ anything} apj
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5037
          {\<lambda>nl. nl = [code tp, bl2wc (<lm>)] @
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  5038
            rec_exec ([recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), Mn (Suc (Suc 0)) rec_nonstop] ! j) [code tp, bl2wc (<lm>)] # 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5039
               0 \<up> (ftj - Suc arj) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5040
          apply(rule_tac recursive_compile_correct)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5041
          apply(case_tac j, auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  5042
          apply(rule_tac [!] primerec_terminate)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5043
          by(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5044
        thus "{\<lambda>nl. nl = code tp # bl2wc (<lm>) # 0 \<up> (ftj - arj) @ anything} apj
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  5045
          {\<lambda>nl. nl = code tp # bl2wc (<lm>) # rec_exec ([recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0))
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5046
          (Suc 0), Mn (Suc (Suc 0)) rec_nonstop] ! j) [code tp, bl2wc (<lm>)] # 0 \<up> (ftj - Suc arj) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5047
          by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5048
      next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5049
        fix j
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5050
        assume "(j::nat) < 2"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  5051
        thus "terminate ([recf.id (Suc (Suc 0)) 0, recf.id (Suc (Suc 0)) (Suc 0), Mn (Suc (Suc 0)) rec_nonstop] ! j)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5052
          [code tp, bl2wc (<lm>)]"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  5053
          by(case_tac j, auto intro!: primerec_terminate)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5054
      qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5055
      thus "{\<lambda>nl. nl = code tp # bl2wc (<lm>) # 0 \<up> (ft2 - Suc (Suc 0)) @ anything} ap2 \<up>"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5056
        by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5057
    qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5058
    thus "{\<lambda>nl. nl = code tp # bl2wc (<lm>) # 0 \<up> (ft1 - Suc (Suc 0)) @ anything} ap1 \<up>" by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5059
  qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5060
qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5061
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5062
lemma uabc_uhalt': 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5063
  "\<lbrakk>tm_wf (tp, 0);
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5064
  \<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
  5065
  rec_ci rec_F = (ap, pos, md)\<rbrakk>
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5066
  \<Longrightarrow> {\<lambda> nl. nl = [code tp, bl2wc (<lm>)]} ap \<up>"
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5067
proof(frule_tac F_ap = ap and rs_pos = pos and a_md = md
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5068
    and suflm = "[]" in F_aprog_uhalt, auto simp: abc_Hoare_unhalt_def, 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5069
     case_tac "abc_steps_l (0, [code tp, bl2wc (<lm>)]) ap n", simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5070
  fix n a b
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5071
  assume h: 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5072
    "\<forall>n. abc_notfinal (abc_steps_l (0, code tp # bl2wc (<lm>) # 0 \<up> (md - pos)) ap n) ap"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5073
    "abc_steps_l (0, [code tp, bl2wc (<lm>)]) ap n = (a, b)" 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5074
    "tm_wf (tp, 0)" 
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5075
    "rec_ci rec_F = (ap, pos, md)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5076
  moreover have a: "ap \<noteq> []"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5077
    using h rec_ci_not_null[of "rec_F" pos md] by auto
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5078
  ultimately show "a < length ap"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5079
  proof(erule_tac x = n in allE)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5080
    assume g: "abc_notfinal (abc_steps_l (0, code tp # bl2wc (<lm>) # 0 \<up> (md - pos)) ap n) ap"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5081
    obtain ss nl where b : "abc_steps_l (0, code tp # bl2wc (<lm>) # 0 \<up> (md - pos)) ap n = (ss, nl)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5082
      by (metis prod.exhaust)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5083
    then have c: "ss < length ap"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5084
      using g by simp
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5085
    thus "?thesis"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5086
      using a b c
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5087
      using abc_list_crsp_steps[of "[code tp, bl2wc (<lm>)]"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5088
                                   "md - pos" ap n ss nl] h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5089
      by(simp)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5090
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5091
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5092
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5093
lemma uabc_uhalt: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5094
  "\<lbrakk>tm_wf (tp, 0); 
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5095
  \<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp))\<rbrakk>
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5096
  \<Longrightarrow> {\<lambda> nl. nl = [code tp, bl2wc (<lm>)]} F_aprog \<up> "
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5097
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
  5098
apply(drule_tac ap = a and pos = b and md = c in uabc_uhalt', simp_all)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5099
apply(rule_tac abc_Hoare_plus_unhalt1, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5100
done
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5101
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5102
lemma tutm_uhalt': 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5103
assumes tm_wf:  "tm_wf (tp,0)"
170
eccd79a974ae updated some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
  5104
  and unhalt: "\<forall> stp. (\<not> TSTD (steps0 (1, Bk\<up>(l), <lm>) tp stp))"
eccd79a974ae updated some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
  5105
  shows "\<forall> stp. \<not> is_final (steps0 (1, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp)"
eccd79a974ae updated some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
  5106
unfolding t_utm_def
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5107
proof(rule_tac compile_correct_unhalt, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5108
  show "F_tprog = tm_of F_aprog"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5109
    by(simp add:  F_tprog_def)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5110
next
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5111
  show "crsp (layout_of F_aprog) (0, [code tp, bl2wc (<lm>)]) (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>)  []"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5112
    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
  5113
next
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5114
  fix stp a b
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5115
  show "abc_steps_l (0, [code tp, bl2wc (<lm>)]) F_aprog stp = (a, b) \<Longrightarrow> a < length F_aprog"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5116
    using assms
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5117
    apply(drule_tac uabc_uhalt, auto simp: abc_Hoare_unhalt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5118
    by(erule_tac x = stp in allE, erule_tac x = stp in allE, simp) 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5119
qed
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5120
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5121
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
  5122
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5123
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5124
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5125
lemma inres_tape:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5126
  "\<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
  5127
  tinres l l'; tinres r r'\<rbrakk>
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5128
  \<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
  5129
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
  5130
  fix aa ba ca
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5131
  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
  5132
            "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
  5133
            "tinres l l'" "tinres r r'"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5134
            "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
  5135
  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
  5136
    using h
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5137
    apply(rule_tac tinres_steps1, auto)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5138
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5139
  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
  5140
    using h
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5141
    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
  5142
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5143
  ultimately show "?thesis"
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5144
    apply(auto intro: tinres_commute)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5145
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5146
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5147
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5148
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
  5149
      \<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
  5150
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
  5151
               <[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
  5152
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
  5153
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
  5154
apply(drule_tac inres_tape, auto)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5155
apply(auto simp: tinres_def)
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5156
apply(case_tac "m > Suc (Suc 0)")
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5157
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
  5158
apply(case_tac m, simp_all add: , case_tac nat, simp_all add: replicate_Suc)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5159
apply(rule_tac x = "2 - m" in exI, simp add: replicate_add[THEN sym])
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5160
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
  5161
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5162
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5163
lemma tutm_uhalt: 
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5164
  "\<lbrakk>tm_wf (tp,0);
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5165
    \<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
  5166
  \<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
  5167
apply(rule_tac tape_normalize)
170
eccd79a974ae updated some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
  5168
apply(rule_tac tutm_uhalt'[simplified], simp_all)
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5169
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5170
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5171
lemma UTM_uhalt_lemma_pre:
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5172
  assumes tm_wf: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5173
  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
  5174
  and args: "args \<noteq> []"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5175
  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
  5176
proof -
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5177
  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
  5178
  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
  5179
             (\<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
  5180
  let ?P2 = ?Q1
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5181
  have "{?P1} (t_wcode |+| t_utm) \<up>"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5182
  proof(rule_tac Hoare_plus_unhalt)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5183
    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
  5184
  next
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5185
    show "{?P1} t_wcode {?Q1}"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  5186
      apply(rule_tac Hoare_haltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5187
      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
  5188
      apply(auto)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5189
      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
  5190
      done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5191
  next
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5192
    show "{?P2} t_utm \<up>"
139
7cb94089324e updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 133
diff changeset
  5193
    proof(rule_tac Hoare_unhaltI, auto)
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5194
      fix n rn
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5195
      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
  5196
      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
  5197
        using assms
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5198
        apply(rule_tac tutm_uhalt, simp_all)
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5199
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5200
      thus "False"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5201
        using h
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5202
        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
  5203
        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
  5204
        done
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5205
    qed
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5206
  qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5207
  thus "?thesis"
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5208
    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
  5209
    done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5210
qed
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5211
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5212
text {*
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5213
  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
  5214
  *}
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5215
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5216
lemma UTM_uhalt_lemma':
131
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5217
  assumes tm_wf: "tm_wf (tp, 0)"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5218
  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
  5219
  and args: "args \<noteq> []"
e995ae949731 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 130
diff changeset
  5220
  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
  5221
  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
  5222
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
  5223
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
  5224
done
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5225
145
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5226
lemma UTM_halt_lemma:
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5227
  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
  5228
  and resut: "rs > 0"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5229
  and args: "(args::nat list) \<noteq> []"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5230
  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
  5231
  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
  5232
proof -
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5233
  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
  5234
          {(\<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
  5235
  proof(rule_tac Hoare_plus_halt)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5236
    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
  5237
    (\<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
  5238
      apply(rule_tac Hoare_haltI, auto)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5239
      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
  5240
      apply(auto)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5241
      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
  5242
      done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5243
  next
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5244
    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
  5245
      using exec
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5246
      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
  5247
      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
  5248
      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
  5249
      done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5250
    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
  5251
      ..
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5252
    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
  5253
      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
  5254
    proof(rule_tac Hoare_haltI, auto)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5255
      fix rn
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5256
      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
  5257
             (\<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
  5258
         (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
  5259
        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
  5260
        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
  5261
        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
  5262
        done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5263
    qed
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5264
  next
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5265
    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
  5266
  qed
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5267
  thus "?thesis"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5268
    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
  5269
    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
  5270
    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
  5271
    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
  5272
    apply(auto)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5273
    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
  5274
           (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
  5275
                        shift (mopup (Suc (Suc 0)))
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5276
                         (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
  5277
                          2))) n)")
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5278
    apply(simp)
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
qed
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_halt_lemma2:
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 args: "(args::nat list) \<noteq> []"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5285
  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
  5286
  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
  5287
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
  5288
using assms(3)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5289
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
  5290
done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5291
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5292
    
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5293
lemma UTM_unhalt_lemma: 
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5294
  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
  5295
  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
  5296
  and args: "args \<noteq> []"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5297
  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
  5298
proof -
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5299
  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
  5300
    using unhalt
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5301
    apply(auto simp: Hoare_unhalt_def)    
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5302
    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
  5303
    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
  5304
    done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5305
  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
  5306
    using assms
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5307
    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
  5308
    done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5309
  thus "?thesis"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5310
    apply(simp add: Hoare_unhalt_def)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5311
    done
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5312
qed
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5313
    
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5314
lemma UTM_unhalt_lemma2: 
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5315
  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
  5316
  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
  5317
  and args: "args \<noteq> []"
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5318
  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
  5319
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
  5320
using assms(2-3)
38d8e0e37b7d updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 139
diff changeset
  5321
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
  5322
done
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
  5323
130
1e89c65f844b added UTM
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  5324
end